Packages February 2024

packages@lists.squeakfoundation.org

1 participants
58 discussions

The Trunk: KernelTests-ct.421.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.421.mcz ==================== Summary ==================== Name: KernelTests-ct.421 Author: ct Time: 12 March 2022, 1:39:59.553359 am UUID: 3916242e-4ff0-0541-9da6-e876e740d0ad Ancestors: KernelTests-ct.420 Tests handling of objects as methods (OaM) during simulation of Object>>#withArgs:executeMethod: and Object>>#with:...executeMethod:. =============== Diff against KernelTests-ct.419 =============== Item was added: + ----- Method: ContextTest>>testPrimitive188 (in category 'tests') ----- + testPrimitive188 + + self testPrimitive188: [:receiver :args :compiledMethod | + receiver withArgs: args executeMethod: compiledMethod]. + + self testPrimitive188: [:receiver :args :compiledMethod | + CompiledMethod receiver: receiver withArguments: args executeMethod: compiledMethod].! Item was added: + ----- Method: ContextTest>>testPrimitive188: (in category 'tests') ----- + testPrimitive188: primitiveBlock + + | block | + { + {2. {}. SmallInteger >> #even}. "valid 0-arg message" + {2. {1}. Integer >> #<<}. "valid unary message" + {2. {3. 4}. Integer >> #raisedTo:modulo:}. "valid binary message" + {2. 'not an array'. Integer >> #<<}. "invalid arguments" + {2. {'excess arg'}. SmallInteger >> #even}. "too many arguments" + {2. {}. Integer >> #<<}. "missing argument" + {2. {1}. 'not a method'}. "invalid method" + {block := [(primitiveBlock valueWithArguments: {2. {3. 4}. TestObjectForMethod new xxxMethod: thisContext homeMethod}) + allButFirst "OaM selector is undefined behavior"]. {}. block class lookupSelector: #value} "object as method" + } do: [:args | + self + assert: ([primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [[primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex messageText]])].! Item was added: + ----- Method: ContextTest>>testPrimitive189 (in category 'tests') ----- + testPrimitive189 + + { + [2 executeMethod: SmallInteger >> #even]. "valid 0-arg message" + [2 with: 1 executeMethod: Integer >> #<<]. "valid unary message" + [2 with: 3 with: 4 executeMethod: Integer >> #raisedTo:modulo:]. "valid binary message" + [2 with: 1 executeMethod: Integer >> #even]. "too many arguments" + [2 executeMethod: Integer >> #<<]. "missing argument" + [2 with: 1 executeMethod: 'not a method']. "invalid method" + [(2 with: 3 with: 4 executeMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod)) + allButFirst "OaM selector is undefined behavior"] "object as method" + } do: [:block | + self + assert: (block on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex messageText]])].!

1 0

The Trunk: KernelTests-ct.417.mcz
by commits＠source.squeak.org 26 Feb '24

26 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.417.mcz ==================== Summary ==================== Name: KernelTests-ct.417 Author: ct Time: 29 December 2021, 6:16:09.754165 pm UUID: 3f9894ac-a774-b44d-85bf-0846ac062cb2 Ancestors: KernelTests-ct.416 Acceptance tests for #runUntilErrorOrReturnFrom:. Given the complexity of the underlying method, I would like to gently request a short feedback from the author (Eliot) whether all assumptions in these tests are correct. :-) =============== Diff against KernelTests-ct.416 =============== Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromError (in category 'tests') ----- + testRunUntilErrorOrReturnFromError + + | context process result sender error | + process := [self error] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: (context hasSender: sender). + self assert: (Error handles: error).! Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromNoError (in category 'tests') ----- + testRunUntilErrorOrReturnFromNoError + + | context process result sender error | + process := [6 * 7] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: sender equals: context. + self assert: nil equals: error. + self assert: 42 equals: context top.!

1 0

