diff --git a/src/PharoCompatibility-Core/PharoCompatibility.class.st b/src/PharoCompatibility-Core/PharoCompatibility.class.st index 7b099b9..a87ce05 100644 --- a/src/PharoCompatibility-Core/PharoCompatibility.class.st +++ b/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 ] diff --git a/src/PharoCompatibility-Pharo12Surface-Pharo13-Tests/PharoCompatibilityP12SurfacePharo13Test.class.st b/src/PharoCompatibility-Pharo12Surface-Pharo13-Tests/PharoCompatibilityP12SurfacePharo13Test.class.st index fbd386d..09c1944 100644 --- a/src/PharoCompatibility-Pharo12Surface-Pharo13-Tests/PharoCompatibilityP12SurfacePharo13Test.class.st +++ b/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 ] +] diff --git a/src/PharoCompatibility-Pharo12Surface-Pharo13/PharoCompatibility.extension.st b/src/PharoCompatibility-Pharo12Surface-Pharo13/PharoCompatibility.extension.st index c8eaa6f..1551204 100644 --- a/src/PharoCompatibility-Pharo12Surface-Pharo13/PharoCompatibility.extension.st +++ b/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' ] diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo12-Tests/PharoCompatibilityP13SurfacePharo12Test.class.st b/src/PharoCompatibility-Pharo13Surface-Pharo12-Tests/PharoCompatibilityP13SurfacePharo12Test.class.st index 45d27e4..d08a81c 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo12-Tests/PharoCompatibilityP13SurfacePharo12Test.class.st +++ b/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 ] +] diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo12/PharoCompatibility.extension.st b/src/PharoCompatibility-Pharo13Surface-Pharo12/PharoCompatibility.extension.st index d3f3eeb..6e74c00 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo12/PharoCompatibility.extension.st +++ b/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 +] diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo13-Tests/PharoCompatibilityP13SurfacePharo13Test.class.st b/src/PharoCompatibility-Pharo13Surface-Pharo13-Tests/PharoCompatibilityP13SurfacePharo13Test.class.st index dbbd597..57978a0 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo13-Tests/PharoCompatibilityP13SurfacePharo13Test.class.st +++ b/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 +] diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo13/PharoCompatibility.extension.st b/src/PharoCompatibility-Pharo13Surface-Pharo13/PharoCompatibility.extension.st index 2f683ac..113e60b 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo13/PharoCompatibility.extension.st +++ b/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 +] diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo14-Tests/PharoCompatibilityP13SurfacePharo14Test.class.st b/src/PharoCompatibility-Pharo13Surface-Pharo14-Tests/PharoCompatibilityP13SurfacePharo14Test.class.st index 9989bef..f9d60d1 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo14-Tests/PharoCompatibilityP13SurfacePharo14Test.class.st +++ b/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 [ diff --git a/src/PharoCompatibility-Pharo13Surface-Pharo14/PharoCompatibility.extension.st b/src/PharoCompatibility-Pharo13Surface-Pharo14/PharoCompatibility.extension.st index fb4902e..11f508d 100644 --- a/src/PharoCompatibility-Pharo13Surface-Pharo14/PharoCompatibility.extension.st +++ b/src/PharoCompatibility-Pharo13Surface-Pharo14/PharoCompatibility.extension.st @@ -1,5 +1,11 @@ Extension { #name : 'PharoCompatibility' } +{ #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } +PharoCompatibility class >> compilationAstFromException: anError [ + + ^ anError compilationResult ast +] + { #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } PharoCompatibility class >> debuggerMethodImplementorForSession: aDebugSession [ @@ -11,3 +17,34 @@ PharoCompatibility class >> refactoringChangeManagerClass [ ^ ReChangeManager ] + +{ #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } +PharoCompatibility class >> syntaxErrorNoticeClassName [ + + ^ #OCSyntaxErrorNotice +] + +{ #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } +PharoCompatibility class >> syntaxNoticeFromException: anError [ + + ^ nil +] + +{ #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } +PharoCompatibility class >> undeclaredVariableNodeFromException: anError [ + + ^ self undeclaredVariableNodeInAst: + (anError compilationResult ast) +] + +{ #category : '*PharoCompatibility-Pharo13Surface-Pharo14' } +PharoCompatibility class >> undeclaredVariableNodeInAst: anAst [ + + anAst ifNil: [ ^ nil ]. + ^ anAst variableNodes + detect: [ :node | + | variable | + variable := node variable. + variable notNil and: [ variable isUndeclaredVariable ] ] + ifNone: [ nil ] +] diff --git a/src/PharoCompatibility-Tests/PharoCompatibilityP13SurfaceTest.class.st b/src/PharoCompatibility-Tests/PharoCompatibilityP13SurfaceTest.class.st index 60aded3..76a5a3c 100644 --- a/src/PharoCompatibility-Tests/PharoCompatibilityP13SurfaceTest.class.st +++ b/src/PharoCompatibility-Tests/PharoCompatibilityP13SurfaceTest.class.st @@ -39,6 +39,5 @@ PharoCompatibilityP13SurfaceTest >> assertPharo13SurfaceProvidesLegacyFileStream { #category : 'asserting' } PharoCompatibilityP13SurfaceTest >> assertPharo13SurfaceProvidesMillisecondSemaphoreTimeout [ - self assert: (Semaphore new respondsTo: #waitTimeoutMilliseconds:). self assert: (Semaphore new waitTimeoutMilliseconds: 1) ] diff --git a/src/PharoCompatibility-Tests/PharoCompatibilityTest.class.st b/src/PharoCompatibility-Tests/PharoCompatibilityTest.class.st index 934b783..fee0101 100644 --- a/src/PharoCompatibility-Tests/PharoCompatibilityTest.class.st +++ b/src/PharoCompatibility-Tests/PharoCompatibilityTest.class.st @@ -16,10 +16,3 @@ PharoCompatibilityTest >> testResumeDeprecationsDuringReturnsBlockValue [ assert: (PharoCompatibility resumeDeprecationsDuring: [ 42 ]) equals: 42 ] - -{ #category : 'tests' } -PharoCompatibilityTest >> testSyntaxErrorNoticeClassNameIsConcrete [ - - self assert: PharoCompatibility syntaxErrorNoticeClassName isString. - self deny: PharoCompatibility syntaxErrorNoticeClassName isEmpty -]