Migrated Equals from SmalltalkHub

BaselineOfEquals/package.st

@@ -0,0 +1 @@
+Package { #name : #BaselineOfEquals }

Equals/Apple.class.st

@@ -0,0 +1,25 @@
+Class {
+	#name : #Apple,
+	#superclass : #Fruit,
+	#instVars : [
+		'color'
+	],
+	#category : #'Equals-Examples'
+}
+
+{ #category : #'instance creation' }
+Apple class >> color: aColor [
+	^self new
+		color: aColor;
+		yourself
+]
+
+{ #category : #accessing }
+Apple >> color [
+	^ color
+]
+
+{ #category : #accessing }
+Apple >> color: anObject [
+	color := anObject
+]

Equals/Banana.class.st

@@ -0,0 +1,10 @@
+Class {
+	#name : #Banana,
+	#superclass : #Fruit,
+	#category : #'Equals-Examples'
+}
+
+{ #category : #accessing }
+Banana >> color [
+	^Color yellow
+]

Equals/ComparableObjectForEqualityTest.class.st

@@ -0,0 +1,7 @@
+Class {
+	#name : #ComparableObjectForEqualityTest,
+	#superclass : #Object,
+	#traits : 'TEquality',
+	#classTraits : 'TEquality classTrait',
+	#category : #'Equals-Test'
+}

Equals/Comparisons.class.st

@@ -0,0 +1,17 @@
+Class {
+	#name : #Comparisons,
+	#superclass : #Object,
+	#category : #'Equals-Examples'
+}
+
+{ #category : #displaying }
+Comparisons class >> display: aBoolean [
+	| displayColor displayLabel |
+	displayLabel := aBoolean ifTrue: [ 'Equal' ] ifFalse: [ 'Different' ].
+	displayColor := aBoolean ifTrue: [ Color green ] ifFalse: [ Color yellow ].
+	GrowlMorph 
+		openWithLabel: displayLabel
+		contents: ''
+		backgroundColor: displayColor
+		labelColor: Color black
+]

Equals/EqualityTest.class.st

@@ -0,0 +1,125 @@
+Class {
+	#name : #EqualityTest,
+	#superclass : #TestCase,
+	#instVars : [
+		'classFactory'
+	],
+	#category : #'Equals-Test'
+}
+
+{ #category : #'setUp-tearDown' }
+EqualityTest >> setUp [
+	super setUp.
+	classFactory := ClassFactoryForTestCase new.
+
+]
+
+{ #category : #'setUp-tearDown' }
+EqualityTest >> tearDown [
+	super tearDown.
+	classFactory cleanUp
+
+]
+
+{ #category : #testing }
+EqualityTest >> testSetContainsOnlyOneInstanceOfAClassWithIVs [
+	| set object class |
+	class  := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: 'x y' classVariableNames:  ''.
+	class compile: 'x: newX y: newY
+		x := newX.
+		y := newY'.
+	class class compile: 'x: newX y: newY
+		^self new
+			x: newX y: newY;
+			yourself'.
+	set := Set new.
+	10 timesRepeat: [
+		object  := class x: 1 y: 2.
+		set add: object].
+	self assert: set size = 1.
+
+]
+
+{ #category : #testing }
+EqualityTest >> testSetContainsOnlyOneInstanceOfAClassWithNoIVs [
+	| set |
+	set := Set new.
+	10 timesRepeat: [set add: ComparableObjectForEqualityTest new].
+	self assert: set size = 1.
+	self assert: (set includes: ComparableObjectForEqualityTest new)
+
+]
+
+{ #category : #testing }
+EqualityTest >> testSetContainsTwoInstancesOfTwoDiffrentClassesWithIVs [
+	| set otherClass yetAnotherClass |
+	otherClass := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: 'x y' classVariableNames:  ''.
+	yetAnotherClass := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: 'x y' classVariableNames:  ''.
+	{otherClass. yetAnotherClass} do: [:class|
+		class compile: 'x: newX y: newY
+			x := newX.
+			y := newY'.
+		class class compile: 'x: newX y: newY
+			^self new
+				x: newX y: newY;
+				yourself'.
+	].
+	set := Set with: (otherClass x: 'abc' y: 123) with: (yetAnotherClass x: 'abc' y: 123).
+	self assert: set size = 2.
+	self assert: (set includes: (otherClass x: 'abc' y: 123)).
+	self assert: (set includes: (yetAnotherClass x: 'abc' y: 123)).
+
+]
+
+{ #category : #testing }
+EqualityTest >> testSetContainsTwoInstancesOfTwoDiffrentClassesWithNoIVs [
+	| set otherClass |
+	otherClass := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: '' classVariableNames:  ''.
+	set := Set with: ComparableObjectForEqualityTest new with: otherClass new.
+	self assert: set size = 2.
+	self assert: (set includes: ComparableObjectForEqualityTest new).
+	self assert: (set includes: otherClass new).
+
+
+]
+
+{ #category : #testing }
+EqualityTest >> testTwoInstancesOfTheSameClassWithDifferentIvValuessAreNOTEqual [
+	| class |
+	class  := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: 'x y' classVariableNames:  ''.
+	class compile: 'x: newX y: newY
+		x := newX.
+		y := newY'.
+	class class compile: 'x: newX y: newY
+		^self new
+			x: newX y: newY;
+			yourself'.
+	self deny: (class x: 1 y: 'abc') = (class x: 1 y: 'zyx').
+]
+
+{ #category : #testing }
+EqualityTest >> testTwoInstancesOfTheSameClassWithNoIVsAreEqual [
+	self assert: ComparableObjectForEqualityTest new = ComparableObjectForEqualityTest new
+
+]
+
+{ #category : #testing }
+EqualityTest >> testTwoInstancesOfTheSameClassWithSameIvValuessAreEqual [
+	| class |
+	class  := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: 'x y' classVariableNames:  ''.
+	class compile: 'x: newX y: newY
+		x := newX.
+		y := newY'.
+	class class compile: 'x: newX y: newY
+		^self new
+			x: newX y: newY;
+			yourself'.
+	self assert: (class x: 1 y: 'abc') = (class x: 1 y: 'abc').
+]
+
+{ #category : #testing }
+EqualityTest >> testTwoInstancesOfTowDifferentClassesWithNoIVsAreNOTEqual [
+	| otherClass |
+	otherClass := classFactory newSubclassOf: ComparableObjectForEqualityTest  instanceVariableNames: '' classVariableNames:  ''.
+	self deny: otherClass new = ComparableObjectForEqualityTest new
+]

Equals/Fruit.class.st

@@ -0,0 +1,49 @@
+Class {
+	#name : #Fruit,
+	#superclass : #Object,
+	#traits : 'TEquality',
+	#classTraits : 'TEquality classTrait',
+	#instVars : [
+		'stage'
+	],
+	#category : #'Equals-Examples'
+}
+
+{ #category : #comparing }
+Fruit >> = anObject [ 
+	self species = anObject species ifFalse: [^false].
+	^self valuesToCompareForEquality = anObject valuesToCompareForEquality
+]
+
+{ #category : #staging }
+Fruit >> beRipe [
+	stage := #ripe
+]
+
+{ #category : #staging }
+Fruit >> beRotten [
+	stage := #rotten
+]
+
+{ #category : #staging }
+Fruit >> beUnripe [
+	stage := #unripe
+]
+
+{ #category : #accessing }
+Fruit >> color [
+	^self subclassResponsibility
+]
+
+{ #category : #comparing }
+Fruit >> hash [
+	^self valuesToCompareForEquality inject: self species hash into: [:hash :comparisonValue|
+		(hash bitXor: comparisonValue hash) hashMultiply]
+
+]
+
+{ #category : #'initialize - release' }
+Fruit >> initialize [
+	super initialize.
+	self beUnripe
+]

Equals/FruitComparisons.class.st

@@ -0,0 +1,47 @@
+Class {
+	#name : #FruitComparisons,
+	#superclass : #Comparisons,
+	#category : #'Equals-Examples'
+}
+
+{ #category : #comparisons }
+FruitComparisons class >> compareApplesOfDifferentColors [
+	"self compareApplesOfDifferentColors"
+
+	| apple1 apple2 |
+	apple1 := Apple color: Color red.
+	apple2 := Apple color: Color yellow.
+	self display: apple1 = apple2
+]
+
+{ #category : #comparisons }
+FruitComparisons class >> compareApplesOfSameColor [
+	"self compareApplesOfSameColor"
+
+	| apple1 apple2 |
+	apple1 := Apple color: Color red.
+	apple2 := Apple color: Color red.
+	self display: apple1 = apple2
+]
+
+{ #category : #comparisons }
+FruitComparisons class >> compareApplesOfSameColorAtDifferentStages [
+	"self compareApplesOfSameColorAtDifferentStages"
+
+	| apple1 apple2 |
+	apple1 := Apple color: Color red.
+	apple1 beRipe.
+	apple2 := Apple color: Color yellow.
+	apple2 beRotten.	
+	self display: apple1 = apple2
+]
+
+{ #category : #comparisons }
+FruitComparisons class >> compareYellowAppleAndBanana [
+	"self compareYellowAppleAndBanana"
+
+	| apple banana |
+	apple := Apple color: Color yellow.
+	banana := Banana new.
+	self display: apple = banana
+]

Equals/Object.extension.st

@@ -0,0 +1,22 @@
+Extension { #name : #Object }
+
+{ #category : #'*Equals' }
+Object class >> allInstVarNamesForEqualityComparison [
+	^self superclass allInstVarNamesForEqualityComparison, self instVarNamesForEqualityComparison
+]
+
+{ #category : #'*Equals' }
+Object >> instVarNamesForEqualityComparison [
+	^self class allInstVarNamesForEqualityComparison
+]
+
+{ #category : #'*Equals' }
+Object class >> instVarNamesForEqualityComparison [
+	^self instVarNames
+]
+
+{ #category : #'*Equals' }
+Object >> valuesToCompareForEquality [
+	^self instVarNamesForEqualityComparison collect: [:ivName|
+		self instVarNamed: ivName]
+]

Equals/Person.class.st

@@ -0,0 +1,57 @@
+Class {
+	#name : #Person,
+	#superclass : #Object,
+	#traits : 'TEquality',
+	#classTraits : 'TEquality classTrait',
+	#instVars : [
+		'name',
+		'age'
+	],
+	#category : #'Equals-Examples'
+}
+
+{ #category : #comparing }
+Person class >> instVarNamesForEqualityComparison [
+	^#(age)
+]
+
+{ #category : #'instance-creation' }
+Person class >> name: aString age: positiveInt [
+	^self new
+		name: aString;
+		age: positiveInt;
+		yourself
+]
+
+{ #category : #comparing }
+Person >> = anObject [ 
+	self species = anObject species ifFalse: [^false].
+	^self valuesToCompareForEquality = anObject valuesToCompareForEquality
+]
+
+{ #category : #accessing }
+Person >> age [
+	^ age
+]
+
+{ #category : #accessing }
+Person >> age: anObject [
+	age := anObject
+]
+
+{ #category : #comparing }
+Person >> hash [
+	^self valuesToCompareForEquality inject: self species hash into: [:hash :comparisonValue|
+		(hash bitXor: comparisonValue hash) hashMultiply]
+
+]
+
+{ #category : #accessing }
+Person >> name [
+	^ name
+]
+
+{ #category : #accessing }
+Person >> name: anObject [
+	name := anObject
+]