Cleanup Requestor

src/AST-Core-Tests/OCCompileCodeSnippetTest.class.st

@@ -7,53 +7,51 @@ Class {
 }
 
 { #category : 'helpers' }
-OCCompileCodeSnippetTest >> compileSnippet: anOCCodeSnippet [ 
-
-	^ [ OpalCompiler new
-		  permitFaulty: true;
-		  isScripting: anOCCodeSnippet isScripting;
-		  compile: anOCCodeSnippet source ]
-	on: OCCodeError do: [ :e |
-		"Compilation should success, because its the *faulty* mode".
-		"If this is expected, then just return nil"
-		anOCCodeSnippet ifSkip: #compile then: [^ nil ].
-		"Otherwise, pass the error"
-		e pass ]
+OCCompileCodeSnippetTest >> compileSnippet: anOCCodeSnippet [
+
+	^ [
+		  OpalCompiler new
+			  permitFaulty: true;
+			  isScripting: anOCCodeSnippet isScripting;
+			  source: anOCCodeSnippet source;
+			  newCompile ]
+		  on: OCCompilationError
+		  do: [ :e | "Compilation should success, because its the *faulty* mode"
+				  anOCCodeSnippet ifSkip: #compile then: [ ^ nil ]. "If this is expected, then just return nil" "Otherwise, pass the error"
+				  e pass ]
 ]
 
 { #category : 'helpers' }
 OCCompileCodeSnippetTest >> compileSnippet: aSnippet onError: errorBlock [
 
 	^ [
-	  OpalCompiler new
-		  isScripting: aSnippet isScripting;
-		  compile: aSnippet source ]
-		  on: OCCodeError
+		  OpalCompiler new
+			  isScripting: aSnippet isScripting;
+			  source: aSnippet source;
+			  newCompile ]
+		  on: OCCompilationError
 		  do: [ :e | errorBlock cull: e ]
 ]
 
 { #category : 'tests' }
 OCCompileCodeSnippetTest >> testCompileFailBlock [
 
-	| method error |
-	error := nil.
-	method := OpalCompiler new
-		          isScripting: snippet isScripting;
-		          failBlock: [ :e |
-			          self assert: (snippet hasNotice: e).
-			          self assert: error isNil. "single invocation"
-			          error := e.
-			          #tag ];
-		          compile: snippet source.
+	| compilationResult |
+	compilationResult := OpalCompiler new
+		                     isScripting: snippet isScripting;
+		                     source: snippet source;
+		                     doCompile.
+
+	compilationResult isError ifTrue: [ 
+		compilationResult ast allNotices do: [ :n | 
+			self assert: (snippet hasNotice: n) ] ].
 
 	snippet isFaulty
-		ifTrue: [
-			self assert: error isNotNil.
-			self assert: method equals: #tag ]
+		ifTrue: [ self assert: compilationResult isError ]
 		ifFalse: [
-			self assert: error isNil.
-			self assert: method isCompiledMethod.
-			self testExecute: method ]
+				self deny: compilationResult isError.
+				self assert: compilationResult compiledMethod isCompiledMethod.
+				self testExecute: compilationResult compiledMethod ]
 ]
 
 { #category : 'tests' }
@@ -83,87 +81,63 @@ OCCompileCodeSnippetTest >> testCompileFaulty [
 { #category : 'tests' }
 OCCompileCodeSnippetTest >> testCompileOnError [
 
-	| method error |
-	error := nil.
+	| method |
 	method := self compileSnippet: snippet onError: [ :e |
-		          self assert:
-			          (snippet hasNotice: e messageText at: e position).
-		          self assert: error isNil. "single invocation"
-		          error := e ].
+		e compilationResult ast allNotices do: [ :n |
+			self assert: (snippet hasNotice: n).
+		].
+		^ self
+	].
+
 	snippet isFaulty
-		ifTrue: [ self assert: error isNotNil ]
+		ifTrue: [ self fail ]
 		ifFalse: [
-			self assert: error isNil.
-			self assert: method isCompiledMethod.
-			self testExecute: method ]
-]
-
-{ #category : 'tests' }
-OCCompileCodeSnippetTest >> testCompileOnErrorResume [
-
-	| method error |
-	error := nil.
-	method := self compileSnippet: snippet onError: [ :e |
-		          self assert:
-			          (snippet hasNotice: e messageText at: e position).
-		          error := e.
-		          e resume ].
-	self assert: snippet isFaulty equals: error isNotNil.
-	self assert: method isCompiledMethod.
-	self testExecute: method
+				self assert: method isCompiledMethod.
+				self testExecute: method ]
 ]
 
 { #category : 'tests' }
 OCCompileCodeSnippetTest >> testCompileUndeclaredFaultyFailBlock [
 
-	| method error |
-	error := nil.
-	method := OpalCompiler new
-		          isScripting: snippet isScripting;
-		          permitUndeclared: true;
-		          failBlock: [ :e |
-			          self assert: (snippet hasNotice: e).
-			          self assert: error isNil. "single invocation"
-			          error := e.
-			          #tag ];
-		          compile: snippet source.
+	| compilationResult |
+	compilationResult := OpalCompiler new
+		                     isScripting: snippet isScripting;
+		                     permitUndeclared: true;
+		                     source: snippet source;
+		                     doCompile.
+	compilationResult isError ifTrue: [
+		compilationResult ast allNotices do: [ :n |
+			self assert: (snippet hasNotice: n)
+	]].
 
 	snippet isFaultyMinusUndeclared
-		ifTrue: [
-			self assert: error isNotNil.
-			self assert: method equals: #tag ]
+		ifTrue: [ self assert: compilationResult isError ]
 		ifFalse: [
-			self assert: error isNil.
-			self assert: method isCompiledMethod.
-			self testExecute: method ]
+				self deny: compilationResult isError.
+				self assert: compilationResult compiledMethod isCompiledMethod.
+				self testExecute: compilationResult compiledMethod ]
 ]
 
 { #category : 'tests' }
 OCCompileCodeSnippetTest >> testCompileWithRequestor [
 
-	| requestor method |
-	requestor := OCMockRequestor new.
-	requestor interactive: false.
-	requestor isScripting: nil.
-	requestor text: nil.
-	method := OpalCompiler new
-		          isScripting: snippet isScripting;
-		          requestor: requestor;
-		          failBlock: [ "When a requestion is set, a failBlock MUST also be set or compilation might crash internally"
-			          | n |
-			          self assert: requestor notifyList size equals: 1.
-			          n := requestor notifyList first.
-			          self assert:
-					          (snippet
-						           hasNotice: (n first allButLast: 3)
-						           at: n second).
-			          self assert: snippet isFaulty.
-			          ^ self ];
-		          compile: snippet source.
-
-	"Still alive? (failBlock never called)"
+	| method compilationResult |
+	compilationResult := OpalCompiler new
+		                     isScripting: snippet isScripting;
+		                     source: snippet source;
+		                     doCompile.
+	compilationResult isError ifTrue: [
+			self assert: snippet isFaulty.
+			compilationResult ast allNotices do: [ :n |
+				self assert: (snippet hasNotice: n messageText at: n position) ].
+		"We verified the error case, exit"
+		^ self
+	].
+
+	"Now verify the success case"
 	self deny: snippet isFaulty.
-	self assert: requestor notifyList isEmpty.
+
+	method := compilationResult compiledMethod.
 	self assert: method isCompiledMethod.
 	self testExecute: method
 ]
@@ -226,7 +200,7 @@ OCCompileCodeSnippetTest >> testDump [
 	| ast dump ast2 dump2 |
 	ast := snippet parse.
 	dump := ast dump.
-	ast2 := OpalCompiler new evaluate: dump.
+	ast2 := OpalEvaluator new evaluate: dump.
 	self assert: ast2 equals: ast.
 	dump2 := ast2 dump.
 	self assert: dump2 equals: dump

src/AST-Core/OCErrorNotice.class.st

@@ -14,3 +14,22 @@ OCErrorNotice >> isError [
 
 	^ true
 ]
+
+{ #category : 'testing' }
+OCErrorNotice >> isErrorOn: anOpalCompiler [ 
+
+	| permitFaulty |	
+	"I'm an error if the compiler does not allow faults.
+	Otherwise, I'm a warning"
+
+	"I'm an error if the setting is not set"
+	permitFaulty := anOpalCompiler permitFaulty.
+	^ permitFaulty ifNil: [ true ]
+		ifNotNil: [ permitFaulty not ]
+]
+
+{ #category : 'testing' }
+OCErrorNotice >> isWarningOn: anOpalCompiler [
+
+	^ (self isErrorOn: anOpalCompiler) not
+]

src/AST-Core/OCNotice.class.st

@@ -72,6 +72,12 @@ OCNotice >> isError [
 	^ false
 ]
 
+{ #category : 'testing' }
+OCNotice >> isErrorOn: anOpalCompiler [
+
+	^ false
+]
+
 { #category : 'testing' }
 OCNotice >> isSyntaxError [
 
@@ -90,6 +96,12 @@ OCNotice >> isWarning [
 	^ false
 ]
 
+{ #category : 'testing' }
+OCNotice >> isWarningOn: anOpalCompiler [ 
+
+	^ (self isErrorOn: anOpalCompiler) not
+]
+
 { #category : 'accessing' }
 OCNotice >> messageText [
 

src/Calypso-SystemQueries/ClySystemEnvironment.class.st

@@ -135,7 +135,6 @@ ClySystemEnvironment >> compileANewClassFrom: newClassDefinitionString notifying
 	compiler := (self classCompilerFor: oldClass)
 		            source: newClassDefinitionString;
 		            requestor: aController;
-		            failBlock: [ ^ nil ];
 		            logged: true.
 
 	[newClass := compiler evaluate] 

src/CodeImport-Commands/ClapCodeEvaluator.class.st

@@ -102,7 +102,7 @@ ClapCodeEvaluator >> evaluate [
 { #category : 'execution' }
 ClapCodeEvaluator >> evaluateExpression [
 
-	^ [ self class compiler evaluate: self source ]
+	^ [ OpalEvaluator new evaluate: self source ]
 		on: Error
 		do: [ :error | self handleError: error ]
 ]

src/Debugger-Model-Tests/OCSourceCode2BytecodeTest.class.st

@@ -23,11 +23,12 @@ OCSourceCode2BytecodeTest class >> classVar [
 
 { #category : 'compiling' }
 OCSourceCode2BytecodeTest >> compile2method: sourceStream [
-			"Compile code without logging the source in the changes file"
-			^OpalCompiler new
-						source: sourceStream;
-						class: self class;
-						compile
+	"Compile code without logging the source in the changes file"
+
+	^ OpalCompiler new
+		  source: sourceStream;
+		  class: self class;
+		  newCompile
 ]
 
 { #category : 'accessing' }

src/Debugger-Model/DebugContext.class.st

@@ -161,26 +161,44 @@ DebugContext >> recompileCurrentMethodTo: aText notifying: aNotifyer [
 
 	| classOrTraitOfMethod selector |
 	self context method isDoIt ifFalse: [
-		selector := self selectedClass compiler parseSelector: aText.
-		(self checkSelectorUnchanged: selector) ifFalse: [ ^ nil ] ].
+			selector := self selectedClass compiler parseSelector: aText.
+			(self checkSelectorUnchanged: selector) ifFalse: [ ^ nil ] ].
 
 	(self selectedClass includesSelector: selector) ifFalse: [
-		^ self selectedClass compiler
-			  protocol: self selectedMessageCategoryName;
-			  isScripting: self selectedMessageName isDoIt;
-			  requestor: aNotifyer;
-			  compile: aText ].
-
-	classOrTraitOfMethod := self
-		                        confirmOnTraitOverwrite: selector
-		                        inClass: self selectedClass.
+			self selectedMessageName isDoIt
+				ifTrue: [
+						self selectedClass compiler
+							protocol: self selectedMessageCategoryName;
+							isScripting: self selectedMessageName isDoIt;
+							requestor: aNotifyer;
+							compile: aText ]
+				ifFalse: [
+						self selectedClass
+							compile: aText asString
+							classified: self selectedMessageCategoryName
+							withStamp: DateAndTime now
+							notifying: aNotifyer
+							logSource: self selectedClass shouldLogSource ].
+			^ self selectedClass >> self selectedMessageName ].
+
+	classOrTraitOfMethod := self confirmOnTraitOverwrite: selector inClass: self selectedClass.
 	classOrTraitOfMethod ifNil: [ ^ nil ].
 
-	^ classOrTraitOfMethod compiler
-		  protocol: self selectedMessageCategoryName;
-		  isScripting: self selectedMessageName isDoIt;
-		  requestor: aNotifyer;
-		  install: aText
+	self selectedMessageName isDoIt
+		ifTrue: [
+				classOrTraitOfMethod compiler
+					protocol: self selectedMessageCategoryName;
+					isScripting: self selectedMessageName isDoIt;
+					requestor: aNotifyer;
+					compile: aText ]
+		ifFalse: [
+				classOrTraitOfMethod
+					compile: aText asString
+					classified: self selectedMessageCategoryName
+					withStamp: DateAndTime now
+					notifying: aNotifyer
+					logSource: classOrTraitOfMethod shouldLogSource ].
+	^ classOrTraitOfMethod >> self selectedMessageName
 ]
 
 { #category : 'accessing' }