Merge pull request #136 from moosetechnology/sanity-checks

Sanity checks

src/EsopeImporter-Tests/FamixEsopeResolverTest.class.st

@@ -673,6 +673,67 @@ FamixEsopeResolverTest >> testResolveAccessesForAnAttribute [
 	self assert: access accessor equals: subrtn
 ]
 
+{ #category : #'test - resolveAccess' }
+FamixEsopeResolverTest >> testResolveAccessesFromStatementFunctionToParameter [
+	"program main
+	 identity(x) = x
+	 end
+	"
+
+	| fct access  var |
+
+	fct := self newEntity: FamixF77StatementFunction named: 'identity'.
+	fct
+		parentEntity: (self defaultMain: 'main') ;
+		addParameter: (self newEntity: FamixF77Parameter named: 'x') ;
+		addAccess: (self defaultAccess: 'x').
+
+ 	resolver resolveAccesses.
+
+	self assert: fct parameters size equals: 1.
+	var := fct parameters anyOne.
+	self assert: var name equals: 'x'.
+
+	self assert: fct accesses size equals: 1.
+
+	access := fct accesses anyOne.
+	self assert: access variable equals: var.
+
+]
+
+{ #category : #'test - resolveAccess' }
+FamixEsopeResolverTest >> testResolveAccessesFromStatementFunctionToParentLocalVariable [
+	"program main
+	 var = 1
+	 constant(x) = var
+	 end
+	"
+
+	| main fct var |
+
+	main := (self defaultMain: 'main')
+		addLocalVariable: (self defaultVariable: 'var' withType: #integer);
+		addAccess: (self defaultAccess: 'var');
+		yourself.
+
+	fct := self newEntity: FamixF77StatementFunction named: 'constant'.
+	fct
+		parentEntity: main ;
+		addParameter: (self newEntity: FamixF77Parameter named: 'x') ;
+		addAccess: (self defaultAccess: 'var').
+
+ 	resolver resolveAccesses.
+
+	self assert: fct localVariables size equals: 0.
+
+	var := fct parameters anyOne.
+	self assert: var incomingAccesses size equals: 0.
+
+	var := main localVariables anyOne.
+	self assert: var incomingAccesses size equals: 2.
+	self assert: fct accesses anyOne variable equals: var.
+]
+
 { #category : #'test - resolveAccess' }
 FamixEsopeResolverTest >> testResolveAccessesInIncludedFileToInside [
 	"Resolve accesses from includedFile to variable declared in the same includedIile

src/EsopeImporter/FamixEsopeResolver.class.st

@@ -229,7 +229,8 @@ FamixEsopeResolver >> resolve [
 	self resolvingSteps do: [ :step |
 		self errorHandler enterContext: step.
 		self perform: step.
-		self errorHandler leaveContext ]
+		self errorHandler leaveContext
+	]
 ]
 
 { #category : #'symbols resolution' }

src/EsopeImporter/FamixF77Access.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #FamixF77Access }
+
+{ #category : #'*EsopeImporter' }
+FamixF77Access >> famixImportSanityCheck [
+
+	self assert: variable isNotNil description: 'Access without variable'.
+	self assert: accessor isNotNil description: 'Access without accessor'
+]

src/EsopeImporter/FamixF77Entity.extension.st

@@ -0,0 +1,14 @@
+Extension { #name : #FamixF77Entity }
+
+{ #category : #'*EsopeImporter' }
+FamixF77Entity >> assert: aBlock description: aString [
+	"reimplement Object>>assert:description: because we want a resumable Failure"
+
+	aBlock value == true ifFalse: [
+		Exception signal: aString ]
+]
+
+{ #category : #'*EsopeImporter' }
+FamixF77Entity >> famixImportSanityCheck [
+	"nothing special by default"
+]

src/EsopeImporter/FamixF77IncludedFile.extension.st

@@ -14,3 +14,11 @@ FamixF77IncludedFile >> createUnresolveVariable: variableName with: resolver [
 	^mooseModel newUnknownVariableNamed: variableName
 
 ]
+
+{ #category : #'*EsopeImporter' }
+FamixF77IncludedFile >> famixImportSanityCheck [
+
+	super famixImportSanityCheck.
+
+	self assert: inclusions isNotEmpty description: 'IncludedFile without inclusions'.
+]

src/EsopeImporter/FamixF77Invocation.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #FamixF77Invocation }
+
+{ #category : #'*EsopeImporter' }
+FamixF77Invocation >> famixImportSanityCheck [
+
+	self assert: sender isNotNil description: 'Invocation without sender'.
+	self assert: candidates isNotEmpty description: 'Invocation without candidates'.
+]

src/EsopeImporter/FamixF77PUFunction.extension.st

@@ -0,0 +1,9 @@
+Extension { #name : #FamixF77PUFunction }
+
+{ #category : #'*EsopeImporter' }
+FamixF77PUFunction >> famixImportSanityCheck [
+
+	super famixImportSanityCheck.
+
+	self assert: declaredType isNotNil description: 'Function without declaredType'.
+]

src/EsopeImporter/FamixF77Parameter.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #FamixF77Parameter }
+
+{ #category : #'*EsopeImporter' }
+FamixF77Parameter >> famixImportSanityCheck [
+
+	self assert: parentBehaviouralEntity isNotNil description: 'Parameter without parentBehaviouralEntity'.
+	self assert: declaredType isNotNil description: 'Parameter without declaredType'.
+]

src/EsopeImporter/FamixF77ProgramUnit.extension.st

@@ -41,6 +41,12 @@ FamixF77ProgramUnit >> defaultImplicit [
 
 ]
 
+{ #category : #'*EsopeImporter' }
+FamixF77ProgramUnit >> famixImportSanityCheck [
+
+	self assert: programFile isNotNil description: 'ProgramUnit without parent ProgramFile'.
+]
+
 { #category : #'*EsopeImporter' }
 FamixF77ProgramUnit >> implicitDictionary [
 

src/EsopeImporter/FamixF77StatementFunction.extension.st

@@ -12,8 +12,26 @@ FamixF77StatementFunction >> allTypes [
 	^#()
 ]
 
+{ #category : #'*EsopeImporter' }
+FamixF77StatementFunction >> famixImportSanityCheck [
+
+	super famixImportSanityCheck.
+
+	self assert: parentEntity isNotNil description: 'StatementFunction without parentEntity'.
+]
+
 { #category : #'*EsopeImporter' }
 FamixF77StatementFunction >> implicitDictionary [
 
 	^parentEntity implicitDictionary
 ]
+
+{ #category : #'*EsopeImporter' }
+FamixF77StatementFunction >> resolveVariable: variableName with: resolver [ 
+	"StatementFunctions have Parameters and no LocalVariable,
+	 but can access LocalVariables of their parentEntity"
+	^(resolver resolveVariableNamed: variableName in: self)
+		ifNotNil: [ :localVar | localVar ]
+		ifNil: [ parentEntity resolveVariable: variableName with: resolver  ]
+
+]

src/EsopeImporter/FamixF77UnknownVariable.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #FamixF77UnknownVariable }
+
+{ #category : #'*EsopeImporter' }
+FamixF77UnknownVariable >> famixImportSanityCheck [
+
+	self assert: incomingAccesses isNotEmpty description: 'UnknownVariable without incomingAccesses'.
+]

src/EsopeImporter/FamixF77Variable.extension.st

@@ -1,5 +1,12 @@
 Extension { #name : #FamixF77Variable }
 
+{ #category : #'*EsopeImporter' }
+FamixF77Variable >> famixImportSanityCheck [
+
+	self assert: parentBehaviouralEntity isNotNil description: 'Variable without parentBehaviouralEntity'.
+	self assert: declaredType isNotNil description: 'Variable without declaredType'.
+]
+
 { #category : #'*EsopeImporter' }
 FamixF77Variable >> segment [
 

src/EsopeImporter/FamixFortranAttribute.extension.st

@@ -0,0 +1,8 @@
+Extension { #name : #FamixFortranAttribute }
+
+{ #category : #'*EsopeImporter' }
+FamixFortranAttribute >> famixImportSanityCheck [
+
+	self assert: parentType isNotNil description: 'Variable without parentType'.
+	self assert: declaredType isNotNil description: 'Variable without declaredType'.
+]

src/EsopeImporter/FamixFortranEntity.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : #FamixFortranEntity }
+
+{ #category : #'*EsopeImporter' }
+FamixFortranEntity >> famixImportSanityCheck [
+	"nothing special by default"
+]

src/EsopeImporter/FortranErrorManager.class.st

@@ -48,30 +48,21 @@ FortranErrorManager >> handleErrorsFor: context running: runningBlock [
 	 2. executes the runningBlock
 	 3. in case of Error register it"
 
-	^self handleErrorsFor: context running: runningBlock onErrorDo: [ :err | nil ]
-]
-
-{ #category : #api }
-FortranErrorManager >> handleErrorsFor: context running: runningBlock onErrorDo: errorBlock [
-	"1. register the context
-	 2. executes the runningBlock
-	 3. in case of Error register it
-	 4. and executes the errorBlock"
-
 	| value |
 
 	self enterContext: context.
 
 	[ value := runningBlock value ]
-	on: Error
-	do: [ :err |
-		self error: err.
-		value := errorBlock value: err
-	].
+		on: Exception
+		do: [ :err |
+			self error: err.
+			err resume
+		].
 
 	self leaveContext.
-	
+
 	^value
+
 ]
 
 { #category : #initialization }