' 
' Advanced Model Checker v1.0
'
' copyright (c) 1999, Rational Software Corporation, ALL RIGHTS RESERVED
'
' Authors: Michael Moors  (mmoors@rational.com)
'          Todd Dunnavant (tdunnavant@rational.com)
' 
' Date:  7-Aug-1999
'
' This script identifies the following Rose model issues:
' -  messages in interaction diagrams that do not have associated class operations
' -  messages in interaction diagrams for which sending and receiving objects aren't
'    class instances
' -  messages in interaction diagrams for which no dependency relation or properly
'    navigable association exists between the classes for which the sending and receiving
'    objects are instances
'

Const LogPrefix$ = "ACM: "

'
' Procedure to write toolinfo to the ViewPort
'
Sub WriteLog (theString As String)
 'RoseApp.WriteErrorLog LogPrefix$ + theString
 Print LogPrefix$ + theString
End Sub


'
' Procedure to check if dependency exists
'
Function CheckDependency (client As Class, server As Class) As Boolean
	Dim Dependencies As ClassDependencyCollection
	CheckDependency = False
	Set Dependencies = client.GetClassDependencies
	For i = 1 To Dependencies.count
		If Dependencies.GetAt(i).GetSupplierClass.Name = server.Name Then
			CheckDependency = True
			Exit For
		End If
	Next
End Function


'
' Procedure to check if navigable association or dependency exists
'
Sub CheckRelations (theMes As Message, DiagramName As String, PackageName As String) 
 Dim theOp As Operation
 Dim sender As ObjectInstance
 Dim receiver As ObjectInstance
 Dim allAsso As AssociationCollection
 Dim Continue As Boolean
 Dim Found As Boolean
   
 Set sender = theMes.GetSenderObject
 Set receiver = theMes.GetReceiverObject
 Continue = True
 If Not sender.isclass Then
  	Continue = False
  	WriteLog " "
  	WriteLog "ObjectInstance " + sender.Name _
  	+ " is not a class. Association or Dependency impossible."
  	WriteLog "Diagram Name = " + DiagramName
  	WriteLog "Owning Package = " + PackageName
 End If
 If Not receiver.isclass Then
  	Continue = False
  	WriteLog " "
  	WriteLog "ObjectInstance " + receiver.Name _
  	+ " is not a class. Association or Dependency impossible."
  	WriteLog "Diagram Name = " + DiagramName
  	WriteLog "Owning Package = " + PackageName
 End If

 ' Skip if one or both ObjectInstances are not Class
 ' Skip if ObjectInstances are of same Class
 If Continue And Not sender.getclass Is receiver.getclass Then
 	'
 	' Check for a dependency between the sender and receiver.  If it exists, we don't
 	' need to perform the association checks
	'
    If CheckDependency (sender.getclass, receiver.getclass) Then 
	Else
	'
	' No dependency exists, so check for navigable associations
	'
 		Set allAsso = sender.GetClass.GetAssociations
  		Found = False
  		For w = 1 To allAsso.count
   			If (allAsso.GetAt(w).getOtherRole(sender.getclass).class _
    		Is receiver.getclass) Then
				If allAsso.GetAt(w).getOtherRole(sender.getclass).Navigable Then
  					Found = True
   					Exit For      ' Terminate looping once true condition is set
				End If
		   	End If
  		Next w
  		If Found Then
  		Else
		'
		'  No navigable association or dependency exists
		'
     		WriteLog " " 
     		WriteLog "NO Dependency or Navagable Association for message " _
      		+ theMes.Name + "."
     		WriteLog "Diagram Name = " + DiagramName
     		WriteLog "Sending Class = " + sender.ClassName
     		WriteLog "Receiving Class = " + receiver.ClassName
     		WriteLog "Owning Package = " + PackageName
   		End If 		' End If for Found or not Found
 	End If          ' End If for dependency check
 End If	            ' End If for continue and class existence checks 
End Sub


'
' Procedure to check if Message has Operation
'
Sub CheckOperation (theMes As Message, DiagramName As String, PackageName As String)
 If theMes.IsOperation Then
  CheckRelations theMes, DiagramName, PackageName
 Else
  WriteLog " "
  WriteLog "message " + theMes.Name + _
   " does not have an operation assigned."
  WriteLog "Diagram Name = " + DiagramName
  If theMes.GetSenderObject.ClassName = "" Then
  	WriteLog "Sending Object = " + theMes.GetSenderObject.Name
  Else
  	WriteLog "Sending Class = " + theMes.GetSenderObject.ClassName
  End If
  If theMes.GetReceiverObject.ClassName = "" Then
  	WriteLog "Receiving Object = " + theMes.GetReceiverObject.Name
  Else 
  	WriteLog "Receiving Class = " + theMes.GetReceiverObject.ClassName
  End If
  WriteLog "Owning Package = " + PackageName
 End If
End Sub

'
' Procedure to check the sequence diagrams of a model
'
Sub CheckSequenceDiagrams (theModel As Model)
 WriteLog "Checking model: " + theModel.Name
 Dim allCats As CategoryCollection
 Dim allUseCases As UseCaseCollection
 Dim allDias As ScenarioDiagramCollection
 Dim useCaseDias As ScenarioDiagramCollection
 Dim allMess As MessageCollection
  
 Set allCats = theModel.GetAllCategories
 '
 ' Build the list of scenario diagrams under the current package
 '
 For x = 1 To allCats.count
  Set allDias = allCats.GetAt(x).ScenarioDiagrams
  For y = 1 To allDias.count
   Set allMess = allDias.GetAt(y).GetMessages
   For z = 1 To allMess.count
    CheckOperation allMess.GetAt(z), allDias.GetAt(y).Name, allCats.GetAt(x).Name
   Next z	  
  Next y
 Next x
  '
  ' Process the scenario diagrams owned by use cases
  '
  Set allUseCases = theModel.GetAllUseCases
  For w = 1 To allUseCases.count
  	Set useCaseDias = allUseCases.GetAt(w).ScenarioDiagrams
	For v = 1 To useCaseDias.count
	  Set allMess = useCaseDias.GetAt(v).GetMessages
	  For u = 1 To allMess.count
	  	CheckOperation allMess.GetAt(u), useCaseDias.GetAt(v).Name, allUseCases.GetAt(w).ParentCategory.Name
	  Next u
	Next v
  Next w
 End Sub

'
' Main
' 
Sub Main
 ViewPort.Open
 'RoseApp.WriteErrorLog ""	   Output moved to ViewPort for greater capacity
 WriteLog "Advanced Check Model starting..."
 CheckSequenceDiagrams RoseApp.CurrentModel
 WriteLog "successfully finished :-)"
End Sub