diff --git a/src/BaselineOfExecutableRequirements/BaselineOfExecutableRequirements.class.st b/src/BaselineOfExecutableRequirements/BaselineOfExecutableRequirements.class.st index 301985f..3cab051 100644 --- a/src/BaselineOfExecutableRequirements/BaselineOfExecutableRequirements.class.st +++ b/src/BaselineOfExecutableRequirements/BaselineOfExecutableRequirements.class.st @@ -29,8 +29,11 @@ BaselineOfExecutableRequirements >> baselineForCommon: spec [ { #category : 'baselines' } BaselineOfExecutableRequirements >> coreDependencies: spec [ - "No dependencies" + spec + baseline: 'MethodProxies' + with: [ spec repository: 'github://Nyan11/MethodProxies/src' ] + ] { #category : 'baselines' } diff --git a/src/ExecutableRequirements-Tests/ExReqMockTestObject.class.st b/src/ExecutableRequirements-Tests/ExReqMockTestObject.class.st index 3708ef1..25ac4d1 100644 --- a/src/ExecutableRequirements-Tests/ExReqMockTestObject.class.st +++ b/src/ExecutableRequirements-Tests/ExReqMockTestObject.class.st @@ -15,6 +15,13 @@ ExReqMockTestObject >> methodToTestMetaSafeRecursion [ ^ true ] +{ #category : 'as yet unclassified' } +ExReqMockTestObject >> methodToTestTheExceptionExit [ + + x := [ true ifTrue: [ Exception signal ] ] value. + ^ Color blue +] + { #category : 'as yet unclassified' } ExReqMockTestObject >> methodToTestTheNonLocalReturn [ diff --git a/src/ExecutableRequirements-Tests/ExReqRepositoryReportTest.class.st b/src/ExecutableRequirements-Tests/ExReqRepositoryReportTest.class.st index d83f090..f4af9c5 100644 --- a/src/ExecutableRequirements-Tests/ExReqRepositoryReportTest.class.st +++ b/src/ExecutableRequirements-Tests/ExReqRepositoryReportTest.class.st @@ -42,16 +42,6 @@ ExReqRepositoryReportTest >> tearDown [ repository := nil ] -{ #category : 'tests' } -ExReqRepositoryReportTest >> testCreateTracingPoints [ - - self assert: ExReqTracingPoint all isEmpty. - self assert: self report tracingPoints isEmpty. - self report createTracingPoints. - self assert: ExReqTracingPoint all isNotEmpty. - self assert: self report tracingPoints isNotEmpty -] - { #category : 'tests' } ExReqRepositoryReportTest >> testExecuteTracingPoints [ @@ -67,15 +57,11 @@ ExReqRepositoryReportTest >> testExecuteTracingPoints [ { #category : 'tests' } ExReqRepositoryReportTest >> testInstallTracingPoints [ - self assert: ExReqTracingPoint all isEmpty. - self assert: self report tracingPoints isEmpty. + self assert: self report builder isEmpty. self report installTracingPoints. - - self assert: ExReqTracingPoint all isNotEmpty. - self assert: self report tracingPoints isNotEmpty. + self assert: self report builder isNotEmpty. self report removeTracingPoints. - self assert: ExReqTracingPoint all isEmpty. - self assert: self report tracingPoints isEmpty. + self assert: self report builder isEmpty. ] { #category : 'tests' } diff --git a/src/ExecutableRequirements-Tests/ExReqSafePassingControlTest.class.st b/src/ExecutableRequirements-Tests/ExReqSafePassingControlTest.class.st index a914778..9a02fb7 100644 --- a/src/ExecutableRequirements-Tests/ExReqSafePassingControlTest.class.st +++ b/src/ExecutableRequirements-Tests/ExReqSafePassingControlTest.class.st @@ -65,6 +65,23 @@ ExReqSafePassingControlTest >> req3 [ yourself ] +{ #category : 'as yet unclassified' } +ExReqSafePassingControlTest >> req4 [ + + + ^ ExReqRequirement new + title: 'A requirement verifications shall handle exception'; + addVerification: [ :verify | + verify + addStepOnAST: + ((ExReqMockTestObject methodNamed: + #methodToTestTheExceptionExit) ast allChildren select: [ + :each | each isMessage ]) first + withPrecondition: [ true ] + withPostcondition: [ true ] ]; + yourself +] + { #category : 'running' } ExReqSafePassingControlTest >> setUp [ @@ -85,6 +102,18 @@ ExReqSafePassingControlTest >> tearDown [ repository := nil ] +{ #category : 'tests' } +ExReqSafePassingControlTest >> testExceptionExit [ + + | requirement requirementReport | + self report installTracingPoints. + self should: [ExReqMockTestObject new methodToTestTheExceptionExit] raise: Exception. + requirement := self req4. + requirementReport := self report findRequirementReport: requirement. + self assert: requirementReport isValid. + self report removeTracingPoints +] + { #category : 'tests' } ExReqSafePassingControlTest >> testMetaSafeRecursion [ diff --git a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginRequirements.class.st b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginRequirements.class.st index 0b21704..8b45b39 100644 --- a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginRequirements.class.st +++ b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginRequirements.class.st @@ -1006,9 +1006,14 @@ ExReqToploLoginRequirements >> capella_requirement_3 [ (ExReqToploLoginSimulation >> #authenticateUsername:password:) ast withPrecondition: [ :obj :args | - (obj - perform: #authenticateUsername:password: - withArguments: args) not ]. + [ + obj + perform: #authenticateUsername:password: + withArguments: args. + false ] + on: Exception + do: [ true ] ] + withPostcondition: [ true ]. verif addStepOnAST: (ExReqToploLoginWidget >> #loginAction) ast withPostcondition: [ :obj :args | diff --git a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginSimulation.class.st b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginSimulation.class.st index 9d97f5a..31ae7eb 100644 --- a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginSimulation.class.st +++ b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginSimulation.class.st @@ -57,7 +57,7 @@ ExReqToploLoginSimulation >> authenticateUsername: aUsernameString password: aPa self database at: aUsernameString ifPresent: [ :value | ^ aPasswordString = value ] - ifAbsent: [ ^ false ] + ifAbsent: [ Exception signal: 'Wrong credentials' ] ] { #category : 'as yet unclassified' } diff --git a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginWidget.class.st b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginWidget.class.st index 2cf22f3..0b5516f 100644 --- a/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginWidget.class.st +++ b/src/ExecutableRequirements-Toplo-Example/ExReqToploLoginWidget.class.st @@ -367,11 +367,11 @@ ExReqToploLoginWidget >> initialize [ { #category : 'as yet unclassified' } ExReqToploLoginWidget >> loginAction [ - (self authenticationBlock - value: self usernameValue - value: self passwordValue) - ifTrue: [ self loginBlock value ] - ifFalse: [ + [ self authenticationBlock + value: self usernameValue + value: self passwordValue. + self loginBlock value ] + on: Exception do: [ :error | self loginStatusContainer visibility: BlVisibility visible. self passwordInput text: '' ] ] diff --git a/src/ExecutableRequirements/ExReqRepositoryReport.class.st b/src/ExecutableRequirements/ExReqRepositoryReport.class.st index 4a4f330..29796d8 100644 --- a/src/ExecutableRequirements/ExReqRepositoryReport.class.st +++ b/src/ExecutableRequirements/ExReqRepositoryReport.class.st @@ -4,8 +4,8 @@ Class { #instVars : [ 'requirementReports', 'repository', - 'tracingPoints', - 'announcer' + 'announcer', + 'builder' ], #category : 'ExecutableRequirements-Model-Report', #package : 'ExecutableRequirements', @@ -73,6 +73,12 @@ ExReqRepositoryReport >> associatedPackages [ ^ self repository associatedPackages. ] +{ #category : 'as yet unclassified' } +ExReqRepositoryReport >> builder [ + + ^ builder +] + { #category : 'as yet unclassified' } ExReqRepositoryReport >> closeReport [ @@ -81,40 +87,6 @@ ExReqRepositoryReport >> closeReport [ requirementReports := { } ] -{ #category : 'as yet unclassified' } -ExReqRepositoryReport >> createTracingPoints [ - - | stepReports preconditionNodeDictionary postconditionNodeDictionary| - " - - Step1: Get all step reports. - - Step2: Create a dictionary with all ast -> step reports. - - Step3: Create all PreconditionTracingPoint. - - Step4: Create a dictionary with all ast & ast methodNode -> step reports. - - Step5: Create all PostconditionTracingPoint. - " - stepReports := self requirementReports flatCollect: [ :req | - req verificationReports flatCollect: #stepReports ]. - preconditionNodeDictionary := Dictionary new. - postconditionNodeDictionary := Dictionary new. - stepReports do: [ :stepReport | - preconditionNodeDictionary - at: stepReport step node - ifPresent: [ :col | col add: stepReport ] - ifAbsentPut: [ OrderedCollection with: stepReport ]. - postconditionNodeDictionary - at: stepReport step node - ifPresent: [ :col | col add: stepReport ] - ifAbsentPut: [ Set with: stepReport ]. - postconditionNodeDictionary - at: stepReport step node methodNode - ifPresent: [ :col | col add: stepReport ] - ifAbsentPut: [ Set with: stepReport ]. - ]. - self tracingPoints: OrderedCollection new. - self tracingPoints addAll: (preconditionNodeDictionary associations collect: [ :asso | ExReqTracingPoint installPreconditionOn: asso key withStepReports: asso value ]). - self tracingPoints addAll: (postconditionNodeDictionary associations collect: [ :asso | ExReqTracingPoint installPostconditionOn: asso key withStepReports: asso value ]). -] - { #category : 'as yet unclassified' } ExReqRepositoryReport >> findRequirementReport: anExReqRequirement [ | result | @@ -128,15 +100,17 @@ ExReqRepositoryReport >> findRequirementReport: anExReqRequirement [ ExReqRepositoryReport >> initialize [ super initialize. - tracingPoints := OrderedCollection new. - announcer := Announcer new + announcer := Announcer new. + builder := NeoExReqInstrumentationBuilder new. ] { #category : 'as yet unclassified' } ExReqRepositoryReport >> installTracingPoints [ - self createTracingPoints. - self tracingPoints do: [ :each | each install ]. + | stepReports | + stepReports := self requirementReports flatCollect: [ :req | + req verificationReports flatCollect: #stepReports ]. + self builder installAllStepReports: stepReports. self isInstalled: true. self isRunning: true. self annouceTracingPointInstalled @@ -157,8 +131,7 @@ ExReqRepositoryReport >> isValid [ { #category : 'as yet unclassified' } ExReqRepositoryReport >> removeTracingPoints [ - self tracingPoints do: [ :each | each remove ]. - self tracingPoints: { }. + self builder uninstallAllStepReports. self isRunning: false. self annouceTracingPointRemoved ] @@ -189,15 +162,3 @@ ExReqRepositoryReport >> subReports [ ^ self requirementReports ] - -{ #category : 'accessing' } -ExReqRepositoryReport >> tracingPoints [ - - ^ tracingPoints -] - -{ #category : 'accessing' } -ExReqRepositoryReport >> tracingPoints: aCollection [ - - tracingPoints := aCollection -] diff --git a/src/ExecutableRequirements/ExReqStepReport.class.st b/src/ExecutableRequirements/ExReqStepReport.class.st index e1bb131..45a339f 100644 --- a/src/ExecutableRequirements/ExReqStepReport.class.st +++ b/src/ExecutableRequirements/ExReqStepReport.class.st @@ -177,6 +177,47 @@ ExReqStepReport >> subReports [ ^ { } ] +{ #category : 'as yet unclassified' } +ExReqStepReport >> verifyPostconditionWithReceiver: anObject withArguments: aCollection [ + + self step ifNil: [ ^ self ]. + postconditionValidity ifTrue: [ ^ self ]. + self preconditionIsValid ifFalse: [ ^ self ]. + self step postcondition ifNil: [ + postconditionValidity := true. + self announceValidity. + ^ self ]. + postconditionValidity := self hasPostcondition + ifTrue: [ + self step postcondition + valueWithEnoughArguments: { + anObject. + aCollection. + self requirement } ] + ifFalse: [ true ]. + + self isValid ifTrue: [ self announceValidity ] +] + +{ #category : 'as yet unclassified' } +ExReqStepReport >> verifyPreconditionWithReceiver: anObject withArguments: aCollection [ + trigger := true. + preconditionValidity ifTrue: [ ^ self ]. + self isPreviousStepValid ifFalse: [ + preconditionValidity := false. + postconditionValidity := false. + ^ self ]. + preconditionValidity := self hasPrecondition + ifTrue: [ + self step precondition + valueWithEnoughArguments: { + anObject. + aCollection. + self requirement } ] + ifFalse: [ true ]. + self isValid ifTrue: [ self announceValidity ] +] + { #category : 'as yet unclassified' } ExReqStepReport >> verifyStepPostconditionWithContext: aContext [ " diff --git a/src/ExecutableRequirements/ExReqTracingPoint.class.st b/src/ExecutableRequirements/ExReqTracingPoint.class.st index 61fde57..90bee58 100644 --- a/src/ExecutableRequirements/ExReqTracingPoint.class.st +++ b/src/ExecutableRequirements/ExReqTracingPoint.class.st @@ -127,7 +127,7 @@ ExReqTracingPoint >> metaLink [ { #category : 'accessing' } ExReqTracingPoint >> name [ - ^ name ifNil: [ #TracingPoint ] + ^ name ifNil: [ name := #TracingPoint ] ] { #category : 'default values' } diff --git a/src/ExecutableRequirements/NeoExReqInstrumentationBuilder.class.st b/src/ExecutableRequirements/NeoExReqInstrumentationBuilder.class.st new file mode 100644 index 0000000..95d5440 --- /dev/null +++ b/src/ExecutableRequirements/NeoExReqInstrumentationBuilder.class.st @@ -0,0 +1,165 @@ +Class { + #name : 'NeoExReqInstrumentationBuilder', + #superclass : 'Object', + #instVars : [ + 'preconditionTracingPoints', + 'postconditionTracingPoints', + 'methodProxies' + ], + #category : 'ExecutableRequirements-Technical', + #package : 'ExecutableRequirements', + #tag : 'Technical' +} + +{ #category : 'initialization' } +NeoExReqInstrumentationBuilder >> initialize [ + + super initialize. + methodProxies := Dictionary new. + preconditionTracingPoints := Dictionary new. + postconditionTracingPoints := Dictionary new +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installAllStepReports: aCollection [ + + | tracingPoints | + aCollection do: [ :each | self installStepReport: each ]. + tracingPoints := self preconditionTracingPoints values + , self postconditionTracingPoints values. + + tracingPoints do: [ :each | + each link: each metaLink. + each install ]. + self methodProxies valuesDo: [ :each | + each + install; + enableInstrumentation ] +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installMethodProxyForStepReport: aStepReport withNode: aNode [ + + self + installPreconditionMethodProxyForStepReport: aStepReport + withNode: aNode. + aStepReport hasPostcondition ifFalse: [ ^ self ]. + self + installPostconditionMethodProxyForStepReport: aStepReport + withNode: aNode +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installPostconditionMethodProxyForStepReport: aStepReport withNode: aNode [ + + self methodProxies + at: aNode + ifPresent: [ :p | p handler addPostconditionStepReport: aStepReport ] + ifAbsentPut: [ + | handler | + handler := NeoExReqMethodProxyHandler new + addPostconditionStepReport: aStepReport; + yourself. + MpMethodProxy onMethod: aNode compiledMethod handler: handler ] +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installPreconditionMethodProxyForStepReport: aStepReport withNode: aNode [ + + self methodProxies + at: aNode + ifPresent: [ :p | p handler addPreconditionStepReport: aStepReport ] + ifAbsentPut: [ + | handler | + handler := NeoExReqMethodProxyHandler new + addPreconditionStepReport: aStepReport; + yourself. + MpMethodProxy onMethod: aNode compiledMethod handler: handler ] +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installStepReport: aStepReport [ + + | astNode | + astNode := aStepReport step node. + astNode isMethod + ifTrue: [ + "self installMethodProxyForStepReport: aStepReport withNode: astNode" ] + ifFalse: [ + self + installTracingPointForStepReport: aStepReport + withNode: astNode ] +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> installTracingPointForStepReport: aStepReport withNode: aNode [ + "Quand la postcondition est nil, il ne trigger pas sauf si on retire la method proxy." + + "L'installation de la méthode proxy retire le preconditionTracingPoint" + + "self + installPostconditionMethodProxyForStepReport: aStepReport + withNode: aNode methodNode." + self preconditionTracingPoints + at: aNode + ifPresent: [ :tp | tp addStepReport: aStepReport ] + ifAbsentPut: [ + NeoExReqPreconditionTracingPoint new + node: aNode; + addStepReport: aStepReport; + yourself ]. + aStepReport hasPostcondition ifFalse: [ ^ self ]. + self postconditionTracingPoints + at: aNode + ifPresent: [ :tp | tp addStepReport: aStepReport ] + ifAbsentPut: [ + NeoExReqPostconditionTracingPoint new + node: aNode; + addStepReport: aStepReport; + yourself ] +] + +{ #category : 'testing' } +NeoExReqInstrumentationBuilder >> isEmpty [ + + ^ self methodProxies isEmpty and: [ + self preconditionTracingPoints isEmpty and: [ + self postconditionTracingPoints isEmpty ] ] +] + +{ #category : 'testing' } +NeoExReqInstrumentationBuilder >> isNotEmpty [ + ^ self isEmpty not +] + +{ #category : 'accessing' } +NeoExReqInstrumentationBuilder >> methodProxies [ + + ^ methodProxies +] + +{ #category : 'accessing' } +NeoExReqInstrumentationBuilder >> postconditionTracingPoints [ + + ^ postconditionTracingPoints +] + +{ #category : 'accessing' } +NeoExReqInstrumentationBuilder >> preconditionTracingPoints [ + + ^ preconditionTracingPoints +] + +{ #category : 'as yet unclassified' } +NeoExReqInstrumentationBuilder >> uninstallAllStepReports [ + + | tracingPoints | + tracingPoints := self preconditionTracingPoints values + , self postconditionTracingPoints values. + + self methodProxies valuesDo: [ :each | each uninstall ]. + tracingPoints do: [ :each | each uninstall ]. + self preconditionTracingPoints removeAll. + self postconditionTracingPoints removeAll. + self methodProxies removeAll +] diff --git a/src/ExecutableRequirements/NeoExReqMethodProxyHandler.class.st b/src/ExecutableRequirements/NeoExReqMethodProxyHandler.class.st new file mode 100644 index 0000000..30456ce --- /dev/null +++ b/src/ExecutableRequirements/NeoExReqMethodProxyHandler.class.st @@ -0,0 +1,66 @@ +Class { + #name : 'NeoExReqMethodProxyHandler', + #superclass : 'MpHandler', + #instVars : [ + 'postconditionStepReports', + 'preconditionStepReports' + ], + #category : 'ExecutableRequirements-Technical', + #package : 'ExecutableRequirements', + #tag : 'Technical' +} + +{ #category : 'evaluating' } +NeoExReqMethodProxyHandler >> aboutToReturnWithReceiver: anObject arguments: anArrayOfObjects [ + + self postconditionStepReports do: [ :stepReport | + stepReport + verifyPostconditionWithReceiver: anObject + withArguments: anArrayOfObjects ] +] + +{ #category : 'adding' } +NeoExReqMethodProxyHandler >> addPostconditionStepReport: aStepReport [ + + self postconditionStepReports add: aStepReport +] + +{ #category : 'adding' } +NeoExReqMethodProxyHandler >> addPreconditionStepReport: aStepReport [ + + self preconditionStepReports add: aStepReport +] + +{ #category : 'evaluating' } +NeoExReqMethodProxyHandler >> afterExecutionWithReceiver: anObject arguments: anArrayOfObjects returnValue: aReturnValue [ + + self postconditionStepReports do: [ :stepReport | + stepReport + verifyPostconditionWithReceiver: anObject + withArguments: anArrayOfObjects ]. + ^ aReturnValue +] + +{ #category : 'evaluating' } +NeoExReqMethodProxyHandler >> beforeExecutionWithReceiver: anObject arguments: anArrayOfObjects [ + + self preconditionStepReports do: [ + :stepReport | + stepReport + verifyPreconditionWithReceiver: anObject + withArguments: anArrayOfObjects ] +] + +{ #category : 'accessing' } +NeoExReqMethodProxyHandler >> postconditionStepReports [ + + ^ postconditionStepReports ifNil: [ postconditionStepReports := OrderedCollection new ]. + +] + +{ #category : 'accessing' } +NeoExReqMethodProxyHandler >> preconditionStepReports [ + + ^ preconditionStepReports ifNil: [ preconditionStepReports := OrderedCollection new ]. + +] diff --git a/src/ExecutableRequirements/NeoExReqPostconditionTracingPoint.class.st b/src/ExecutableRequirements/NeoExReqPostconditionTracingPoint.class.st new file mode 100644 index 0000000..c0ba5d9 --- /dev/null +++ b/src/ExecutableRequirements/NeoExReqPostconditionTracingPoint.class.st @@ -0,0 +1,30 @@ +Class { + #name : 'NeoExReqPostconditionTracingPoint', + #superclass : 'NeoExReqTracingPoint', + #category : 'ExecutableRequirements-Technical', + #package : 'ExecutableRequirements', + #tag : 'Technical' +} + +{ #category : 'accessing' } +NeoExReqPostconditionTracingPoint >> metaLink [ + + ^ super metaLink control: #after; yourself +] + +{ #category : 'as yet unclassified' } +NeoExReqPostconditionTracingPoint >> verifyConditionsWithReceiver: anObject withArguments: aCollection [ + + ^ self + verifyPostconditionsWithReceiver: anObject + withArguments: aCollection +] + +{ #category : 'as yet unclassified' } +NeoExReqPostconditionTracingPoint >> verifyPostconditionsWithReceiver: anObject withArguments: aCollection [ + + self stepReports do: [ :stepReport | + stepReport + verifyPostconditionWithReceiver: anObject + withArguments: aCollection ] +] diff --git a/src/ExecutableRequirements/NeoExReqPreconditionTracingPoint.class.st b/src/ExecutableRequirements/NeoExReqPreconditionTracingPoint.class.st new file mode 100644 index 0000000..61c5c47 --- /dev/null +++ b/src/ExecutableRequirements/NeoExReqPreconditionTracingPoint.class.st @@ -0,0 +1,22 @@ +Class { + #name : 'NeoExReqPreconditionTracingPoint', + #superclass : 'NeoExReqTracingPoint', + #category : 'ExecutableRequirements-Technical', + #package : 'ExecutableRequirements', + #tag : 'Technical' +} + +{ #category : 'as yet unclassified' } +NeoExReqPreconditionTracingPoint >> verifyConditionsWithReceiver: anObject withArguments: aCollection [ + + ^ self verifyPreconditionsWithReceiver: anObject withArguments: aCollection +] + +{ #category : 'as yet unclassified' } +NeoExReqPreconditionTracingPoint >> verifyPreconditionsWithReceiver: anObject withArguments: aCollection [ + + self stepReports do: [ :stepReport | + stepReport + verifyPreconditionWithReceiver: anObject + withArguments: aCollection ] +] diff --git a/src/ExecutableRequirements/NeoExReqTracingPoint.class.st b/src/ExecutableRequirements/NeoExReqTracingPoint.class.st new file mode 100644 index 0000000..d975084 --- /dev/null +++ b/src/ExecutableRequirements/NeoExReqTracingPoint.class.st @@ -0,0 +1,95 @@ +Class { + #name : 'NeoExReqTracingPoint', + #superclass : 'DebugPoint', + #instVars : [ + 'stepReports' + ], + #category : 'ExecutableRequirements-Technical', + #package : 'ExecutableRequirements', + #tag : 'Technical' +} + +{ #category : 'adding' } +NeoExReqTracingPoint >> addStepReport: aStepReport [ + + self stepReports add: aStepReport +] + +{ #category : 'as yet unclassified' } +NeoExReqTracingPoint >> disableInstrumentation [ + + self disable +] + +{ #category : 'as yet unclassified' } +NeoExReqTracingPoint >> enableInstrumentation [ + + self enable +] + +{ #category : 'accessing' } +NeoExReqTracingPoint >> metaLink [ + + ^ MetaLink new + metaObject: self; + options: #( #+ optionCompileOnLinkInstallation ); + selector: #verifyConditionsWithContext:; + arguments: #( context ); + yourself +] + +{ #category : 'accessing' } +NeoExReqTracingPoint >> name [ + + ^ name ifNil: [ #TracingPoint ] +] + +{ #category : 'accessing' } +NeoExReqTracingPoint >> stepReports [ + + ^ stepReports ifNil: [ stepReports := OrderedCollection new ] +] + +{ #category : 'accessing' } +NeoExReqTracingPoint >> stepReports: aCollection [ + + stepReports := aCollection +] + +{ #category : 'accessing' } +NeoExReqTracingPoint >> type [ + + ^ #TracingPoint +] + +{ #category : 'initialization' } +NeoExReqTracingPoint >> uninstall [ + + thisProcess runInMetaLevel: [ self remove ] +] + +{ #category : 'as yet unclassified' } +NeoExReqTracingPoint >> verifyConditionsWithContext: aContext [ + + + "DebugPointManager notifyDebugPointHit: self inContext: aContext." + self enabled ifFalse: [ ^ false ]. + self saveContext: aContext. + (self checkBehaviors allSatisfy: [ :behavior | behavior execute ]) + ifFalse: [ ^ false ]. + self sideEffectBehaviors do: [ :behavior | behavior execute ]. + + self disableInstrumentation. + self + verifyConditionsWithReceiver: aContext receiver + withArguments: aContext arguments. + self enableInstrumentation. + + ^ true +] + +{ #category : 'as yet unclassified' } +NeoExReqTracingPoint >> verifyConditionsWithReceiver: anObject withArguments: aCollection [ + + ^ self subclassResponsibility +]