Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Cleanups in Slots code and Slot testing code
  • Loading branch information
astares committed Sep 2, 2019
1 parent a075c18 commit 5ffe12c
Show file tree
Hide file tree
Showing 45 changed files with 185 additions and 186 deletions.
2 changes: 1 addition & 1 deletion src/Slot-Core/IndexedSlot.class.st
Expand Up @@ -55,5 +55,5 @@ IndexedSlot >> read: anObject [

{ #category : #'meta-object-protocol' }
IndexedSlot >> write: aValue to: anObject [
^ thisContext object: anObject instVarAt: index put: aValue.
^ thisContext object: anObject instVarAt: index put: aValue
]
10 changes: 5 additions & 5 deletions src/Slot-Core/InstanceVariableSlot.class.st
Expand Up @@ -39,8 +39,8 @@ InstanceVariableSlot class >> resetIvarSlots [
InstanceVariableSlot >> definitionString [
"non special globals are defined by the symbol"
^self needsFullDefinition
ifTrue: [super definitionString]
ifFalse: [self name printString]
ifTrue: [ super definitionString ]
ifFalse: [ self name printString ]

]

Expand All @@ -53,7 +53,7 @@ InstanceVariableSlot >> emitStore: methodBuilder [
{ #category : #'code generation' }
InstanceVariableSlot >> emitValue: methodBuilder [
"emit the bytecode to push ivar"
methodBuilder pushInstVar: index.
methodBuilder pushInstVar: index

]

Expand All @@ -74,8 +74,8 @@ InstanceVariableSlot >> isWrittenIn: aCompiledCode [

{ #category : #testing }
InstanceVariableSlot >> needsFullDefinition [
"I am just a backward compatible ivar slot and can use simple definitons.
Note: my subclasses need full definitons"
"I am just a backward compatible ivar slot and can use simple definitions.
Note: my subclasses need full definitions"

^ self class ~= InstanceVariableSlot
]
Expand Up @@ -38,5 +38,5 @@ AbstractInitializedClassVariable >> printOn: aStream [
nextPutAll: ' => ';
nextPutAll: self class name;
nextPutAll: ' default: '.
default printOn: aStream.
default printOn: aStream
]
2 changes: 1 addition & 1 deletion src/Slot-Examples/AbstractInitializedSlot.class.st
Expand Up @@ -36,5 +36,5 @@ AbstractInitializedSlot >> printOn: aStream [
nextPutAll: ' => ';
nextPutAll: self class name;
nextPutAll: ' default: '.
default printOn: aStream.
default printOn: aStream
]
6 changes: 3 additions & 3 deletions src/Slot-Examples/BooleanSlot.class.st
Expand Up @@ -46,7 +46,7 @@ BooleanSlot >> emitValue: methodBuilder [
pushLiteral: offset;
send: #bitAt:;
pushLiteral: 1;
send: #==.
send: #==


]
Expand All @@ -56,7 +56,7 @@ BooleanSlot >> installingIn: aClass [
| booleanSlots |
super installingIn: aClass.

"we reuse a baselot if it is already there, if not, we add it"
"we reuse a baseSlot if it is already there, if not, we add it"
"TODO: this does not take into account adding BooleanSlots higher up in the Hierarchy"
aClass classLayout
resolveSlot: #'_booleanBaseSlot'
Expand All @@ -65,7 +65,7 @@ BooleanSlot >> installingIn: aClass [

"my offset in the base slot is defined by the order of all BooleanSlots in the Hierarchy"
booleanSlots := aClass allSlots select: [ :each | each isKindOf: self class ].
offset := booleanSlots indexOf: self.
offset := booleanSlots indexOf: self



Expand Down
6 changes: 3 additions & 3 deletions src/Slot-Examples/ComputedSlot.class.st
Expand Up @@ -27,7 +27,7 @@ ComputedSlot >> = other [

{ #category : #'code generation' }
ComputedSlot >> emitValue: methodBuilder [
"generate the bytcode for 'block cull: self'"
"generate the bytecode for 'block cull: self'"
methodBuilder
pushLiteral: block;
pushReceiver;
Expand All @@ -36,7 +36,7 @@ ComputedSlot >> emitValue: methodBuilder [

{ #category : #comparing }
ComputedSlot >> hasSameDefinitionAs: otherSlot [
"other then #=, we use string comparition for the blocks here"
"other then #=, we use string comparision for the blocks here"
^ (super hasSameDefinitionAs: otherSlot)
and: [ block printString = otherSlot block printString ]

Expand All @@ -59,7 +59,7 @@ ComputedSlot >> printOn: aStream [

{ #category : #'meta-object-protocol' }
ComputedSlot >> read: anObject [
"we use #cull to support both 0-arg and 1-arg blocks"
"we use #cull: to support both 0-arg and 1-arg blocks"
^block cull: anObject

]
Expand Down
2 changes: 1 addition & 1 deletion src/Slot-Examples/HistorySlot.class.st
Expand Up @@ -26,7 +26,7 @@ HistorySlot >> initialize [

{ #category : #initialization }
HistorySlot >> initialize: anObject [
super write: (OrderedCollection with: nil) to: anObject.
super write: (OrderedCollection with: nil) to: anObject

]

Expand Down
2 changes: 1 addition & 1 deletion src/Slot-Examples/PropertySlot.class.st
Expand Up @@ -48,7 +48,7 @@ PropertySlot >> installingIn: aClass [
aClass classLayout
resolveSlot: #'_propertyBaseSlot'
ifFound: [: slot | baseSlot := slot ]
ifNone: [aClass addSlot: (baseSlot := #'_propertyBaseSlot' => BaseSlot default: Dictionary new)].
ifNone: [aClass addSlot: (baseSlot := #'_propertyBaseSlot' => BaseSlot default: Dictionary new)]

]

Expand Down
6 changes: 3 additions & 3 deletions src/Slot-Examples/RelationSlot.class.st
Expand Up @@ -66,7 +66,7 @@ RelationSlot >> addAssociationFrom: ownerObject to: otherObject [
RelationSlot >> checkValue: aValue [

(aValue isKindOf: self targetClass)
ifFalse: [ self error: 'Invalid value' ].
ifFalse: [ self error: 'Invalid value' ]
]

{ #category : #'code generation' }
Expand Down Expand Up @@ -114,7 +114,7 @@ RelationSlot >> inClass: aTargetClassOrSymbol [
{ #category : #initialization }
RelationSlot >> inverse: anInverseSymbol inClass: aTargetClassOrSymbol [
self inClass: aTargetClassOrSymbol.
inverseName := anInverseSymbol.
inverseName := anInverseSymbol
]

{ #category : #accessing }
Expand Down Expand Up @@ -159,7 +159,7 @@ RelationSlot >> printOn: aStream [
store: inverseName ].
aStream
nextPutAll: ' inClass: ';
store: self targetClassName.
store: self targetClassName

]

Expand Down
4 changes: 2 additions & 2 deletions src/Slot-Examples/UnlimitedInstanceVariableSlot.class.st
Expand Up @@ -45,7 +45,7 @@ UnlimitedInstanceVariableSlot >> installingIn: aClass [
| unlimitedSlots |
super installingIn: aClass.

"we reuse a baselot if it is already there, if not, we add it"
"we reuse a baseSlot if it is already there, if not, we add it"
"TODO: this does not take into account adding BooleanSlots higher up in the Hierarchy"
aClass classLayout
resolveSlot: #'_ivarArrayBaseSlot'
Expand All @@ -54,7 +54,7 @@ UnlimitedInstanceVariableSlot >> installingIn: aClass [

"my offset in the base slot is defined by the order of all BooleanSlots in the Hierarchy"
unlimitedSlots := aClass allSlots select: [ :each | each isKindOf: self class ].
offset := unlimitedSlots indexOf: self.
offset := unlimitedSlots indexOf: self

]

Expand Down
2 changes: 1 addition & 1 deletion src/Slot-Examples/WeakSlot.class.st
Expand Up @@ -63,5 +63,5 @@ WeakSlot >> wantsInitalization [
{ #category : #'meta-object-protocol' }
WeakSlot >> write: aValue to: anObject [

^(super read: anObject) at: 1 put: aValue.
^(super read: anObject) at: 1 put: aValue
]
2 changes: 1 addition & 1 deletion src/Slot-Tests/AccessorInstanceVariableSlotTest.class.st
Expand Up @@ -26,5 +26,5 @@ AccessorInstanceVariableSlotTest >> testAccessorInstanceVariableSlot [

"did we create accessors?"
self assert: (aClass includesSelector: #slot1).
self assert: (aClass includesSelector: #slot1:).
self assert: (aClass includesSelector: #slot1:)
]
12 changes: 6 additions & 6 deletions src/Slot-Tests/BooleanSlotTest.class.st
Expand Up @@ -27,7 +27,7 @@ BooleanSlotTest >> testExampleBooleanSlot [

self assert: object slot1 == true.
object slot1: false.
self assert: object slot1 == false.
self assert: object slot1 == false
]

{ #category : #tests }
Expand All @@ -49,16 +49,16 @@ BooleanSlotTest >> testExampleTwoBooleanSlots [
object := aClass new.
"test reflective write and read"
slot1 write: true to: object.
self assert: (slot1 read: object) = true.
self assert: (slot1 read: object) equals: true.

slot2 write: true to: object.
self assert: (slot2 read: object) = true.
self assert: (slot2 read: object) equals: true.

slot2 write: true to: object.
slot1 write: false to: object.
self assert: (slot2 read: object) = true.
self assert: (slot2 read: object) equals: true.
slot2 write: false to: object.
self assert: (slot2 read: object) = false.
self assert: (slot2 read: object) equals: false



Expand Down Expand Up @@ -94,7 +94,7 @@ BooleanSlotTest >> testExampleTwoBooleanSlotsRemoveOne [
slot2 write: false to: object.
self deny: (slot2 read: object).

aClass removeSlot: slot1.
aClass removeSlot: slot1



Expand Down
8 changes: 4 additions & 4 deletions src/Slot-Tests/ComputedSlotTest.class.st
Expand Up @@ -18,7 +18,7 @@ ComputedSlotTest >> testReadComputedSlotCompiled [

"now compile an accessor and read"
self compileAccessorsFor: slot.
self assert: object slot1 equals: 5.
self assert: object slot1 equals: 5
]

{ #category : #tests }
Expand All @@ -29,7 +29,7 @@ ComputedSlotTest >> testReadComputedSlotReflective [
self assert: (aClass hasSlotNamed: #slot1).
object := aClass new.

self assert: (slot read: object) equals: 5.
self assert: (slot read: object) equals: 5
]

{ #category : #tests }
Expand All @@ -41,7 +41,7 @@ ComputedSlotTest >> testReadComputedSlotReflectiveNoArg [

object := aClass new.

self assert: (slot read: object) equals: 5.
self assert: (slot read: object) equals: 5
]

{ #category : #tests }
Expand All @@ -57,5 +57,5 @@ ComputedSlotTest >> testWriteComputedSlotCompiled [
self compileAccessorsFor: slot.
object slot1: 10.
"the write is ignored"
self assert: object slot1 equals: 5.
self assert: object slot1 equals: 5
]
6 changes: 3 additions & 3 deletions src/Slot-Tests/ExampleClassVariableTest.class.st
Expand Up @@ -20,7 +20,7 @@ ExampleClassVariableTest >> testCreateClassWithClassVariable [
sharedVariables: {classVar}
].

self assert: (aClass hasClassVarNamed: 'ClassVar').
self assert: (aClass hasClassVarNamed: 'ClassVar')



Expand All @@ -41,7 +41,7 @@ ExampleClassVariableTest >> testCreateClassWithTwoClassVariable [
].

self assert: (aClass hasClassVarNamed: 'ClassVar1').
self assert: (aClass hasClassVarNamed: 'ClassVar2').
self assert: (aClass hasClassVarNamed: 'ClassVar2')



Expand Down Expand Up @@ -72,5 +72,5 @@ ExampleClassVariableTest >> testMigrateClassVar [

self assert: (aClass hasClassVarNamed: 'ClassVar').
self assert: (aClass classVariableNamed: #ClassVar) class equals: ExampleClassVariableWithState.
self assert: (aClass classVariableNamed: #ClassVar) read equals: 5.
self assert: (aClass classVariableNamed: #ClassVar) read equals: 5
]
4 changes: 2 additions & 2 deletions src/Slot-Tests/ExampleSlotWithStateTest.class.st
Expand Up @@ -10,7 +10,7 @@ ExampleSlotWithStateTest >> testExampleClassSide [
aClass := self make: [ :builder | builder classSlots: {#slot1 =>ExampleSlotWithState}].

self assert: (aClass class hasSlotNamed: #slot1).
self assert: aClass class slotDefinitionString equals: '{ #slot1 => ExampleSlotWithState }'.
self assert: aClass class slotDefinitionString equals: '{ #slot1 => ExampleSlotWithState }'
]

{ #category : #tests }
Expand Down Expand Up @@ -40,5 +40,5 @@ ExampleSlotWithStateTest >> testExampleTwoSlotWithState [

aClass := self make: [ :builder | builder slots: {#slot2 =>ExampleSlotWithState}].
self deny: (aClass hasSlotNamed: #slot1).
self assert: (aClass hasSlotNamed: #slot2).
self assert: (aClass hasSlotNamed: #slot2)
]
2 changes: 1 addition & 1 deletion src/Slot-Tests/HistorySlotTest.class.st
Expand Up @@ -90,7 +90,7 @@ HistorySlotTest >> testIsFirstElementNil [

instance := aClass new.

self assert: (instance slot1) equals: nil.
self assert: (instance slot1) equals: nil
]

{ #category : #tests }
Expand Down
6 changes: 3 additions & 3 deletions src/Slot-Tests/InitializedClassVariableTest.class.st
Expand Up @@ -13,7 +13,7 @@ InitializedClassVariableTest >> testInitializedClassVariableCompiled [
self compileAccessorsFor: classVar.
self assert: aClass new ClassVar equals: 5.
aClass new ClassVar: 6.
self assert: aClass new ClassVar equals: 6.
self assert: aClass new ClassVar equals: 6



Expand All @@ -28,7 +28,7 @@ InitializedClassVariableTest >> testInitializedClassVariableReadReflective [

self assert: classVar read equals: 5.
classVar write: 10.
self assert: classVar read equals: 10.
self assert: classVar read equals: 10



Expand All @@ -44,7 +44,7 @@ InitializedClassVariableTest >> testInitializedClassVariableReflectiveBlock [

self assert: classVar read equals: 5.
classVar write: 10.
self assert: classVar read equals: 10.
self assert: classVar read equals: 10



Expand Down
6 changes: 3 additions & 3 deletions src/Slot-Tests/InitializedSlotTest.class.st
Expand Up @@ -25,7 +25,7 @@ InitializedSlotTest >> testReadWriteCompiled [
"test compiled write and read"
self assert: (object slot1) equals: 5.
object slot1: 10.
self assert: (object slot1) equals: 10.
self assert: (object slot1) equals: 10



Expand All @@ -44,7 +44,7 @@ InitializedSlotTest >> testReflectiveReadWrite [
"test reflective write and read"
self assert: (slot read: object) equals: 5.
slot write: 10 to: object.
self assert: (slot read: object) equals: 10.
self assert: (slot read: object) equals: 10



Expand All @@ -63,7 +63,7 @@ InitializedSlotTest >> testReflectiveReadWriteBlock [
"test reflective write and read"
self assert: (slot read: object) equals: 5.
slot write: 10 to: object.
self assert: (slot read: object) equals: 10.
self assert: (slot read: object) equals: 10



Expand Down
6 changes: 3 additions & 3 deletions src/Slot-Tests/LazyClassVariableTest.class.st
Expand Up @@ -13,7 +13,7 @@ LazyClassVariableTest >> testLazyClassVarCompiled [
self compileAccessorsFor: classVar.
self assert: aClass new ClassVar equals: 5.
aClass new ClassVar: 6.
self assert: aClass new ClassVar equals: 6.
self assert: aClass new ClassVar equals: 6



Expand All @@ -28,7 +28,7 @@ LazyClassVariableTest >> testLazyClassVarReadReflective [

self assert: classVar read equals: 5.
classVar write: 10.
self assert: classVar read equals: 10.
self assert: classVar read equals: 10



Expand All @@ -44,7 +44,7 @@ LazyClassVariableTest >> testLazyClassVarReadReflectiveBlock [

self assert: classVar read equals: 5.
classVar write: 10.
self assert: classVar read equals: 10.
self assert: classVar read equals: 10



Expand Down

0 comments on commit 5ffe12c

Please sign in to comment.