[squeak-dev] The Inbox: Mirrors-cwp.2.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue May 22 06:25:38 UTC 2012
A new version of Mirrors was added to project The Inbox:
http://source.squeak.org/inbox/Mirrors-cwp.2.mcz
==================== Summary ====================
Name: Mirrors-cwp.2
Author: cwp
Time: 15 May 2012, 6:50:25.515 pm
UUID: 48ba5f51-623b-4e6f-9b64-47c2c3e43258
Ancestors: Mirrors-cwp.1
Implemented a simple non-invasive inspector.
==================== Snapshot ====================
SystemOrganization addCategory: #'Mirrors-Tests'!
SystemOrganization addCategory: #'Mirrors-Object'!
SystemOrganization addCategory: #'Mirrors-Utilities'!
nil subclass: #MessageShunt
instanceVariableNames: 'handler'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Utilities'!
----- Method: MessageShunt class>>handler: (in category 'as yet unclassified') -----
handler: aBlock
| inst |
inst := self basicNew.
CompiledMethod
receiver: inst
withArguments: {1. aBlock}
executeMethod: (Reflection compiledMethodAt: #fixedAt:put:).
^ inst!
----- Method: MessageShunt class>>initialize (in category 'as yet unclassified') -----
initialize
self superclass: nil!
----- Method: MessageShunt>>doesNotUnderstand: (in category 'as yet unclassified') -----
doesNotUnderstand: aMessage
handler value: aMessage!
TestCase subclass: #FixedSlotMirrorTest
instanceVariableNames: 'mirror four'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: FixedSlotMirrorTest>>instVarAt: (in category 'shunts') -----
instVarAt: anIndex
"We don't want the slot mirror sending #instVarAt:, so if it does, fail the test"
self assert: false!
----- Method: FixedSlotMirrorTest>>instVarAt:put: (in category 'shunts') -----
instVarAt: anIndex put: anObject
"We don't want mirrors sending #instVarAt:put:, so if it does, fail the test"
self assert: false!
----- Method: FixedSlotMirrorTest>>setUp (in category 'running') -----
setUp
mirror := FixedSlotMirror on: self index: 4.
!
----- Method: FixedSlotMirrorTest>>testName (in category 'tests') -----
testName
self assert: mirror name = 'four'!
----- Method: FixedSlotMirrorTest>>testRead (in category 'tests') -----
testRead
four := Object new.
self assert: mirror value == four!
----- Method: FixedSlotMirrorTest>>testWrite (in category 'tests') -----
testWrite
| value |
value := Object new.
mirror value: value.
self assert: four == value!
TestCase subclass: #ObjectMirrorTest1
instanceVariableNames: 'mirror four'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectMirrorTest1>>setFour (in category 'support') -----
setFour
four := #four!
----- Method: ObjectMirrorTest1>>setUp (in category 'running') -----
setUp
mirror := ObjectMirror on: self!
----- Method: ObjectMirrorTest1>>tearDown (in category 'running') -----
tearDown
mirror := nil.
four := nil.!
----- Method: ObjectMirrorTest1>>testPerformWithNoArguments (in category 'tests') -----
testPerformWithNoArguments
mirror perform: #setFour arguments: #().
self assert: four = #four!
----- Method: ObjectMirrorTest1>>testReflects (in category 'tests') -----
testReflects
self assert: (mirror reflects: self)!
----- Method: ObjectMirrorTest1>>testSize (in category 'tests') -----
testSize
| expected actual |
expected := 4.
actual := mirror size.
self assert: actual = expected!
----- Method: ObjectMirrorTest1>>testSlotAt (in category 'tests') -----
testSlotAt
| slot |
slot := mirror slotAt: 1.
self assert: slot value = #testSlotAt!
----- Method: ObjectMirrorTest1>>testSlotAtIfAbsent (in category 'tests') -----
testSlotAtIfAbsent
| marker actual |
marker := Object new.
actual := mirror slotAt: 1 ifAbsent: [marker].
self deny: actual == marker!
----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentIfPresent (in category 'tests') -----
testSlotAtIfAbsentIfPresent
| answer slot |
answer := mirror slotAt: 1
ifPresent: [:val | slot := val. #present]
ifAbsent: [#absent].
self assert: slot value == #testSlotAtIfAbsentIfPresent.
self assert: answer == #present!
----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentIfPresentNot (in category 'tests') -----
testSlotAtIfAbsentIfPresentNot
| answer value |
answer := mirror slotAt: 10
ifPresent: [:val | value := val. #present]
ifAbsent: [#absent].
self assert: value isNil.
self assert: answer == #absent!
----- Method: ObjectMirrorTest1>>testSlotAtIfAbsentNot (in category 'tests') -----
testSlotAtIfAbsentNot
| marker actual |
marker := Object new.
actual := mirror slotAt: 10 ifAbsent: [marker].
self assert: actual == marker!
----- Method: ObjectMirrorTest1>>testSlotAtIfPresent (in category 'tests') -----
testSlotAtIfPresent
| slot |
mirror slotAt: 1 ifPresent: [:s | slot := s].
self assert: slot value == #testSlotAtIfPresent!
----- Method: ObjectMirrorTest1>>testSlotAtIfPresentNot (in category 'tests') -----
testSlotAtIfPresentNot
| value answer |
answer := mirror slotAt: 10 ifPresent: [:val | value := val].
self assert: value isNil.
self assert: answer isNil!
----- Method: ObjectMirrorTest1>>testSlots (in category 'tests') -----
testSlots
| slots |
slots := mirror slots.
self assert: slots size = mirror size.
slots do: [:ea | self assert: (ea isKindOf: FixedSlotMirror)]!
----- Method: ObjectMirrorTest1>>testUnderstands (in category 'tests') -----
testUnderstands
self assert: (mirror understands: #testUnderstands)!
----- Method: ObjectMirrorTest1>>testUnderstandsNot (in category 'tests') -----
testUnderstandsNot
self deny: (mirror understands: #thisSelectorIsNotImplemented)!
----- Method: ObjectMirrorTest1>>testUnderstandsSuper (in category 'tests') -----
testUnderstandsSuper
self assert: (mirror understands: #runCase)!
TestCase subclass: #ObjectMirrorTest2
instanceVariableNames: 'mirror handler shunt'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectMirrorTest2>>setUpFailShunt (in category 'as yet unclassified') -----
setUpFailShunt
handler := [ :m | self assert: false ].
shunt := MessageShunt handler: handler.
mirror := ObjectMirror on: shunt!
----- Method: ObjectMirrorTest2>>testPerformSendsOneMessage (in category 'as yet unclassified') -----
testPerformSendsOneMessage
handler := [:message | self assert: message selector = #griffle].
shunt := MessageShunt handler: handler.
mirror := ObjectMirror on: shunt.
mirror perform: #griffle arguments: #().
!
----- Method: ObjectMirrorTest2>>testSlotAtSendsNoMessages (in category 'as yet unclassified') -----
testSlotAtSendsNoMessages
| slot |
self setUpFailShunt.
slot := mirror slotAt: 1.
self assert: slot value == handler!
----- Method: ObjectMirrorTest2>>testUnderstandsSendsNoMessages (in category 'as yet unclassified') -----
testUnderstandsSendsNoMessages
self setUpFailShunt.
self deny: (mirror understands: #griffle)
!
TestCase subclass: #ObjectMirrorTest3
instanceVariableNames: 'mirror array'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectMirrorTest3>>setUp (in category 'as yet unclassified') -----
setUp
array := {#one. #two. #three}.
mirror := ObjectMirror on: array!
----- Method: ObjectMirrorTest3>>testSlotAt (in category 'as yet unclassified') -----
testSlotAt
| slot |
slot := mirror slotAt: 1.
self assert: slot value = #one!
TestCase subclass: #ObjectMirrorTest4
instanceVariableNames: 'mirror object'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectMirrorTest4>>setUp (in category 'as yet unclassified') -----
setUp
object := (SparseLargeArray new: 3)
at: 1 put: #one;
at: 2 put: #two;
at: 3 put: #three;
yourself.
mirror := ObjectMirror on: object!
----- Method: ObjectMirrorTest4>>testFixedSlotAt (in category 'as yet unclassified') -----
testFixedSlotAt
| slot |
slot := mirror slotAt: 2.
self assert: slot value = 3!
----- Method: ObjectMirrorTest4>>testVariableSlotAt (in category 'as yet unclassified') -----
testVariableSlotAt
| slot |
slot := mirror slotAt: 6.
self assert: slot value = #(one two three)!
TestCase subclass: #ObjectVmMirrorTest1
instanceVariableNames: 'mirror four'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectVmMirrorTest1>>four: (in category 'accessing') -----
four: anObject
four := anObject!
----- Method: ObjectVmMirrorTest1>>setUp (in category 'running') -----
setUp
mirror := ObjectVmMirror on: self!
----- Method: ObjectVmMirrorTest1>>testFixedAt (in category 'tests') -----
testFixedAt
four := Object new.
self assert: (mirror fixedAt: 4) == four!
----- Method: ObjectVmMirrorTest1>>testFixedAtPut (in category 'tests') -----
testFixedAtPut
| tmp |
tmp := Object new.
mirror fixedAt: 4 put: tmp.
self assert: four == tmp!
----- Method: ObjectVmMirrorTest1>>testFixedSize (in category 'tests') -----
testFixedSize
self assert: mirror fixedSize = 4!
----- Method: ObjectVmMirrorTest1>>testPerform (in category 'tests') -----
testPerform
| tmp |
tmp := Object new.
mirror perform: #four: arguments: {tmp}.
self assert: four == tmp!
----- Method: ObjectVmMirrorTest1>>testReflects (in category 'tests') -----
testReflects
self assert: (mirror reflects: self)!
TestCase subclass: #ObjectVmMirrorTest2
instanceVariableNames: 'mirror array'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: ObjectVmMirrorTest2>>setUp (in category 'as yet unclassified') -----
setUp
array := #(one two three).
mirror := ObjectVmMirror on: array!
----- Method: ObjectVmMirrorTest2>>testVariableAt (in category 'as yet unclassified') -----
testVariableAt
self assert: (mirror variableAt: 2) == (array at: 2)!
----- Method: ObjectVmMirrorTest2>>testVariableAtPut (in category 'as yet unclassified') -----
testVariableAtPut
| tmp |
tmp := Object new.
mirror variableAt: 2 put: tmp.
self assert: (array at: 2) == tmp!
----- Method: ObjectVmMirrorTest2>>testVariableSize (in category 'as yet unclassified') -----
testVariableSize
self assert: mirror variableSize = 3.!
TestCase subclass: #VariableSlotMirrorTest
instanceVariableNames: 'mirror array'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Tests'!
----- Method: VariableSlotMirrorTest>>setUp (in category 'running') -----
setUp
array := {#one. #two. #three}.
mirror := VariableSlotMirror on: array index: 2.!
----- Method: VariableSlotMirrorTest>>testName (in category 'tests') -----
testName
self assert: mirror name = '2'!
----- Method: VariableSlotMirrorTest>>testReflects (in category 'tests') -----
testReflects
self assert: (mirror reflects: array)!
----- Method: VariableSlotMirrorTest>>testValue (in category 'tests') -----
testValue
| actual expected |
expected := array at: 2.
actual := mirror value.
self assert: actual == expected!
----- Method: VariableSlotMirrorTest>>testWrite (in category 'tests') -----
testWrite
| tmp |
tmp := Object new.
mirror value: tmp.
self assert: (array at: 2) == tmp!
Object subclass: #FixedSlotMirror
instanceVariableNames: 'vmMirror index name'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Object'!
----- Method: FixedSlotMirror class>>on:index: (in category 'as yet unclassified') -----
on: anObject index: anInteger
^ self onVmMirror: (ObjectVmMirror on: anObject) index: anInteger!
----- Method: FixedSlotMirror class>>onVmMirror:index: (in category 'as yet unclassified') -----
onVmMirror: aMirror index: anInteger
^ self basicNew initializeWithMirror: aMirror index: anInteger!
----- Method: FixedSlotMirror>>initializeWithMirror:index: (in category 'as yet unclassified') -----
initializeWithMirror: aVmMirror index: anInteger
| object |
self initialize.
vmMirror := aVmMirror.
index := anInteger.
"This should be done using a ClassMirror, once they're implemented."
object := Reflection receiver: aVmMirror perform: #fixedAt: arguments: {1}.
name := object class allInstVarNames at: anInteger!
----- Method: FixedSlotMirror>>name (in category 'as yet unclassified') -----
name
^ name!
----- Method: FixedSlotMirror>>value (in category 'as yet unclassified') -----
value
^ vmMirror fixedAt: index!
----- Method: FixedSlotMirror>>value: (in category 'as yet unclassified') -----
value: anObject
vmMirror fixedAt: index put: anObject!
----- Method: FixedSlotMirror>>valueMirror (in category 'as yet unclassified') -----
valueMirror
^ ObjectMirror on: self value!
Object subclass: #MirrorInspector
instanceVariableNames: 'mirror index'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Utilities'!
----- Method: MirrorInspector class>>inspect: (in category 'as yet unclassified') -----
inspect: anObject
(self on: anObject) open!
----- Method: MirrorInspector class>>on: (in category 'as yet unclassified') -----
on: anObject
| mirror |
mirror := ObjectMirror on: anObject.
^ self basicNew initializeWithMirror: mirror!
----- Method: MirrorInspector>>buildWith: (in category 'building') -----
buildWith: aBuilder
| list text window |
list := aBuilder pluggableListSpec new
model: self;
frame: (LayoutFrame fractions: (0 at 0 corner: 0.5 at 1));
list: #slotLabels;
listSize: #slotCount;
getIndex: #selectedSlotIndex;
setIndex: #selectedSlotIndex:;
doubleClick: #spawn;
yourself.
text := aBuilder pluggableTextSpec new
model: self;
frame: (LayoutFrame fractions: (0.5 at 0 corner: 1 at 1));
askBeforeDiscardingEdits: false;
getText: #slotPrintString;
yourself.
window := aBuilder pluggableWindowSpec new
model: self;
label: #label;
extent: 300 at 200;
children: {list. text}.
^ aBuilder build: window
!
----- Method: MirrorInspector>>initializeWithMirror: (in category 'initialization') -----
initializeWithMirror: aMirror
self initialize.
mirror := aMirror.
index := 0.!
----- Method: MirrorInspector>>label (in category 'callbacks') -----
label
^ 'Mirror Inspector on: ', self safePrintString!
----- Method: MirrorInspector>>open (in category 'initialization') -----
open
ToolBuilder default open: self
!
----- Method: MirrorInspector>>safePrintString (in category 'callbacks') -----
safePrintString
^ mirror safePrintString!
----- Method: MirrorInspector>>selectedSlotIndex (in category 'callbacks') -----
selectedSlotIndex
^ index !
----- Method: MirrorInspector>>selectedSlotIndex: (in category 'callbacks') -----
selectedSlotIndex: anInteger
index := anInteger.
self changed: #selectedSlotIndex.
self changed: #slotPrintString!
----- Method: MirrorInspector>>slotCount (in category 'callbacks') -----
slotCount
^ mirror size!
----- Method: MirrorInspector>>slotLabels (in category 'callbacks') -----
slotLabels
^ mirror slots collect: [:ea | ea name]!
----- Method: MirrorInspector>>slotPrintString (in category 'callbacks') -----
slotPrintString
^ index = 0 ifFalse: [(mirror slotAt: index) valueMirror safePrintString]!
----- Method: MirrorInspector>>spawn (in category 'callbacks') -----
spawn
index = 0 ifFalse: [self class inspect: (mirror slotAt: index) value]!
Object subclass: #ObjectMirror
instanceVariableNames: 'vmMirror'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Object'!
----- Method: ObjectMirror class>>on: (in category 'as yet unclassified') -----
on: anObject
^ self basicNew initializeWithObject: anObject!
----- Method: ObjectMirror>>initializeWithObject: (in category 'initialization') -----
initializeWithObject: anObject
self initialize.
vmMirror := ObjectVmMirror on: anObject!
----- Method: ObjectMirror>>perform:arguments: (in category 'messages') -----
perform: aSelector arguments: anArray
^ vmMirror perform: aSelector arguments: anArray!
----- Method: ObjectMirror>>reflects: (in category 'messages') -----
reflects: anObject
^ vmMirror reflects: anObject!
----- Method: ObjectMirror>>safePrintString (in category 'printing') -----
safePrintString
^ vmMirror safePrintString!
----- Method: ObjectMirror>>size (in category 'slots') -----
size
^ vmMirror fixedSize + vmMirror variableSize!
----- Method: ObjectMirror>>slotAt: (in category 'slots') -----
slotAt: anInteger
^ self
slotAt: anInteger
ifAbsent: [self error: 'Slot doesn''t exist']!
----- Method: ObjectMirror>>slotAt:ifAbsent: (in category 'slots') -----
slotAt: anInteger ifAbsent: aBlock
^ self
slotAt: anInteger
ifPresent: [:val | val]
ifAbsent: aBlock!
----- Method: ObjectMirror>>slotAt:ifPresent: (in category 'slots') -----
slotAt: anInteger ifPresent: aBlock
^ self
slotAt: anInteger
ifPresent: aBlock
ifAbsent: [nil]!
----- Method: ObjectMirror>>slotAt:ifPresent:ifAbsent: (in category 'slots') -----
slotAt: anInteger ifPresent: pBlock ifAbsent: aBlock
^ anInteger <= self size
ifTrue:
[| fixedSize slot |
fixedSize := vmMirror fixedSize.
slot := anInteger <= fixedSize
ifTrue: [FixedSlotMirror onVmMirror: vmMirror index: anInteger]
ifFalse: [VariableSlotMirror onVmMirror: vmMirror index: anInteger - fixedSize].
pBlock value: slot]
ifFalse: aBlock
!
----- Method: ObjectMirror>>slots (in category 'slots') -----
slots
^ (1 to: self size) collect: [:i | self slotAt: i]!
----- Method: ObjectMirror>>understands: (in category 'messages') -----
understands: aSelector
^ vmMirror understands: aSelector!
Object subclass: #ObjectVmMirror
instanceVariableNames: 'object'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Object'!
----- Method: ObjectVmMirror class>>on: (in category 'as yet unclassified') -----
on: anObject
| inst |
inst := self basicNew.
inst initialize.
Reflection
receiver: inst
perform: #fixedAt:put:
arguments: {1. anObject}.
^ inst!
----- Method: ObjectVmMirror>>fixedAt: (in category 'slots') -----
fixedAt: anInteger
^ Reflection
receiver: object
perform: #fixedAt:
arguments: {anInteger}!
----- Method: ObjectVmMirror>>fixedAt:put: (in category 'slots') -----
fixedAt: anInteger put: anObject
^ Reflection
receiver: object
perform: #fixedAt:put:
arguments: {anInteger. anObject}!
----- Method: ObjectVmMirror>>fixedSize (in category 'slots') -----
fixedSize
^ Reflection
receiver: object
perform: #fixedSize
arguments: #()!
----- Method: ObjectVmMirror>>perform:arguments: (in category 'messages') -----
perform: aSelector arguments: anArray
^ Reflection
receiver: object
perform: #perform:arguments:
arguments: {aSelector. anArray}!
----- Method: ObjectVmMirror>>reflects: (in category 'testing') -----
reflects: anObject
^ anObject == object!
----- Method: ObjectVmMirror>>safeIdentityHash (in category 'printing') -----
safeIdentityHash
^ Reflection
receiver: object
perform: #identityHash
arguments: #()!
----- Method: ObjectVmMirror>>safePrintOn: (in category 'printing') -----
safePrintOn: aStream
aStream
nextPutAll: object class name;
nextPut: $[;
print: self safeIdentityHash;
nextPut: $]!
----- Method: ObjectVmMirror>>safePrintString (in category 'printing') -----
safePrintString
^ String streamContents: [:stream | self safePrintOn: stream]!
----- Method: ObjectVmMirror>>understands: (in category 'messages') -----
understands: aSelector
"This should use a ClassMirror, but that isn't implemented yet. For now, #class is
fine, because it's implemented as a byte code and doesn't send a messages to
the reflectee"
^ object class canUnderstand: aSelector!
----- Method: ObjectVmMirror>>variableAt: (in category 'slots') -----
variableAt: anInteger
^ Reflection
receiver: object
perform: #variableAt:
arguments: {anInteger}!
----- Method: ObjectVmMirror>>variableAt:put: (in category 'slots') -----
variableAt: anInteger put: anObject
^ Reflection
receiver: object
perform: #variableAt:put:
arguments: {anInteger. anObject}!
----- Method: ObjectVmMirror>>variableSize (in category 'slots') -----
variableSize
^ Reflection
receiver: object
perform: #variableSize
arguments: #()!
Object subclass: #Reflection
instanceVariableNames: ''
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Utilities'!
----- Method: Reflection class>>basicNew (in category 'as yet unclassified') -----
basicNew
self error: 'Reflection should never be instanciated'!
----- Method: Reflection class>>primitiveFailedFor: (in category 'as yet unclassified') -----
primitiveFailedFor: anObject
"Can make this smarter"
self error: 'primitive failed'!
----- Method: Reflection class>>receiver:perform:arguments: (in category 'as yet unclassified') -----
receiver: anObject perform: aSelector arguments: anArray
| cm |
cm := self compiledMethodAt: aSelector ifAbsent:
[^ anObject doesNotUnderstand: (Message selector: aSelector arguments: anArray)].
^ self receiver: anObject withArguments: anArray executeMethod: cm!
----- Method: Reflection class>>receiver:withArguments:executeMethod: (in category 'as yet unclassified') -----
receiver: receiver withArguments: argArray executeMethod: compiledMethod
<primitive: 188>
self primitiveFailed!
----- Method: Reflection class>>with:do: (in category 'as yet unclassified') -----
with: anObject do: aBlock
| result shunt |
shunt := MessageShunt handler:
[:message || cm |
cm := self compiledMethodAt: message selector.
result := self
receiver: anObject
withArguments: message arguments
executeMethod: cm].
aBlock value: shunt.
^ result
!
----- Method: Reflection>>fixedAt: (in category 'as yet unclassified') -----
fixedAt: anInteger
<primitive: 73>
^ Reflection primitiveFailedFor: self!
----- Method: Reflection>>fixedAt:put: (in category 'as yet unclassified') -----
fixedAt: anInteger put: anObject
<primitive: 74>
^ Reflection primitiveFailedFor: self!
----- Method: Reflection>>fixedSize (in category 'as yet unclassified') -----
fixedSize
"We can get away with sending #class here because the compiler emits
a bytecode that reads the class pointer directly."
| format |
0 flag: #instSizeChange.
format := Reflection receiver: self class perform: #fixedAt: arguments: {3}.
^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1.
!
----- Method: Reflection>>identityHash (in category 'as yet unclassified') -----
identityHash
<primitive: 75>
self class == SmallInteger ifTrue: [^ self].
Reflection primitiveFailedFor: self!
----- Method: Reflection>>perform:arguments: (in category 'as yet unclassified') -----
perform: aSelector arguments: anArray
<primitive: 84>
Reflection primitiveFailedFor: self!
----- Method: Reflection>>variableAt: (in category 'as yet unclassified') -----
variableAt: anInteger
<primitive: 60>
^ Reflection primitiveFailedFor: self!
----- Method: Reflection>>variableAt:put: (in category 'as yet unclassified') -----
variableAt: anInteger put: anObject
<primitive: 61>
Reflection primitiveFailedFor: self!
----- Method: Reflection>>variableSize (in category 'as yet unclassified') -----
variableSize
<primitive: 62>
^ 0!
Object subclass: #VariableSlotMirror
instanceVariableNames: 'vmMirror index'
classVariableNames: ''
poolDictionaries: ''
category: 'Mirrors-Object'!
----- Method: VariableSlotMirror class>>on:index: (in category 'as yet unclassified') -----
on: anObject index: anInteger
^ self onVmMirror: (ObjectVmMirror on: anObject) index: anInteger!
----- Method: VariableSlotMirror class>>onVmMirror:index: (in category 'as yet unclassified') -----
onVmMirror: aMirror index: anInteger
^ self basicNew initializeWithMirror: aMirror index: anInteger!
----- Method: VariableSlotMirror>>initializeWithMirror:index: (in category 'as yet unclassified') -----
initializeWithMirror: aVmMirror index: anInteger
self initialize.
vmMirror := aVmMirror.
index := anInteger!
----- Method: VariableSlotMirror>>name (in category 'as yet unclassified') -----
name
^ index asString!
----- Method: VariableSlotMirror>>reflects: (in category 'as yet unclassified') -----
reflects: anObject
^ vmMirror reflects: anObject!
----- Method: VariableSlotMirror>>value (in category 'as yet unclassified') -----
value
^ vmMirror variableAt: index!
----- Method: VariableSlotMirror>>value: (in category 'as yet unclassified') -----
value: anObject
^ vmMirror variableAt: index put: anObject!
----- Method: VariableSlotMirror>>valueMirror (in category 'as yet unclassified') -----
valueMirror
^ ObjectMirror on: self value!
More information about the Squeak-dev
mailing list
|