The Trunk: KernelTests-ct.409.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.409.mcz ==================== Summary ==================== Name: KernelTests-ct.409 Author: ct Time: 10 November 2021, 1:45:40.105242 am UUID: ab3db7b1-d980-5b4b-80a2-8c08bef9b23b Ancestors: KernelTests-mt.407 Adds new simulation tests for the reflection primitives 117 (primitiveExternalCall), 118 (primitiveDoPrimitiveWithArgs), and 218 (primitiveDoNamedPrimitiveWithArgs) and revises existing tests for the primitives 83 (primitivePerform), 84 (primitivePerformWithArgs), and 100 (primitivePerformInSuperclass) which do not need to be dispatched via primitive 118. =============== Diff against KernelTests-mt.407 =============== Item was changed: ----- Method: ContextTest>>testPrimitive100 (in category 'tests') ----- testPrimitive100 { {#isNil. {}. Object}. "valid 0-arg message" {#=. {true}. UndefinedObject}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}. Object}. "valid binary message" {{}. #=. {true}. SequenceableCollection}. "mirror primitive" + {'not a selector'. {}. Object}. "invalid selector" + {#isNil. 'not an array'. Object}. "invalid arguments" - {#isNil}. "missing arguments" - {#isNil. 'not an array'}. "invalid arguments" - {#isNil. {}}. "missing lookupClass" {#isNil. {'excess arg'}. Object}. "too many arguments" {#=. {}. UndefinedObject}. "missing argument" + {#isNil. {}. 'not a class'}. "invalid lookupClass" {#isNil. {}. Boolean}. "lookupClass not in inheritance chain" + } do: [:args | | block | + block := [[nil + perform: args first + withArguments: args second + inSuperclass: args third] + on: Error do: [:ex | ex messageText]]. - } do: [:args | self + assert: block value + equals: (Context runSimulated: block). + + block := [[thisContext + object: nil + perform: args first + withArguments: args second + inClass: args third] + on: Error do: [:ex | ex messageText]]. + self + assert: block value + equals: (Context runSimulated: block)].! - assert: (nil tryPrimitive: 100 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 100 withArgs: args])].! Item was added: + ----- Method: ContextTest>>testPrimitive117 (in category 'tests') ----- + testPrimitive117 + + | input1 input2 | + "valid 0-arg primitive" + self + assert: #isNil size + equals: (Context runSimulated: [#isNil size]). + + "valid unary primitive" + self + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]). + + "superfluous arguments" + self "cascade!!" + assert: 6 + 9 + equals: (Context runSimulated: [6 + 9]); + assert: true. + + self + assert: ((input1 := {1. 2. 3}) at: 2 put: 4) + equals: (Context runSimulated: [(input2 := {1. 2. 3}) at: 2 put: 4]); + assert: input1 + equals: input2.! Item was added: + ----- Method: ContextTest>>testPrimitive118 (in category 'tests') ----- + testPrimitive118 + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + receiver tryPrimitive: primitiveIndex withArgs: arguments]. + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + thisContext receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments].! Item was added: + ----- Method: ContextTest>>testPrimitive118: (in category 'tests') ----- + testPrimitive118: primitiveBlock + + | input1 input2 | + { + {#isNil. 62. {}}. "valid 0-arg primitive" + {6. 9. {7}}. "valid unary primitive" + {6. 62. {7}}. "failing primitive" + {6. 'not a primitive'. {7}}. "invalid primitive" + {6. 9. 'not an array'}. "invalid arguments" + {#isNil. 62. {1}}. "too many arguments" + {6. 9. {}}. "missing argument" + + {nil. 83. {#=. true}}. "primitivePerform" + {nil. 83. {#isNil. 'excess arg'}}. "primitivePerform - too many arguments" + {nil. 84. {#=. {true}}}. "primitivePerformWithArgs" + {nil. 84. {#isNil. 'excess arg'}}. "primitivePerformWithArgs - invalid arguments" + {nil. 100. {#=. true. Object}}. "primitivePerformInSuperclass" + {nil. 100. {#isNil. {'excess arg'}. Object}}. "primitivePerformInSuperclass - too many arguments" + + {6. 118. {9. {7}}}. "primitiveDoPrimitiveWithArgs" + {6. 118. {9. {7. 13}}}. "primitiveDoPrimitiveWithArgs - superfluous arguments" + {6. 118. {118. {9. {7}}}}. "primitiveDoPrimitiveWithArgs - M3" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {}}}. "primitiveDoNamedPrimitiveWithArgs" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {4.0}}}. "primitiveDoNamedPrimitiveWithArgs - superfluous arguments" + } do: [:args | | block | + block := [primitiveBlock valueWithArguments: args]. + self + assert: block value + equals: (Context runSimulated: block)]. + + self + assert: (primitiveBlock value: (input1 := {1. 2. 3}) value: 61 value: {2. 4}) + equals: (Context runSimulated: [primitiveBlock value: (input2 := {1. 2. 3}) value: 61 value: {2. 4}]); + assert: input1 + equals: input2.! Item was added: + ----- Method: ContextTest>>testPrimitive218 (in category 'tests') ----- + testPrimitive218 + + "valid 0-arg primitive" + self + assert: (Float32Array withAll: {2.0. 3.0}) sum + equals: (Context runSimulated: [(Float32Array withAll: {2.0. 3.0}) sum]). + + "valid unary primitive" + self + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: 'wiffy' = 'ziffy' + equals: (Context runSimulated: ['wiffy' = 'ziffy']). + + "superfluous arguments" + self "cascade!!" + assert: 'wiffy' = 'wiffy' copy + equals: (Context runSimulated: ['wiffy' = 'wiffy' copy]); + assert: true.! Item was changed: ----- Method: ContextTest>>testPrimitive83 (in category 'tests') ----- testPrimitive83 { + [nil perform: #isNil]. "valid 0-arg message" + [nil perform: #= with: true]. "valid unary message" + [nil perform: #ifNil:ifNotNil: with: [2] with: [:x | x]]. "valid binary message" + [nil perform: #isNil with: 'excess arg']. "too many arguments" + [nil perform: #=] + } do: [:block | - {#isNil}. "valid 0-arg message" - {#=. true}. "valid unary message" - {#ifNil:ifNotNil:. [2]. [:x | x]}. "valid binary message" - {#isNil. 'excess arg'}. "too many arguments" - {#=}. "missing argument" - } do: [:args | self + assert: (block on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex messageText]])].! - assert: (nil tryPrimitive: 83 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 83 withArgs: args])].! Item was changed: ----- Method: ContextTest>>testPrimitive84 (in category 'tests') ----- testPrimitive84 { {#isNil. {}}. "valid 0-arg message" {#=. {true}}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}}. "valid binary message" - {#isNil}. "missing arguments" {#isNil. 'not an array'}. "invalid arguments" {#isNil. {'excess arg'}}. "too many arguments" {#=. {}}. "missing argument" } do: [:args | self + assert: ([nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]) + equals: (Context runSimulated: [[nil perform: args first withArguments: args second] on: Error do: [:ex | ex messageText]])].! - assert: (nil tryPrimitive: 84 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 84 withArgs: args])].!

1 0

The Trunk: Kernel-ct.1548.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1548.mcz ==================== Summary ==================== Name: Kernel-ct.1548 Author: ct Time: 30 December 2023, 8:57:59.873665 pm UUID: 0b32cb51-9e96-d247-be53-734ad1f2735f Ancestors: Kernel-ct.1545 Proposal: Resolves #mustBeBoolean errors for copies or proxies for true and false. For instance, the following now works: True basicNew ifTrue: [1] ifFalse: [2]. (ObjectTracer on: false) ifTrue: [1] ifFalse: [2]. See: https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou… =============== Diff against Kernel-ct.1545 =============== Item was added: + ----- Method: False>>mustBeBooleanIn: (in category 'as yet unclassified') ----- + mustBeBooleanIn: aContext + + aContext skipBackBeforeJump. + ^ false! Item was added: + ----- Method: ObjectTracer>>mustBeBoolean (in category 'very few messages') ----- + mustBeBoolean + "Overwritten to preserve original sender context." + + ^ self mustBeBooleanIn: thisContext sender! Item was added: + ----- Method: True>>mustBeBooleanIn: (in category 'as yet unclassified') ----- + mustBeBooleanIn: aContext + + aContext skipBackBeforeJump. + ^ true!

1 0

The Trunk: Monticello-ct.808.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.808.mcz ==================== Summary ==================== Name: Monticello-ct.808 Author: ct Time: 25 February 2024, 9:10:40.513023 pm UUID: d9aa0fc7-caea-2841-8275-b462e51158e9 Ancestors: Monticello-cmm.807 In repository inspector, updates version list after adopting a version. =============== Diff against Monticello-cmm.807 =============== Item was added: + ----- Method: MCRepositoryInspector>>adopt (in category 'actions') ----- + adopt + super adopt. + self refresh.!

1 0

The Trunk: Kernel-ct.1547.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1547.mcz ==================== Summary ==================== Name: Kernel-ct.1547 Author: ct Time: 30 December 2023, 8:54:13.166665 pm UUID: 60bc9f54-c12a-4545-9ff9-b3d2875784cd Ancestors: Kernel-ct.1545 Proposal: When simulating #mustBeBoolean errors, send #mustBeBoolean instead of #mustBeBooleanIn: just like the VM. I don't see any harm in this. =============== Diff against Kernel-ct.1545 =============== Item was changed: ----- Method: Context>>jump:if: (in category 'instruction decoding') ----- jump: distance if: condition "Simulate the action of a 'conditional jump' bytecode whose offset is the argument, distance, and whose condition is the argument, condition." | bool | bool := self pop. condition == bool ifTrue: [self jump: distance] ifFalse: [(true == bool or: [false == bool]) ifFalse: + [^self send: #mustBeBoolean to: bool with: #()]]! - [^self send: #mustBeBooleanIn: to: bool with: {self}]]!

1 0

The Trunk: Kernel-ct.1546.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1546.mcz ==================== Summary ==================== Name: Kernel-ct.1546 Author: ct Time: 30 December 2023, 8:52:22.257665 pm UUID: 0c54d495-74a1-cd4e-8c0f-f95dec89f2a1 Ancestors: Kernel-ct.1545 In the debugger/simulator, fixes stepping through #mustBeBoolean errors and restarting from primitive methods that no longer fail. There is no need to throw up another debugger here. Just continue with the new context, and the client (i.e., the debugger) must honor the answer of #stepToSendOrReturn. =============== Diff against Kernel-ct.1545 =============== Item was changed: ----- Method: Context>>stepToSendOrReturn (in category 'system simulation') ----- stepToSendOrReturn "Simulate the execution of bytecodes until either sending a message or returning a value to the receiver (that is, until switching contexts)." | ctxt | [self willReallySend or: [self willReturn or: [self willReallyStore]]] whileFalse: [ctxt := self step. ctxt == self ifFalse: + ["Caused by mustBeBoolean handling or callPrimitive:" + ^ctxt stepToSendOrReturn]]! - [self halt. - "Caused by mustBeBoolean handling" - ^ctxt]]!

1 0

The Trunk: Tools-ct.1245.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1245.mcz ==================== Summary ==================== Name: Tools-ct.1245 Author: ct Time: 30 December 2023, 8:52:32.810665 pm UUID: 2a87a721-9966-6f46-abea-4e240d9f5ecd Ancestors: Tools-ct.1244 Complements Kernel-ct.1546 (fixes stepping through #mustBeBoolean errors and restarting from primitive methods that no longer fail). =============== Diff against Tools-ct.1244 =============== Item was changed: ----- Method: Debugger>>contents:notifying: (in category 'accessing') ----- contents: aText notifying: aController "Accept new method source of the selected context." | selector classOfMethod category ctxt newMethod | contextStackIndex = 0 ifTrue: [^ false]. "First, handle some edge cases" selector := self selectedClass newParser parseSelector: aText. "selector isDoIt ifTrue: [ currentCompiledMethod := self compileDoIt: aText]." self flag: #todo. "ct: Recompile doIt method *without* creating method litters!! See Compiler>>#evaluateCue:ifFail:." selector = self selectedMessageName ifFalse: [ "Different message compiled, delegating to super" ^ super contents: aText notifying: aController]. self selectedContext isExecutingBlock ifTrue: [ "If we are in a block context, we need to rewind the stack before ." | home | home := self selectedContext activeHome. home ifNil: [ (self confirm: 'Method for block not found on stack, can''t edit and continue. Update method anyway?' translated) ifFalse: [ ^ false]. ^ (super contents: aText notifying: aController) ifTrue: [ contents := nil. self contentsChanged. self inform: 'Method was updated, but cannot revert the stack to it.' translated]; yourself]. (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' translated withCRs) ifFalse: [ ^ false]. self resetContext: home changeContents: false. "N.B. Only reset the contents if the compilation succeeds. If contents would be reset when compilation fails, both compiler error message and modifications were lost." ^ (self contents: aText notifying: aController) ifTrue: [self contentsChanged]; yourself]. classOfMethod := self selectedClass. category := self selectedMessageCategoryName. "Do the actual compilation" selector := classOfMethod compile: aText classified: category notifying: aController. selector ifNil: [^ false]. "compilation cancelled" "Update views" contents := aText. newMethod := classOfMethod compiledMethodAt: selector. newMethod isQuick ifTrue: [ self cutBackExecutionToSenderContext]. ctxt := interruptedProcess popTo: self selectedContext. ctxt == self selectedContext ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' translated withCRs] ifTrue: [ newMethod isQuick ifFalse: [ + ctxt := interruptedProcess restartTopWith: newMethod. + ctxt := interruptedProcess stepToSendOrReturn]. - interruptedProcess restartTopWith: newMethod. - interruptedProcess stepToSendOrReturn]. contextVariablesInspector object: nil]. self resetContext: ctxt. Project current addDeferredUIMessage: [ self changed: #contentsSelection]. ^ true! Item was changed: ----- Method: Debugger>>tryRestartFrom: (in category 'context stack menu') ----- tryRestartFrom: context "Try to restart from the initial state of the context. Return whether an unwind error occurred." | actualContext unwindError | actualContext := interruptedProcess popTo: context. unwindError := actualContext ~= context. unwindError ifFalse: [ + actualContext := interruptedProcess restartTop; stepToSendOrReturn]. - interruptedProcess restartTop; stepToSendOrReturn]. self resetContext: actualContext. ^ unwindError!

1 0

The Trunk: Kernel-ct.1490.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ct.1490.mcz ==================== Summary ==================== Name: Kernel-ct.1490 Author: ct Time: 22 September 2022, 12:33:25.251935 pm UUID: abcadab7-53c3-f840-a63b-f90658e6a190 Ancestors: Kernel-eem.1488 code simulation: Do not check numArgs in perform primitives. Instead, answer a primitive fail token from Context>>#send:to:with:lookupIn: if the numbers mismatch. See http://lists.squeakfoundation.org/pipermail/squeak-dev/2022-September/22224…. Pros of this advantage: - semantic correctness: Prior to the final method lookup, the VM should not know anything about the type of a selector. - optimization: Avoid redundant method lookup. Cons of this advantage: - When simulating an invalid message send instruction, the simulator will no longer signal a clear 'Wrong number of arguments in simulated message' error but instead prolong the infection chain until a 'MessageNotUnderstood: Array>>' exception is signaled by the InstructionStream eventually. Note that such an invalidation would cause the VM to crash, though, so I don't know how important this is. (Example - BEWARE! Only simulate it! block := Compiler evaluate: '[false ifTrue: 2 ifFalse: 3]'. block method literalAt: 1 put: #itest:fTrue:ifFalse:. block value) =============== Diff against Kernel-eem.1488 =============== Item was changed: ----- Method: Context>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and arguments are given as arguments to this message. If successful, push result and return resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes execution needs to be intercepted and simulated to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug interesting code, such as the debugger itself. Hence use primitive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ [self notify: ('The code being simulated is trying to control a process ({1}). Process controlling cannot be simulated. If you proceed, things may happen outside the observable area of the simulator.' translated format: {meth reference})] ifCurtailed: [self push: nil "Cheap fix of the context's internal state"]]. ((primitiveIndex between: 201 and: 222) and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: [(primitiveIndex = 206 or: [primitiveIndex = 208]) ifTrue: "[Full]BlockClosure>>valueWithArguments:" [^receiver simulateValueWithArguments: arguments first caller: self]. ((primitiveIndex between: 201 and: 209) "[Full]BlockClosure>>value[:value:...]" or: [primitiveIndex between: 221 and: 222]) ifTrue: "[Full]BlockClosure>>valueNoContextSwitch[:]" [^receiver simulateValueWithArguments: arguments caller: self]]. primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" [| selector | selector := arguments at: 1 ifAbsent: [^ self class primitiveFailTokenFor: #'bad argument']. - arguments size - 1 = selector numArgs ifFalse: - [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: arguments allButFirst]. primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" [| selector args | arguments size = 2 ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. selector := arguments first. args := arguments second. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. - args size = selector numArgs ifFalse: - [^ self class primitiveFailTokenFor: #'bad number of arguments']. ^self send: selector to: receiver with: args]. primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" [| rcvr selector args superclass | arguments size caseOf: { [3] -> [ rcvr := receiver. selector := arguments first. args := arguments second. superclass := arguments third]. [4] -> ["mirror primitive" rcvr := arguments first. selector := arguments second. args := arguments third. superclass := arguments fourth] } otherwise: [^ self class primitiveFailTokenFor: #'bad number of arguments']. args isArray ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. - args size = selector numArgs ifFalse: - [^ self class primitiveFailTokenFor: #'bad number of arguments']. ((self objectClass: rcvr) includesBehavior: superclass) ifFalse: [^ self class primitiveFailTokenFor: #'bad argument']. ^self send: selector to: rcvr with: args lookupIn: superclass]. "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| effective | effective := Processor activeProcess effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]]. primitiveIndex = 188 ifTrue: "Object>>withArgs:executeMethod: CompiledMethod class>>receiver:withArguments:executeMethod: VMMirror>>ifFail:object:with:executeMethod: et al" [| n args methodArg thisReceiver | ((n := arguments size) between: 2 and: 4) ifFalse: [^self class primitiveFailTokenFor: #'unsupported operation']. ((self objectClass: (args := arguments at: n - 1)) == Array and: [(self objectClass: (methodArg := arguments at: n)) includesBehavior: CompiledMethod]) ifFalse: [^self class primitiveFailTokenFor: #'bad argument']. methodArg numArgs = args size ifFalse: [^self class primitiveFailTokenFor: #'bad number of arguments']. thisReceiver := arguments at: n - 2 ifAbsent: [receiver]. methodArg primitive > 0 ifTrue: [methodArg isQuick ifTrue: [^self push: (methodArg valueWithReceiver: thisReceiver arguments: args)]. ^self doPrimitive: methodArg primitive method: methodArg receiver: thisReceiver args: args]. ^self activateMethod: methodArg withArgs: args receiver: thisReceiver]. primitiveIndex = 118 ifTrue: "[receiver:]tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 3 and: [(self objectClass: arguments second) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifTrue: [^self doPrimitive: arguments second method: meth receiver: arguments first args: arguments last]. (arguments size = 2 and: [(self objectClass: arguments first) == SmallInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^self class primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] ifFalse: "should use self receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments but this is only in later VMs (and appears to be broken)" [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. ^(self isPrimFailToken: value) ifTrue: [value] ifFalse: [self push: value]! Item was changed: ----- Method: Context>>send:to:with:lookupIn: (in category 'controlling') ----- send: selector to: rcvr with: arguments lookupIn: lookupClass "Simulate the action of sending a message with selector and arguments to rcvr. The argument, lookupClass, is the class in which to lookup the message. This is the receiver's class for normal messages, but for super messages it will be some specific class related to the source method." | meth primIndex val ctxt | (meth := lookupClass lookupSelector: selector) ifNil: [selector == #doesNotUnderstand: ifTrue: [self error: 'Recursive message not understood!!' translated]. ^self send: #doesNotUnderstand: to: rcvr with: {(Message selector: selector arguments: arguments) lookupClass: lookupClass} lookupIn: lookupClass]. (self objectClass: meth) isCompiledCodeClass ifFalse: ["Object as Methods (OaM) protocol: 'The contract is that, when the VM encounters an ordinary object (rather than a compiled method) in the method dictionary during lookup, it sends it the special selector #run:with:in: providing the original selector, arguments, and receiver.'. DOI: 10.1145/2991041.2991062." ^self send: #run:with:in: to: meth with: {selector. arguments. rcvr}]. meth numArgs = arguments size ifFalse: + [^ self class primitiveFailTokenFor: #'bad number of arguments']. - [^ self error: ('Wrong number of arguments in simulated message {1}' translated format: {selector})]. (primIndex := meth primitive) > 0 ifTrue: [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. (self isPrimFailToken: val) ifFalse: [^val]]. ctxt := self activateMethod: meth withArgs: arguments receiver: rcvr. (primIndex isInteger and: [primIndex > 0]) ifTrue: [ctxt failPrimitiveWith: val]. ^ctxt!

1 0

The Trunk: KernelTests-ct.453.mcz
by commits＠source.squeak.org 25 Feb '24

25 Feb '24

Christoph Thiede uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ct.453.mcz ==================== Summary ==================== Name: KernelTests-ct.453 Author: ct Time: 25 February 2024, 8:46:33.380593 pm UUID: 081d7c84-95a3-3848-b6e6-a4a7c5007915 Ancestors: KernelTests-ct.452, KernelTests-ct.409, KernelTests-ct.417, KernelTests-ct.421, KernelTests-ct.448 Merges and revises several simulation tests from the inbox. As always, please refer to the original versions to read their full messages. KernelTests-ct.376: Tests #contextEnsure: and #contextOn:do:. Includes regression tests for Kernel-ct.1296. Revision: Reduced overdetailed commentary and overcautious exception handlers, now that simulation works more robust. KernelTests-ct.409: Adds new simulation tests for the reflection primitives 117 (primitiveExternalCall), 118 (primitiveDoPrimitiveWithArgs), and 218 (primitiveDoNamedPrimitiveWithArgs) and revises existing tests for the primitives 83 (primitivePerform), 84 (primitivePerformWithArgs), and 100 (primitivePerformInSuperclass) which do not need to be dispatched via primitive 118. Revision: Completely rework previously useless testPrimitive117. Revise examples in testPrimitive118: and testPrimitive218. Extend testPrimitive83 and testPrimitive84 with examples for invalid selectors and Objects as Methods and make the assertion more debug-friendly. Improve commentary. Document known failures due to erroneous VM behavior. Recategorize. KernelTests-ct.417: Acceptance tests for #runUntilErrorOrReturnFrom:. Revision: Test resumed simulation of context after error. KernelTests-ct.420: Tests simulation of primitive 188 (primitiveExecuteMethodArgsArray) and primitive 189 (primitiveExecuteMethod). Revision: Add example for invalid method to testPrimitive188:. Make assertions more debug-friendly. Improve commentary. KernelTests-ct.421: Tests handling of objects as methods (OaM) during simulation of Object>>#withArgs:executeMethod: and Object>>#with:...executeMethod:. KernelTests-ct.448: Complements Kernel-ct.1546 (fixes stepping through #mustBeBoolean errors and restarting from primitive methods that no longer fail). =============== Diff against KernelTests-ct.452 =============== Item was added: + ----- Method: ContextTest>>simulate: (in category 'private') ----- + simulate: aBlock + + | result | + [result := aBlock value] newProcess runUntil: [:ctxt | false]. + ^ result! Item was changed: + ----- Method: ContextTest>>testBlockCannotReturn (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testBlockCannotReturn (in category 'tests') ----- testBlockCannotReturn "Test if #return:from: correctly handles returns to dead or nil contexts." | p | p := [ thisContext pc: nil ] newProcess. p runUntil: [:ctx | ctx method selector = #pc: and: [ctx sender isDead]]. "assert p stoped at the last instruction, i.e. a return, of #pc: and is about to return to a dead context" self assert: p suspendedContext method selector equals: #pc:. self assert: p suspendedContext sender isDead. self assert: p suspendedContext willReturn. self assert: p suspendedContext atEnd. p step. "step into a return to a dead sender" self assert: p suspendedContext method selector = #cannotReturn:! Item was changed: + ----- Method: ContextTest>>testBlockCannotReturnToNil (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testBlockCannotReturnToNil (in category 'tests') ----- testBlockCannotReturnToNil "Test if #return:from: correctly handles returns to dead or nil contexts." | context nextContext | context := [] asContext. "assert p is at the last instruction, i.e. a return, and is about to return to a nil context" self assert: context method selector = thisContext method selector. self assert: context sender isNil. self assert: context willReturn. self assert: context atEnd. nextContext := context step. "step into a return to a nil sender" self assert: nextContext method selector = #cannotReturn:! Item was added: + ----- Method: ContextTest>>testContextEnsure (in category 'tests') ----- + testContextEnsure + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextEnsure: + [sideEffect := sideEffect + 1]). + sideEffect := 0]. + + result := block value. + + self assert: 0 equals: result. + self assert: 1 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextEnsureSimulation (in category 'tests') ----- + testContextEnsureSimulation + "Regression test for http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFr…" + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextEnsure: + [sideEffect := sideEffect + 1]). + sideEffect := 0]. + + result := self simulate: block. + + self assert: 0 equals: result. + self assert: 1 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextEnsureSimulationWithError (in category 'tests') ----- + testContextEnsureSimulationWithError + "Regression test for http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFr…" + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextEnsure: + [sideEffect := sideEffect + 1]). + sideEffect := 0. + self error]. + + result := self simulate: [[block value] on: Error do: [42]]. + + self assert: 42 equals: result. + self assert: 1 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextEnsureWithError (in category 'tests') ----- + testContextEnsureWithError + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextEnsure: + [sideEffect := sideEffect + 1]). + sideEffect := 0. + self error]. + + result := [block value] on: Error do: [42]. + + self assert: 42 equals: result. + self assert: 1 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextOnDo (in category 'tests') ----- + testContextOnDo + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextOn: Error do: + [sideEffect := sideEffect + 1]). + sideEffect := 0]. + + result := block value. + + self assert: 0 equals: result. + self assert: 0 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextOnDoSimulation (in category 'tests') ----- + testContextOnDoSimulation + "Regression test for http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFr…" + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextOn: Error do: + [sideEffect := sideEffect + 1]). + sideEffect := 0]. + + result := self simulate: block. + + self assert: 0 equals: result. + self assert: 0 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextOnDoSimulationWithError (in category 'tests') ----- + testContextOnDoSimulationWithError + "Regression test for http://forum.world.st/BUG-s-in-Context-control-jump-runUntilErrorOrReturnFr…" + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextOn: Error do: + [sideEffect := sideEffect + 1. + 42]). + sideEffect := 0. + self error]. + + result := self simulate: block. + + self assert: 42 equals: result. + self assert: 1 equals: sideEffect.! Item was added: + ----- Method: ContextTest>>testContextOnDoWithError (in category 'tests') ----- + testContextOnDoWithError + + | sideEffect block result | + block := + [sideEffect := nil. + thisContext insertSender: + (Context contextOn: Error do: + [sideEffect := sideEffect + 1. + 42]). + sideEffect := 0. + self error]. + + result := block value. + + self assert: 42 equals: result. + self assert: 1 equals: sideEffect.! Item was changed: + ----- Method: ContextTest>>testCopyStack (in category 'tests - query') ----- - ----- Method: ContextTest>>testCopyStack (in category 'tests') ----- testCopyStack self assert: aContext copyStack printString = aContext printString.! Item was changed: + ----- Method: ContextTest>>testCopyTo (in category 'tests - query') ----- - ----- Method: ContextTest>>testCopyTo (in category 'tests') ----- testCopyTo | context depth targetSender | context := thisContext. depth := 1. targetSender := context. [ (targetSender := targetSender sender) isNil ] whileFalse: [ | original copy | original := context. copy := context copyTo: targetSender. 1 to: depth do: [ :index | index = 1 ifFalse: [ "Since we're copying thisContext, the pc and stackPtr may be different for the current frame." self assert: original pc equals: copy pc; assert: original stackPtr equals: copy stackPtr ]. self deny: original == copy; assert: original method equals: copy method; assert: original closure equals: copy closure; assert: original receiver equals: copy receiver. original := original sender. copy := copy sender ]. self assert: copy isNil; assert: original == targetSender. depth := depth + 1 ]! Item was changed: + ----- Method: ContextTest>>testFindContextSuchThat (in category 'tests - query') ----- - ----- Method: ContextTest>>testFindContextSuchThat (in category 'tests') ----- testFindContextSuchThat self assert: (aContext findContextSuchThat: [:each| true]) printString = aContext printString. self assert: (aContext hasContext: aContext). ! Item was changed: + ----- Method: ContextTest>>testMessageNotUnderstood (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testMessageNotUnderstood (in category 'tests') ----- testMessageNotUnderstood "A simulation error (recursive message not understood) occurs that cannot be handled by the simulated code" self should: [Context runSimulated: [[TestEmptyClass new foo] on: Error do: [:ex | ex]]] raise: Error. "The simulator sends #doesNotUnderstand: to the receiver even if the lookup class has no superclass." self assert: [Context runSimulated: [self executeShould: [ProtoObject new foo] inScopeOf: MessageNotUnderstood]]. self assert: [Context runSimulated: [self executeShould: [Compiler evaluate: 'super foo' for: Object new] inScopeOf: MessageNotUnderstood]].! Item was changed: + ----- Method: ContextTest>>testObjectsAsMethod (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testObjectsAsMethod (in category 'tests') ----- testObjectsAsMethod | result error | + [SystemChangeNotifier uniqueInstance doSilently: [ - SystemChangeNotifier uniqueInstance doSilently: [ self class addSelector: #foo withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod)]. result := Context runSimulated: [[self foo] on: Error do: [:ex | error := ex]]. + error ifNotNil: [self fail: error]] - error ifNotNil: [self fail: error]. + ensure: + [SystemChangeNotifier uniqueInstance doSilently: [ + [self assert: self foo equals: result] + ensure: [self class removeSelector: #foo]]].! - SystemChangeNotifier uniqueInstance doSilently: [ - [self assert: self foo equals: result] - ensure: [self class removeSelector: #foo]].! Item was changed: + ----- Method: ContextTest>>testPrimitive100 (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testPrimitive100 (in category 'tests') ----- testPrimitive100 + "Test simulation of primitive 100." { {#isNil. {}. Object}. "valid 0-arg message" {#=. {true}. UndefinedObject}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}. Object}. "valid binary message" {{}. #=. {true}. SequenceableCollection}. "mirror primitive" + {'not a selector'. {}. Object}. "invalid selector" + {#isNil. 'not an array'. Object}. "invalid arguments" - {#isNil}. "missing arguments" - {#isNil. 'not an array'}. "invalid arguments" - {#isNil. {}}. "missing lookupClass" {#isNil. {'excess arg'}. Object}. "too many arguments" {#=. {}. UndefinedObject}. "missing argument" + {#isNil. {}. 'not a class'}. "invalid lookupClass" {#isNil. {}. Boolean}. "lookupClass not in inheritance chain" + } do: [:args | | block | + block := [[nil + perform: args first + withArguments: args second + inSuperclass: args third] + on: Error do: [:ex | ex description]]. - } do: [:args | self + assert: block value + equals: (Context runSimulated: block). + + block := [[thisContext + object: nil + perform: args first + withArguments: args second + inClass: args third] + on: Error do: [:ex | ex description]]. + self + assert: block value + equals: (Context runSimulated: block)].! - assert: (nil tryPrimitive: 100 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 100 withArgs: args])].! Item was added: + ----- Method: ContextTest>>testPrimitive117 (in category 'tests - simulation') ----- + testPrimitive117 + "Test simulation of primitive 117 (aka named primitives)." + + "valid 0-arg primitive" + self + assert: (Float32Array withAll: {2.0. 3.0}) sum "<-- primitive 117 (aka named primitive)" + equals: (Context runSimulated: [(Float32Array withAll: {2.0. 3.0}) sum]). "<-- simulator sends tryNamedPrimitiveIn:for:withArgs: (primitive 218)" + + "valid unary primitive" + self + assert: ('wiffy' hashWithInitialHash: 42) + equals: (Context runSimulated: ['wiffy' hashWithInitialHash: 42]). + + "superfluous arguments" + self "cascade!!" + assert: ('wiffy' hashWithInitialHash: 42) + equals: (Context runSimulated: ['wiffy' hashWithInitialHash: 42]); + assert: true.! Item was added: + ----- Method: ContextTest>>testPrimitive118 (in category 'tests - simulation') ----- + testPrimitive118 + "Test simulation of primitive 118." + + self testPrimitive118: [:receiver :primitiveIndex :arguments | + receiver tryPrimitive: primitiveIndex withArgs: arguments]. + + self flag: #bug. "Known bug: Mirror version of primitive 118 currently misbehaves in the OSVM." + self testPrimitive118: [:receiver :primitiveIndex :arguments | + thisContext receiver: receiver tryPrimitive: primitiveIndex withArgs: arguments].! Item was added: + ----- Method: ContextTest>>testPrimitive118: (in category 'tests - simulation') ----- + testPrimitive118: primitiveBlock + + | input1 input2 | + { + {#isNil. 62. {}}. "valid 0-arg primitive" + {6. 9. {7}}. "valid unary primitive" + {6. 62. {7}}. "failing primitive" + {6. 'not a primitive'. {7}}. "invalid primitive" + {6. 9. 'not an array'}. "invalid arguments" + {#isNil. 62. {1}}. "too many arguments" + {6. 9. {}}. "missing argument" + + {6. 83. {#=. 6.0}}. "primitivePerform" + {6. 83. {#isNil. 'excess arg'}}. "primitivePerform - too many arguments" + {6. 84. {#=. {6.0}}}. "primitivePerformWithArgs" + {6. 84. {#isNil. 'excess arg'}}. "primitivePerformWithArgs - invalid arguments" + {6. 100. {#=. 6.0. Object}}. "primitivePerformInSuperclass" + {6. 100. {#isNil. {'excess arg'}. Object}}. "primitivePerformInSuperclass - too many arguments" + + {6. 118. {9. {7}}}. "primitiveDoPrimitiveWithArgs" + {6. 118. {9. {7. 13}}}. "primitiveDoPrimitiveWithArgs - superfluous arguments" + {6. 118. {118. {9. {7}}}}. "primitiveDoPrimitiveWithArgs - nested invocation" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {}}}. "primitiveDoNamedPrimitiveWithArgs" + {thisContext. 218. {Float32Array >> #sum. Float32Array withAll: {2.0. 3.0}. {4.0}}}. "primitiveDoNamedPrimitiveWithArgs - superfluous arguments" + } do: [:args | | block | + block := [primitiveBlock valueWithArguments: args]. + self + assert: block value + equals: (Context runSimulated: block)]. + + self + assert: (primitiveBlock value: (input1 := {1. 2. 3}) value: 61 value: {2. 4}) + equals: (Context runSimulated: [primitiveBlock value: (input2 := {1. 2. 3}) value: 61 value: {2. 4}]); + assert: input1 + equals: input2.! Item was added: + ----- Method: ContextTest>>testPrimitive188 (in category 'tests - simulation') ----- + testPrimitive188 + "Test simulation of primitive 188." + + self testPrimitive188: [:receiver :args :compiledMethod | + receiver withArgs: args executeMethod: compiledMethod]. + + self testPrimitive188: [:receiver :args :compiledMethod | + CompiledMethod receiver: receiver withArguments: args executeMethod: compiledMethod].! Item was added: + ----- Method: ContextTest>>testPrimitive188: (in category 'tests - simulation') ----- + testPrimitive188: primitiveBlock + + | block | + { + {2. {}. SmallInteger >> #even}. "valid 0-arg message" + {2. {1}. Integer >> #<<}. "valid unary message" + {2. {3. 4}. Integer >> #raisedTo:modulo:}. "valid binary message" + {2. 'not an array'. Integer >> #<<}. "invalid arguments" + {2. {'excess arg'}. SmallInteger >> #even}. "too many arguments" + {2. {}. Integer >> #<<}. "missing argument" + {2. {1}. 'not a method'}. "invalid method" + {block := [(primitiveBlock valueWithArguments: {2. {3. 4}. TestObjectForMethod new xxxMethod: thisContext homeMethod}) + allButFirst "OaM selector is undefined behavior"]. {}. block class lookupSelector: #value} "object as method" + } do: [:args | + self + assert: ([primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex description]) + equals: (Context runSimulated: [[primitiveBlock valueWithArguments: args] on: Error do: [:ex | ex description]])].! Item was added: + ----- Method: ContextTest>>testPrimitive189 (in category 'tests - simulation') ----- + testPrimitive189 + "Test simulation of primitive 118." + + { + [2 executeMethod: SmallInteger >> #even]. "valid 0-arg message" + [2 with: 1 executeMethod: Integer >> #<<]. "valid unary message" + [2 with: 3 with: 4 executeMethod: Integer >> #raisedTo:modulo:]. "valid binary message" + [2 with: 1 executeMethod: Integer >> #even]. "too many arguments" + [2 executeMethod: Integer >> #<<]. "missing argument" + [2 with: 1 executeMethod: 'not a method']. "invalid method" + [(2 with: 3 with: 4 executeMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod)) + allButFirst "OaM selector is undefined behavior"] "object as method" + } do: [:block | + self + assert: (block on: Error do: [:ex | ex description]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex description]])].! Item was added: + ----- Method: ContextTest>>testPrimitive218 (in category 'tests') ----- + testPrimitive218 + "Test usage of primitive 218 through simulation." + + self testPrimitive117. + + "Test simulation of primitive 218." + self simulate: [self testPrimitive117].! Item was changed: + ----- Method: ContextTest>>testPrimitive83 (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testPrimitive83 (in category 'tests') ----- testPrimitive83 + "Test simulation of primitive 83." + self flag: #bug. "Known bug: Primitive 83 SPORADICALLY does NOT fail in the OSVM for missing argument!!" + { + [nil perform: #isNil]. "valid 0-arg message" + [nil perform: #= with: true]. "valid unary message" + [nil perform: #ifNil:ifNotNil: with: [2] with: [:x | x]]. "valid binary message" + [nil perform: #isNil with: 'excess arg']. "too many arguments" + [nil perform: #=]. "missing argument" + [nil perform: Object]. "invalid selector" + [[(self class + addSelector: #plonk:with: withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod); + perform: #plonk:with: with: 2 with: 3) allButFirst "OaM selector is undefined behavior"] + ensure: [self class removeSelector: #plonk]]. + } do: [:block | - {#isNil}. "valid 0-arg message" - {#=. true}. "valid unary message" - {#ifNil:ifNotNil:. [2]. [:x | x]}. "valid binary message" - {#isNil. 'excess arg'}. "too many arguments" - {#=}. "missing argument" - } do: [:args | self + assert: (block on: Error do: [:ex | ex description]) + equals: (Context runSimulated: [block on: Error do: [:ex | ex description]])].! - assert: (nil tryPrimitive: 83 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 83 withArgs: args])].! Item was changed: + ----- Method: ContextTest>>testPrimitive84 (in category 'tests - simulation') ----- - ----- Method: ContextTest>>testPrimitive84 (in category 'tests') ----- testPrimitive84 + "Test simulation of primitive 84." { {#isNil. {}}. "valid 0-arg message" {#=. {true}}. "valid unary message" {#ifNil:ifNotNil:. {[2]. [:x | x]}}. "valid binary message" - {#isNil}. "missing arguments" {#isNil. 'not an array'}. "invalid arguments" {#isNil. {'excess arg'}}. "too many arguments" {#=. {}}. "missing argument" + {Object. {}}. "invalid selector" + {#in:. + {[:it | + [(self class + addSelector: #plonk:with: withMethod: (TestObjectForMethod new xxxMethod: thisContext homeMethod); + perform: #plonk:with: withArguments: #(2 3)) allButFirst "OaM selector is undefined behavior"] + ensure: [self class removeSelector: #plonk]]}}. } do: [:args | self + assert: ([nil perform: args first withArguments: args second] on: Error do: [:ex | ex description]) + equals: (Context runSimulated: [[nil perform: args first withArguments: args second] on: Error do: [:ex | ex description]])].! - assert: (nil tryPrimitive: 84 withArgs: args) - equals: (Context runSimulated: [nil tryPrimitive: 84 withArgs: args])].! Item was added: + ----- Method: ContextTest>>testRestartCallPrimitive (in category 'tests') ----- + testRestartCallPrimitive + + | array context start | + array := Array new. + context := [[array at: 1] value] asContext. + [context selector = #at:] whileFalse: [context := context step]. + start := context sender. + + array become: (Array with: 42). + context privRefresh. + context := context stepToSendOrReturn. + + self assert: start equals: context. + self assert: context willReturn. + self assert: 42 equals: context top.! Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromError (in category 'tests') ----- + testRunUntilErrorOrReturnFromError + + | context process result sender error | + process := [result := 1 / 0] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: (context hasSender: sender). + self assert: (ZeroDivide handles: error). + + process suspendedContext: context. + process runUntil: [:ctxt | ctxt sender isNil]. + self assert: error identical: result.! Item was added: + ----- Method: ContextTest>>testRunUntilErrorOrReturnFromNoError (in category 'tests') ----- + testRunUntilErrorOrReturnFromNoError + + | context process result sender error | + process := [6 * 7] newProcess. + process runUntil: [:ctxt | ctxt receiver == self]. + context := process suspendedContext. + sender := context sender. + + result := context runUntilErrorOrReturnFrom: context. + context := result first. + error := result second. + + self assert: sender equals: context. + self assert: nil equals: error. + self assert: 42 equals: context top.!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2024