From d5fd32a26b622edceb996ecbe45484eca8a4a6b3 Mon Sep 17 00:00:00 2001
From: Marcus Denker <marcus.denker@inria.fr>
Date: Mon, 11 Oct 2021 13:11:57 +0200
Subject: [PATCH] - move #originalName from RPackage to kernel - implement
 #nonObsoleteClass in terms of #originalName - add a test

- implement obsoleteClasses to use #isObsolete

fixes #10144
---
 src/Kernel-Tests/BehaviorTest.class.st       |  6 ++++++
 src/Kernel/Behavior.class.st                 | 13 ++++++++-----
 src/Kernel/Metaclass.class.st                |  2 +-
 src/RPackage-Core/Behavior.extension.st      |  8 --------
 src/System-Support/SystemNavigation.class.st |  8 ++++----
 5 files changed, 19 insertions(+), 18 deletions(-)
 delete mode 100644 src/RPackage-Core/Behavior.extension.st

diff --git a/src/Kernel-Tests/BehaviorTest.class.st b/src/Kernel-Tests/BehaviorTest.class.st
index ec51958b011..0e50d6fc426 100644
--- a/src/Kernel-Tests/BehaviorTest.class.st
+++ b/src/Kernel-Tests/BehaviorTest.class.st
@@ -209,6 +209,12 @@ BehaviorTest >> testMethodsWritingSlot [
 	self assert: numberViaSlot equals: numberViaIVar
 ]
 
+{ #category : #tests }
+BehaviorTest >> testNonObsoleteClass [
+	"Does it work on not-obsolete classes?"
+	self assert: Object nonObsoleteClass equals: Object
+]
+
 { #category : #'tests - properties' }
 BehaviorTest >> testPropertyValueAtPut [
 	| testValue |
diff --git a/src/Kernel/Behavior.class.st b/src/Kernel/Behavior.class.st
index c76e1851583..92d1ee20692 100644
--- a/src/Kernel/Behavior.class.st
+++ b/src/Kernel/Behavior.class.st
@@ -1268,11 +1268,7 @@ Behavior >> new: sizeRequested [
 Behavior >> nonObsoleteClass [
 	"Attempt to find and return the current version of this obsolete class"
 
-	| obsName |
-	obsName := self name.
-	[obsName beginsWith: 'AnObsolete']
-		whileTrue: [obsName := obsName copyFrom: 'AnObsolete' size + 1 to: obsName size].
-	^ self environment at: obsName asSymbol
+	^ self environment at: self originalName
 ]
 
 { #category : #initialization }
@@ -1288,6 +1284,13 @@ Behavior >> obsoleteSubclasses [
 	^ obs copyWithout: nil
 ]
 
+{ #category : #initialization }
+Behavior >> originalName [
+	^ ((self isObsolete and: [ self name beginsWith: 'AnObsolete' ])
+		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) ]
+		ifFalse:  [ self name ]) asSymbol
+]
+
 { #category : #copying }
 Behavior >> postCopy [
 	super postCopy.
diff --git a/src/Kernel/Metaclass.class.st b/src/Kernel/Metaclass.class.st
index 4298043b824..182e91850c0 100644
--- a/src/Kernel/Metaclass.class.st
+++ b/src/Kernel/Metaclass.class.st
@@ -191,7 +191,7 @@ Metaclass >> isMetaclassOfClassOrNil [
 { #category : #testing }
 Metaclass >> isObsolete [
 	"Return true if the receiver is obsolete"
-	^self soleInstance == nil "Either no thisClass"
+	^self soleInstance isNil "Either no thisClass"
 		or:[self soleInstance classSide ~~ self "or I am not the class of thisClass"
 			or:[self soleInstance isObsolete]] "or my instance is obsolete"
 ]
diff --git a/src/RPackage-Core/Behavior.extension.st b/src/RPackage-Core/Behavior.extension.st
deleted file mode 100644
index 4d40f25a3d7..00000000000
--- a/src/RPackage-Core/Behavior.extension.st
+++ /dev/null
@@ -1,8 +0,0 @@
-Extension { #name : #Behavior }
-
-{ #category : #'*Rpackage-Core' }
-Behavior >> originalName [
-	^ ((self isObsolete and: [ self name beginsWith: 'AnObsolete' ])
-		ifTrue: [ (self name copyFrom:   'AnObsolete' size + 1 to: self name size ) ]
-		ifFalse:  [ self name ]) asSymbol
-]
diff --git a/src/System-Support/SystemNavigation.class.st b/src/System-Support/SystemNavigation.class.st
index 03f68db59aa..2ae54dffa43 100644
--- a/src/System-Support/SystemNavigation.class.st
+++ b/src/System-Support/SystemNavigation.class.st
@@ -368,22 +368,22 @@ SystemNavigation >> obsoleteClasses [
 		allInstancesDo: [ :m | 
 			| c |
 			c := m soleInstance.
-			(c notNil and: [ 'AnOb*' match: c name asString ])
+			(c notNil and: [ c isObsolete ])
 				ifTrue: [ obs add: c ] ].
 	^ obs asArray	
 		
 "Likely in a ClassDict or Pool...
-(Association allInstances select: [:a | (a value isKindOf: Class) and: ['AnOb*' match: a value name]]) asArray
+(Association allInstances select: [:a | (a value isKindOf: Class) and: [a value isObsolete]]) asArray
 "	
 	
 "Obsolete class refs or super pointer in last lit of a method...
 | n l found |
-Smalltalk browseAllSelect:
+SystemNavigation new browseAllSelect:
 	[:m | found := false.
 	1 to: m numLiterals do:
 		[:i | (((l := m literalAt: i) isMemberOf: Association)
 				and: [(l value isKindOf: Behavior)
-				and: ['AnOb*' match: l value name]])
+				and: [l value isObsolete]])
 			ifTrue: [found := true]].
 	found]
 "