Merge pull request #18082 from tesonep/helping-to-test-refactorings

Improving Refactorins

Author: tesonep

src/Refactoring-Environment/RBBrowserEnvironment.class.st

@@ -57,6 +57,16 @@ RBBrowserEnvironment >> & anEnvironment [
 	^RBAndEnvironment onEnvironment: self and: anEnvironment
 ]
 
+{ #category : 'comparing' }
+RBBrowserEnvironment >> = anotherObject [
+
+	self == anotherObject ifTrue: [ ^ true ].
+
+	"The default browser environment is always equals to other default"
+
+	^ self class = anotherObject class
+]
+
 { #category : 'accessing' }
 RBBrowserEnvironment >> accessGuard [
 	^ accessGuard ifNil: [ accessGuard := Mutex new ]
@@ -357,6 +367,12 @@ RBBrowserEnvironment >> handleSystemChange: aSystemAnnouncement [
 		todoList remove: anyResult]
 ]
 
+{ #category : 'comparing' }
+RBBrowserEnvironment >> hash [ 
+	
+	^ self class hash
+]
+
 { #category : 'environments' }
 RBBrowserEnvironment >> implementorsMatching: aString [
 	^RBSelectorEnvironment implementorsMatching: aString in: self

src/Refactoring-Environment/RBBrowserEnvironmentWrapper.class.st

@@ -27,6 +27,12 @@ RBBrowserEnvironmentWrapper class >> onEnvironment: anEnvironment [
 		yourself
 ]
 
+{ #category : 'comparing' }
+RBBrowserEnvironmentWrapper >> = anotherEnvironment [
+
+	^ self == anotherEnvironment or: [anotherEnvironment class = self class and: [ environment = anotherEnvironment environment ]]
+]
+
 { #category : 'visiting' }
 RBBrowserEnvironmentWrapper >> acceptVisitor: aProgramNodeVisitor [
 
@@ -69,6 +75,12 @@ RBBrowserEnvironmentWrapper >> environment [
 	^ environment
 ]
 
+{ #category : 'comparing' }
+RBBrowserEnvironmentWrapper >> hash [ 
+
+	^ environment hash
+]
+
 { #category : 'testing' }
 RBBrowserEnvironmentWrapper >> includesClass: aClass [
 	^environment includesClass: aClass

src/Refactoring-Environment/RBClassEnvironment.class.st

@@ -43,6 +43,17 @@ RBClassEnvironment class >> onEnvironment: anEnvironment classes: aCollection [
 		classes: aCollection; yourself
 ]
 
+{ #category : 'comparing' }
+RBClassEnvironment >> = anotherEnvironment [
+
+	self == anotherEnvironment 
+		ifTrue: [ ^ true ].
+	
+	anotherEnvironment class = self class ifFalse: [ ^ false ].
+	
+	^ environment = anotherEnvironment environment and: [ classes = anotherEnvironment classesOnEnvironment and: [ metaClasses = anotherEnvironment metaClasses ] ]
+]
+
 { #category : 'adding' }
 RBClassEnvironment >> addClass: aClass [
 	aClass isMeta
@@ -110,6 +121,12 @@ RBClassEnvironment >> classesDo: aBlock [
 			ifTrue: [ aBlock value: class classSide ] ]
 ]
 
+{ #category : 'accessing' }
+RBClassEnvironment >> classesOnEnvironment [ 
+
+	^ classes
+]
+
 { #category : 'private' }
 RBClassEnvironment >> defaultLabel [
 	| stream |
@@ -127,6 +144,12 @@ RBClassEnvironment >> definesClass: aClass [
 	^ self includesClass: aClass
 ]
 
+{ #category : 'comparing' }
+RBClassEnvironment >> hash [ 
+	
+	^ super hash bitXor: (classes hash bitXor: metaClasses hash)
+]
+
 { #category : 'testing' }
 RBClassEnvironment >> includesClass: aClass [
 	^(aClass isMeta
@@ -162,6 +185,12 @@ RBClassEnvironment >> metaClassSelectorDictionary [
 				yourself ]
 ]
 
+{ #category : 'accessing' }
+RBClassEnvironment >> metaClasses [ 
+
+	^ metaClasses 
+]
+
 { #category : 'accessing - classes' }
 RBClassEnvironment >> orphanClasses [
 

src/Refactoring-Environment/RBClassHierarchiesEnvironment.class.st

@@ -43,6 +43,17 @@ RBClassHierarchiesEnvironment class >> onEnvironment: anEnvironment classes: aCo
 		classes: aCollection; yourself
 ]
 
+{ #category : 'comparing' }
+RBClassHierarchiesEnvironment >> = anotherEnvironment [
+
+	self == anotherEnvironment 
+		ifTrue: [ ^ true ].
+	
+	anotherEnvironment class = self class ifFalse: [ ^ false ].
+	
+	^ environment = anotherEnvironment environment and: [ classes = anotherEnvironment classesOnEnvironment and: [ metaClasses = anotherEnvironment metaClasses ] ]
+]
+
 { #category : 'adding' }
 RBClassHierarchiesEnvironment >> addClass: aClass [
 	aClass isMeta
@@ -112,6 +123,12 @@ RBClassHierarchiesEnvironment >> classesDo: aBlock [
 			ifTrue: [ aBlock value: class classSide ] ]
 ]
 
+{ #category : 'accessing' }
+RBClassHierarchiesEnvironment >> classesOnEnvironment [
+
+	^ classes
+]
+
 { #category : 'private' }
 RBClassHierarchiesEnvironment >> defaultLabel [
 	| stream |
@@ -129,6 +146,12 @@ RBClassHierarchiesEnvironment >> definesClass: aClass [
 	^ self includesClass: aClass
 ]
 
+{ #category : 'comparing' }
+RBClassHierarchiesEnvironment >> hash [ 
+	
+	^ super hash bitXor: (classes hash bitXor: metaClasses hash)
+]
+
 { #category : 'testing' }
 RBClassHierarchiesEnvironment >> includesClass: aClass [
 	^(aClass isMeta
@@ -164,6 +187,12 @@ RBClassHierarchiesEnvironment >> metaClassSelectorDictionary [
 				yourself ]
 ]
 
+{ #category : 'accessing' }
+RBClassHierarchiesEnvironment >> metaClasses [ 
+
+	^ metaClasses 
+]
+
 { #category : 'copying' }
 RBClassHierarchiesEnvironment >> postCopy [
 	super postCopy.

src/Refactoring-Environment/RBClassHierarchyEnvironment.class.st

@@ -34,6 +34,17 @@ RBClassHierarchyEnvironment class >> onEnvironment: anEnvironment class: aClass
 		yourself
 ]
 
+{ #category : 'comparing' }
+RBClassHierarchyEnvironment >> = anotherEnvironment [
+
+	self == anotherEnvironment 
+		ifTrue: [ ^ true ].
+	
+	anotherEnvironment class = self class ifFalse: [ ^ false ].
+	
+	^ environment = anotherEnvironment environment and: [ class = anotherEnvironment hierarchyClass ]
+]
+
 { #category : 'accessing' }
 RBClassHierarchyEnvironment >> basisObjects [
 	^ { class }
@@ -51,6 +62,18 @@ RBClassHierarchyEnvironment >> definesClass: aClass [
 			[ aClass inheritsFrom: class ] ]) and: [super definesClass: aClass]
 ]
 
+{ #category : 'comparing' }
+RBClassHierarchyEnvironment >> hash [
+
+	^ super hash bitXor: class hash
+]
+
+{ #category : 'accessing' }
+RBClassHierarchyEnvironment >> hierarchyClass [
+
+	^ class
+]
+
 { #category : 'testing' }
 RBClassHierarchyEnvironment >> includesClass: aClass [
 	^ (aClass == class or:

src/Refactoring-Environment/RBCompositeEnvironment.class.st

@@ -8,6 +8,15 @@ Class {
 	#package : 'Refactoring-Environment'
 }
 
+{ #category : 'comparing' }
+RBCompositeEnvironment >> = anObject [
+	"Answer whether the receiver and anObject represent the same object."
+
+	self == anObject ifTrue: [ ^ true ].
+	self class = anObject class ifFalse: [ ^ false ].
+	^ environment = anObject environment and: [otherEnvironment = anObject otherEnvironment]
+]
+
 { #category : 'description' }
 RBCompositeEnvironment >> description [
 
@@ -16,6 +25,13 @@ RBCompositeEnvironment >> description [
 		  , (otherEnvironment descriptionUntil: 15) ]
 ]
 
+{ #category : 'comparing' }
+RBCompositeEnvironment >> hash [
+	"Answer an integer value that is related to the identity of the receiver."
+
+	^ otherEnvironment hash
+]
+
 { #category : 'testing' }
 RBCompositeEnvironment >> isCompositeEnvironment [
 	^ true

src/Refactoring-Environment/RBPackageEnvironment.class.st

@@ -60,6 +60,16 @@ RBPackageEnvironment class >> packages: aCollection [
 		packages: aCollection
 ]
 
+{ #category : 'comparing' }
+RBPackageEnvironment >> = anObject [
+	"Answer whether the receiver and anObject represent the same object."
+
+	self == anObject ifTrue: [ ^ true ].
+	self class = anObject class ifFalse: [ ^ false ].
+	^ environment = anObject environment and: [
+		  packages = anObject packages ]
+]
+
 { #category : 'adding' }
 RBPackageEnvironment >> addPackage: aSymbol [
 	packages add: aSymbol
@@ -105,6 +115,13 @@ RBPackageEnvironment >> definesClass: aClass [
 	^ (super definesClass: aClass) and: [ self packages anySatisfy: [ :package | package includesClass: aClass ] ]
 ]
 
+{ #category : 'comparing' }
+RBPackageEnvironment >> hash [
+	"Answer an integer value that is related to the identity of the receiver."
+
+	^ packages hash
+]
+
 { #category : 'testing' }
 RBPackageEnvironment >> includesClass: aClass [
 

src/Refactoring-Environment/RBPragmaEnvironment.class.st

@@ -34,6 +34,17 @@ RBPragmaEnvironment class >> onEnvironment: anEnvironment keywords: aKeywordColl
 		yourself
 ]
 
+{ #category : 'comparing' }
+RBPragmaEnvironment >> = anObject [
+	"Answer whether the receiver and anObject represent the same object."
+
+	self == anObject ifTrue: [ ^ true ].
+	self class = anObject class ifFalse: [ ^ false ].
+	^ environment = anObject environment and: [
+			  keywords = anObject basisObjects and: [
+				  condition = anObject condition ] ]
+]
+
 { #category : 'adding' }
 RBPragmaEnvironment >> addKeyword: aSymbol [
 	keywords add: aSymbol
@@ -44,6 +55,12 @@ RBPragmaEnvironment >> basisObjects [
 	^ keywords
 ]
 
+{ #category : 'accessing' }
+RBPragmaEnvironment >> condition [
+
+	^ condition
+]
+
 { #category : 'initialization' }
 RBPragmaEnvironment >> condition: aBlock [
 	condition := aBlock
@@ -57,6 +74,13 @@ RBPragmaEnvironment >> defaultLabel [
 	^ stream contents
 ]
 
+{ #category : 'comparing' }
+RBPragmaEnvironment >> hash [
+	"Answer an integer value that is related to the identity of the receiver."
+
+	^ keywords hash bitXor: condition hash
+]
+
 { #category : 'testing' }
 RBPragmaEnvironment >> includesClass: aClass [
 	^ (environment includesClass: aClass) and: [ aClass selectors anySatisfy: [ :each | self includesSelector: each in: aClass ] ]

src/Refactoring-Environment/RBProtocolEnvironment.class.st

@@ -34,6 +34,17 @@ RBProtocolEnvironment class >> onEnvironment: anEnvironment class: aClass protoc
 		class: aClass protocols: aCollection; yourself
 ]
 
+{ #category : 'comparing' }
+RBProtocolEnvironment >> = anObject [
+	"Answer whether the receiver and anObject represent the same object."
+
+	self == anObject ifTrue: [ ^ true ].
+	self class = anObject class ifFalse: [ ^ false ].
+	^ environment = anObject environment and: [
+		  class = anObject definedClass and: [
+			  protocols = anObject protocols ] ]
+]
+
 { #category : 'adding' }
 RBProtocolEnvironment >> addProtocol: aSymbol [
 	protocols add: aSymbol
@@ -79,6 +90,13 @@ RBProtocolEnvironment >> description [
 	^ label ifNil: [self defaultName , ' of ', self class name, self descriptionBasis]
 ]
 
+{ #category : 'comparing' }
+RBProtocolEnvironment >> hash [
+	"Answer an integer value that is related to the identity of the receiver."
+
+	^ class hash bitXor: protocols hash
+]
+
 { #category : 'testing' }
 RBProtocolEnvironment >> includesClass: aClass [
 	^ aClass == class and: [super includesClass: aClass]