Audit reflective compatibility helpers against surface model

src/PharoCompatibility-Core/PharoCompatibility.class.st

@@ -9,19 +9,6 @@ Class {
 	#tag : 'Core'
 }
 
-{ #category : 'errors' }
-PharoCompatibility class >> compilationAstFromException: anError [
-
-	| compilationResult |
-	(anError respondsTo: #compilationResult) ifFalse: [ ^ nil ].
-	compilationResult := anError compilationResult.
-	(compilationResult respondsTo: #ast) ifTrue: [
-		^ compilationResult ast ].
-	^ [ compilationResult instVarNamed: 'ast' ]
-		  on: Error
-		  do: [ :ignored | nil ]
-]
-
 { #category : 'accessing' }
 PharoCompatibility class >> currentMajorVersion [
 
@@ -122,29 +109,6 @@ PharoCompatibility class >> loadedSurfaces [
 	^ surfaces asArray
 ]
 
-{ #category : 'errors' }
-PharoCompatibility class >> noticeFromException: anError ifKindOfAnyNamed: classNames [
-
-	| candidate |
-	candidate := anError.
-	(anError respondsTo: #notice) ifTrue: [
-		anError notice ifNotNil: [ :notice | candidate := notice ] ].
-	^ (self object: candidate isKindOfAnyClassNamed: classNames)
-		  ifTrue: [ candidate ]
-		  ifFalse: [ nil ]
-]
-
-{ #category : 'private' }
-PharoCompatibility class >> object: anObject isKindOfAnyClassNamed: classNames [
-
-	classNames do: [ :className |
-		| class |
-		class := Smalltalk at: className ifAbsent: [ nil ].
-		(class notNil and: [ anObject isKindOf: class ]) ifTrue: [
-			^ true ] ].
-	^ false
-]
-
 { #category : 'errors' }
 PharoCompatibility class >> resumeDeprecationsDuring: aBlock [
 
@@ -162,67 +126,13 @@ PharoCompatibility class >> runtimeVersionString [
 	^ SystemVersion current version
 ]
 
-{ #category : 'errors' }
-PharoCompatibility class >> syntaxErrorNoticeClassName [
-
-	| syntaxErrorClass |
-	(Smalltalk at: #OCSyntaxErrorNotice ifAbsent: [ nil ]) ifNotNil: [
-		:ocSyntaxErrorClass |
-		ocSyntaxErrorClass name = #OCSyntaxErrorNotice ifTrue: [
-			^ ocSyntaxErrorClass name asString ] ].
-	syntaxErrorClass := self firstExistingGlobalFrom:
-		                    #( RBSyntaxErrorNotice OCSyntaxErrorNotice
-		                       SyntaxErrorNotification ).
-	^ syntaxErrorClass
-		  ifNil: [ 'SyntaxErrorNotification' ]
-		  ifNotNil: [ syntaxErrorClass name asString ]
-]
-
-{ #category : 'errors' }
-PharoCompatibility class >> syntaxNoticeFromException: anError [
-
-	^ self
-		  noticeFromException: anError
-		  ifKindOfAnyNamed:
-		  { self syntaxErrorNoticeClassName asSymbol }
-]
-
-{ #category : 'errors' }
-PharoCompatibility class >> undeclaredVariableNodeFromException: anError [
-
-	| ast notice |
-	notice := self
-		          noticeFromException: anError
-		          ifKindOfAnyNamed:
-		          #( OCUndeclaredVariableNotice OCUndeclaredVariableWarning ).
-	(notice notNil and: [ notice respondsTo: #node ]) ifTrue: [
-		^ notice node ].
-	ast := self compilationAstFromException: anError.
-	(ast notNil and: [ ast respondsTo: #variableNodes ]) ifFalse: [
-		^ nil ].
-	^ ast variableNodes
-		  detect: [ :node |
-			  | variable |
-			  variable := node variable.
-			  variable notNil and: [
-				  (variable respondsTo: #isUndeclaredVariable) and: [
-					  variable isUndeclaredVariable ] ] ]
-		  ifNone: [ nil ]
-]
-
 { #category : 'authoring' }
 PharoCompatibility class >> withNonInteractiveAuthorNamed: authorName during: aBlock [
 
 	| authorClass fullName |
-	authorClass := Smalltalk at: #Author ifAbsent: [ nil ].
-	authorClass ifNil: [ ^ aBlock value ].
-	(authorClass respondsTo: #fullNamePerSe) ifFalse: [ ^ aBlock value ].
-	fullName := authorClass perform: #fullNamePerSe.
+	authorClass := Smalltalk at: #Author ifAbsent: [ ^ aBlock value ].
+	fullName := authorClass fullNamePerSe.
 	(fullName isNil or: [ fullName isEmpty ]) ifTrue: [
-		(authorClass respondsTo: #useAuthor:during:) ifTrue: [
-			^ authorClass
-				  perform: #useAuthor:during:
-				  with: authorName
-				  with: aBlock ] ].
+		^ authorClass useAuthor: authorName during: aBlock ].
 	^ aBlock value
 ]

src/PharoCompatibility-Pharo12Surface-Pharo13-Tests/PharoCompatibilityP12SurfacePharo13Test.class.st

@@ -12,20 +12,16 @@ Class {
 { #category : 'tests' }
 PharoCompatibilityP12SurfacePharo13Test >> testAuthorCompatibilityProtocol [
 
-	| authorClass observedFullName previousFullName |
+	| observedFullName previousFullName |
 	PharoCompatibility installPharo12Surface.
-	authorClass := Smalltalk at: #Author ifAbsent: [ nil ].
-	self assert: authorClass notNil.
-	self assert: (authorClass respondsTo: #fullNamePerSe).
-	self assert: (authorClass respondsTo: #useAuthor:during:).
-	previousFullName := authorClass fullNamePerSe.
+	previousFullName := PharoCompatibilityAuthor fullNamePerSe.
 	self
-		assert: (authorClass useAuthor: 'MCP' during: [
-				 observedFullName := authorClass fullNamePerSe.
-				 42 ])
+		assert: (PharoCompatibilityAuthor useAuthor: 'MCP' during: [
+			observedFullName := PharoCompatibilityAuthor fullNamePerSe.
+			42 ])
 		equals: 42.
 	self assert: observedFullName equals: 'MCP'.
-	self assert: authorClass fullNamePerSe equals: previousFullName
+	self assert: PharoCompatibilityAuthor fullNamePerSe equals: previousFullName
 ]
 
 { #category : 'tests' }
@@ -38,3 +34,23 @@ PharoCompatibilityP12SurfacePharo13Test >> testInstallPharo12SurfacePreservesMis
 	self assert:
 		(Smalltalk includesKey: #RBPushDownInstanceVariableRefactoring)
 ]
+
+{ #category : 'tests' }
+PharoCompatibilityP12SurfacePharo13Test >> testWithNonInteractiveAuthorUsesShimWhenNoAuthorIsConfigured [
+
+	| observedFullName previousFullName |
+	PharoCompatibility installPharo12Surface.
+	previousFullName := PharoCompatibilityAuthor fullNamePerSe.
+	PharoCompatibilityAuthor fullName: ''.
+	[
+	self
+		assert: (PharoCompatibility
+				withNonInteractiveAuthorNamed: 'MCP'
+				during: [
+					observedFullName := PharoCompatibilityAuthor fullNamePerSe.
+					42 ])
+		equals: 42.
+	self assert: observedFullName equals: 'MCP'.
+	self assert: PharoCompatibilityAuthor fullNamePerSe isEmpty ]
+		ensure: [ PharoCompatibilityAuthor fullName: previousFullName ]
+]

src/PharoCompatibility-Pharo12Surface-Pharo13/PharoCompatibility.extension.st

@@ -41,12 +41,9 @@ PharoCompatibility class >> icebergCommandLineCommitModifiedFilePaths: modifiedF
 { #category : '*PharoCompatibility-Pharo12Surface-Pharo13' }
 PharoCompatibility class >> icebergCommitAuthorName [
 
-	| authorClass fullName |
-	authorClass := Smalltalk at: #Author ifAbsent: [ nil ].
-	(authorClass notNil and: [ authorClass respondsTo: #fullNamePerSe ])
-		ifTrue: [
-			fullName := authorClass perform: #fullNamePerSe.
-			(fullName notNil and: [ fullName notEmpty ]) ifTrue: [ ^ fullName ] ].
+	| fullName |
+	fullName := PharoCompatibilityAuthor fullNamePerSe.
+	(fullName notNil and: [ fullName notEmpty ]) ifTrue: [ ^ fullName ].
 	^ 'PharoCompatibility'
 ]
 

src/PharoCompatibility-Pharo13Surface-Pharo12-Tests/PharoCompatibilityP13SurfacePharo12Test.class.st

@@ -41,3 +41,28 @@ PharoCompatibilityP13SurfacePharo12Test >> testRefactoringChangeManagerClass [
 		assert: PharoCompatibility refactoringChangeManagerClass
 		equals: RBRefactoryChangeManager
 ]
+
+{ #category : 'tests' }
+PharoCompatibilityP13SurfacePharo12Test >> testSyntaxErrorNoticeClassName [
+
+	self
+		assert: PharoCompatibility syntaxErrorNoticeClassName
+		equals: #RBSyntaxErrorNotice
+]
+
+{ #category : 'tests' }
+PharoCompatibilityP13SurfacePharo12Test >> testWithNonInteractiveAuthorUsesAuthorWhenNoAuthorIsConfigured [
+
+	| observedFullName |
+	Author useAuthor: '' during: [
+		self
+			assert:
+				(PharoCompatibility
+					 withNonInteractiveAuthorNamed: 'MCP'
+					 during: [
+						 observedFullName := Author fullNamePerSe.
+						 42 ])
+			equals: 42.
+		self assert: observedFullName equals: 'MCP'.
+		self assert: Author fullNamePerSe isEmpty ]
+]

src/PharoCompatibility-Pharo13Surface-Pharo12/PharoCompatibility.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'PharoCompatibility' }
 
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo12' }
+PharoCompatibility class >> compilationAstFromException: anError [
+
+	^ nil
+]
+
 { #category : '*PharoCompatibility-Pharo13Surface-Pharo12' }
 PharoCompatibility class >> debuggerMethodImplementorForSession: aDebugSession [
 	"Pharo 12 does not provide the Pharo 13 debugger method implementor. Answer nil so callers keep their explicit fallback path instead of probing runtime globals."
@@ -12,3 +18,23 @@ PharoCompatibility class >> refactoringChangeManagerClass [
 
 	^ RBRefactoryChangeManager
 ]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo12' }
+PharoCompatibility class >> syntaxErrorNoticeClassName [
+
+	^ #RBSyntaxErrorNotice
+]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo12' }
+PharoCompatibility class >> syntaxNoticeFromException: anError [
+
+	(anError isKindOf: CodeError) ifFalse: [ ^ nil ].
+	^ anError notice
+]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo12' }
+PharoCompatibility class >> undeclaredVariableNodeFromException: anError [
+
+	(anError isKindOf: OCUndeclaredVariableWarning) ifFalse: [ ^ nil ].
+	^ anError notice node
+]

src/PharoCompatibility-Pharo13Surface-Pharo13-Tests/PharoCompatibilityP13SurfacePharo13Test.class.st

@@ -24,3 +24,11 @@ PharoCompatibilityP13SurfacePharo13Test >> testRefactoringChangeManagerClass [
 		assert: PharoCompatibility refactoringChangeManagerClass
 		equals: RBRefactoryChangeManager
 ]
+
+{ #category : 'tests' }
+PharoCompatibilityP13SurfacePharo13Test >> testSyntaxErrorNoticeClassName [
+
+	self
+		assert: PharoCompatibility syntaxErrorNoticeClassName
+		equals: #OCSyntaxErrorNotice
+]

src/PharoCompatibility-Pharo13Surface-Pharo13/PharoCompatibility.extension.st

@@ -1,5 +1,11 @@
 Extension { #name : 'PharoCompatibility' }
 
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo13' }
+PharoCompatibility class >> compilationAstFromException: anError [
+
+	^ nil
+]
+
 { #category : '*PharoCompatibility-Pharo13Surface-Pharo13' }
 PharoCompatibility class >> debuggerMethodImplementorForSession: aDebugSession [
 
@@ -11,3 +17,21 @@ PharoCompatibility class >> refactoringChangeManagerClass [
 
 	^ RBRefactoryChangeManager
 ]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo13' }
+PharoCompatibility class >> syntaxErrorNoticeClassName [
+
+	^ #OCSyntaxErrorNotice
+]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo13' }
+PharoCompatibility class >> syntaxNoticeFromException: anError [
+
+	^ anError notice
+]
+
+{ #category : '*PharoCompatibility-Pharo13Surface-Pharo13' }
+PharoCompatibility class >> undeclaredVariableNodeFromException: anError [
+
+	^ anError notice node
+]

src/PharoCompatibility-Pharo13Surface-Pharo14-Tests/PharoCompatibilityP13SurfacePharo14Test.class.st

@@ -54,13 +54,9 @@ PharoCompatibilityP13SurfacePharo14Test >> testMetacelloRegistryUnderstandsRegis
 
 	| registration |
 	PharoCompatibility installPharo13Surface.
-	self assert:
-		(MetacelloProjectRegistration registry respondsTo:
-			 #registrationForClassNamed:ifAbsent:).
 	registration := MetacelloProjectRegistration registry
-		                registrationForClassNamed:
-		                'BaselineOfPharoCompatibility'
-		                ifAbsent: [ nil ].
+		registrationForClassNamed: #BaselineOfPharoCompatibility
+		ifAbsent: [ nil ].
 	self assert: registration notNil.
 	self
 		assert: registration projectName asString
@@ -71,21 +67,21 @@ PharoCompatibilityP13SurfacePharo14Test >> testMetacelloRegistryUnderstandsRegis
 PharoCompatibilityP13SurfacePharo14Test >> testMoveClassRefactoringUsesTheClassBeingRepackaged [
 
 	| className packageName targetClass |
-	className := 'PharoCompatibilityP14MoveProbe'.
+	className := #PharoCompatibilityP14MoveProbe.
 	packageName := 'PharoCompatibility-P14-MoveProbe'.
 	[
 	self removeClassNamed: className.
 	self removePackageNamed: packageName.
-	targetClass := (Object << className asSymbol)
-		               package: 'PharoCompatibility-Tests';
-		               tag: 'Tests';
-		               install.
+	targetClass := (Object << className)
+		package: 'PharoCompatibility-Tests';
+		tag: 'Tests';
+		install.
 	(PackageOrganizer default ensurePackage: packageName) ensureTag:
 		'Moved'.
 	(RBMoveClassTransformation
-		 move: className
-		 toPackage: packageName
-		 inTag: 'Moved') execute.
+		move: className
+		toPackage: packageName
+		inTag: 'Moved') execute.
 	self
 		assert: targetClass packageName asString
 		equals: packageName.
@@ -110,6 +106,14 @@ PharoCompatibilityP13SurfacePharo14Test >> testRefactoringChangeManagerClass [
 	self assert: PharoCompatibility refactoringChangeManagerClass equals: ReChangeManager
 ]
 
+{ #category : 'tests' }
+PharoCompatibilityP13SurfacePharo14Test >> testSyntaxErrorNoticeClassName [
+
+	self
+		assert: PharoCompatibility syntaxErrorNoticeClassName
+		equals: #OCSyntaxErrorNotice
+]
+
 { #category : 'tests' }
 PharoCompatibilityP13SurfacePharo14Test >> testUndeclaredVariableNodeFromCompilationError [