[squeak-dev] The Trunk: KernelTests-eem.377.mczcommits at source.squeak.org commits at source.squeak.orgThu Mar 12 01:50:56 UTC 2020
Eliot Miranda uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-eem.377.mcz ==================== Summary ==================== Name: KernelTests-eem.377 Author: eem Time: 11 March 2020, 6:50:54.691022 pm UUID: ffe697e5-da6e-4c3c-98ac-fd190f0169eb Ancestors: KernelTests-eem.376 WriteBarrierTest Add a test for become. Add a test for updating multiple inst vars in a single method. Extend several of the tests to include additional testing of being able to separate retryModificationNoresume from resume =============== Diff against KernelTests-eem.376 =============== Item was added: + ----- Method: WriteBarrierTest>>testAttemptToMutateLiterals (in category 'tests - object') ----- + testAttemptToMutateLiterals + | guineaPigs | + guineaPigs := {#[1 2 3] . #(1 2 3) }. + guineaPigs do: + [ :guineaPig | + self should: [guineaPig at: 1 put: 4] + raise: ModificationForbidden]. + + self should: [guineaPigs first become: guineaPigs second ] + raise: ModificationForbidden. + + self should: [ByteString adoptInstance: guineaPigs first] + raise: ModificationForbidden. + + self should: [WeakArray adoptInstance: guineaPigs last] + raise: ModificationForbidden! Item was added: + ----- Method: WriteBarrierTest>>testBecomeReadOnly (in category 'tests - object') ----- + testBecomeReadOnly + | readOnlyArrays readOnlyByteArrays | + readOnlyArrays := (1 to: 3) collect: [:n| (0 to: n) asArray beReadOnlyObject; yourself]. + "N.B. if the targets are read-only this fails, which is correct for elementsForwardIdentityTo: since copyHash is implicitly true; + we need to write a test for a putative elementsForwardIdentityNoCopyHashTo:" + readOnlyByteArrays := (1 to: 3) collect: [:n| (0 to: n) asByteArray" beReadOnlyObject; yourself"]. + self should: [readOnlyArrays elementsForwardIdentityTo: readOnlyByteArrays] + raise: ModificationForbidden. + [readOnlyArrays elementsForwardIdentityTo: readOnlyByteArrays] + on: ModificationForbidden + do: [:ex| + false + ifTrue: "This fails, but should succeed. I *think* it's to do with catching signals when resignalling" + [(ex mirror detect: [:element| element isReadOnlyObject] ifNone: []) ifNotNil: + [:readOnlyObj| readOnlyObj beWritableObject]] + ifFalse: + [ex mirror do: [:element| element beWritableObject]]. + ex retryModification]. + self assert: (readOnlyArrays allSatisfy: [:array| array class == ByteArray])! Item was changed: ----- Method: WriteBarrierTest>>testMutateByteArrayUsingByteAtPut (in category 'tests - object') ----- testMutateByteArrayUsingByteAtPut | guineaPig | guineaPig := ByteArray new: 5. guineaPig beReadOnlyObject. self should: [ guineaPig byteAt: 1 put: 12 ] raise: ModificationForbidden. [ guineaPig byteAt: 1 put: 12 ] on: ModificationForbidden do: [:modification | self assert: modification fieldIndex equals: 1. modification object beWritableObject. modification retryModification ]. + self assert: guineaPig first equals: 12. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + self + should: [ guineaPig byteAt: 1 put: 13 ] + raise: ModificationForbidden. + + [ guineaPig byteAt: 1 put: 13 ] + on: ModificationForbidden + do: [ :modification | + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume]. + + self assert: guineaPig first equals: 13. + self assert: guineaPig isReadOnlyObject! - self assert: guineaPig first equals: 12! Item was changed: ----- Method: WriteBarrierTest>>testMutateByteArrayUsingDoubleAtPut (in category 'tests - object') ----- testMutateByteArrayUsingDoubleAtPut | guineaPig | guineaPig := ByteArray new: 8. guineaPig beReadOnlyObject. self should: [ guineaPig doubleAt: 1 put: (2 raisedTo: 65) asFloat ] raise: ModificationForbidden. [ guineaPig doubleAt: 1 put: (2 raisedTo: 65) asFloat ] on: ModificationForbidden do: [:modification | self assert: modification fieldIndex equals: 1. modification object beWritableObject. modification retryModification ]. + self assert: guineaPig first equals: (2 raisedTo: 65) asFloat. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + self + should: [ guineaPig doubleAt: 1 put: (2 raisedTo: 64) asFloat ] + raise: ModificationForbidden. + + [ guineaPig doubleAt: 1 put: (2 raisedTo: 64) asFloat ] + on: ModificationForbidden + do: [ :modification | + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume]. + + self assert: guineaPig first equals: (2 raisedTo: 64) asFloat. + self assert: guineaPig isReadOnlyObject! - self assert: guineaPig first equals: (2 raisedTo: 65) asFloat! Item was changed: ----- Method: WriteBarrierTest>>testMutateByteArrayUsingFloatAtPut (in category 'tests - object') ----- testMutateByteArrayUsingFloatAtPut | guineaPig | guineaPig := ByteArray new: 5. guineaPig beReadOnlyObject. self should: [ guineaPig floatAt: 1 put: 1.0 ] raise: ModificationForbidden. [ guineaPig floatAt: 1 put: 1.0 ] on: ModificationForbidden do: [:modification | self assert: modification fieldIndex equals: 1. modification object beWritableObject. modification retryModification ]. + self assert: guineaPig first equals: 1.0. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + + self + should: [ guineaPig floatAt: 1 put: 2.0 ] + raise: ModificationForbidden. + + [ guineaPig floatAt: 1 put: 2.0 ] + on: ModificationForbidden + do: [:modification | + self assert: modification fieldIndex equals: 1. + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume]. + + self assert: guineaPig first equals: 2.0. + self assert: guineaPig isReadOnlyObject! - self assert: guineaPig first equals: 1.0! Item was changed: ----- Method: WriteBarrierTest>>testMutateByteStringyUsingAtPut (in category 'tests - object') ----- testMutateByteStringyUsingAtPut | guineaPig | guineaPig := ByteString new: 5. guineaPig beReadOnlyObject. self should: [ guineaPig at: 1 put: $h ] raise: ModificationForbidden. [ guineaPig at: 1 put: $h ] on: ModificationForbidden do: [:modification | self assert: modification fieldIndex equals: 1. modification object beWritableObject. modification retryModification ]. + self assert: guineaPig first equals: $h. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + + self + should: [ guineaPig at: 1 put: $g ] + raise: ModificationForbidden. + + [ guineaPig at: 1 put: $g ] + on: ModificationForbidden + do: [:modification | + self assert: modification fieldIndex equals: 1. + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume ]. + + self assert: guineaPig first equals: $g. + self assert: guineaPig isReadOnlyObject! - self assert: guineaPig first equals: $h! Item was changed: ----- Method: WriteBarrierTest>>testMutateObjectClassViaAdoption (in category 'tests - object') ----- testMutateObjectClassViaAdoption | guineaPig | guineaPig := WriteBarrierStub new. guineaPig beReadOnlyObject. self should: [ WriteBarrierAnotherStub adoptInstance: guineaPig ] raise: ModificationForbidden. [ WriteBarrierAnotherStub adoptInstance: guineaPig ] on: ModificationForbidden do: [ :modification | modification object beWritableObject. modification retryModification ]. + self assert: guineaPig class equals: WriteBarrierAnotherStub. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + self + should: [ WriteBarrierAnotherStub adoptInstance: guineaPig ] + raise: ModificationForbidden. + + [ WriteBarrierAnotherStub adoptInstance: guineaPig ] + on: ModificationForbidden + do: [ :modification | + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume]. + + self assert: guineaPig class equals: WriteBarrierAnotherStub. + self assert: guineaPig isReadOnlyObject! - self assert: guineaPig class equals: WriteBarrierAnotherStub! Item was changed: ----- Method: WriteBarrierTest>>testMutateObjectInstVarUsingAtPut (in category 'tests - object') ----- testMutateObjectInstVarUsingAtPut | guineaPig | guineaPig := Array new: 5. guineaPig beReadOnlyObject. self should: [ guineaPig at: 1 put: #test ] raise: ModificationForbidden. [ guineaPig at: 1 put: #test ] on: ModificationForbidden do: [:modification | self assert: modification fieldIndex equals: 1. modification object beWritableObject. modification retryModification ]. + self assert: guineaPig first equals: #test. + self deny: guineaPig isReadOnlyObject. + + guineaPig beReadOnlyObject. + + self + should: [ guineaPig at: 1 put: #test ] + raise: ModificationForbidden. + + [ guineaPig at: 1 put: #test ] + on: ModificationForbidden + do: [:modification | + self assert: modification fieldIndex equals: 1. + modification object beWritableObject. + modification retryModificationNoResume. + modification object beReadOnlyObject. + modification resume ]. + + self assert: guineaPig first equals: #test. + self assert: guineaPig isReadOnlyObject + ! - self assert: guineaPig first equals: #test! Item was added: + ----- Method: WriteBarrierTest>>testRetryingPointInstVarModification (in category 'tests - object') ----- + testRetryingPointInstVarModification + | guineaPig labRat | + guineaPig := 1 at 2. + labRat := guineaPig copy bitShiftPoint: 3. + guineaPig beReadOnlyObject. + + [ guineaPig bitShiftPoint: 3 ] + on: ModificationForbidden + do: [:err | + guineaPig beWritableObject. + err retryModification ]. + + self assert: guineaPig equals: labRat. + self deny: guineaPig isReadOnlyObject. + + guineaPig bitShiftPoint: -3; beReadOnlyObject. + self assert: guineaPig equals: 1 at 2. + + [ guineaPig bitShiftPoint: 3 ] + on: ModificationForbidden + do: [:err | + guineaPig beWritableObject. + err retryModificationNoResume. + guineaPig beReadOnlyObject. + err resume ]. + + self assert: guineaPig equals: labRat. + self assert: guineaPig isReadOnlyObject!
More information about the Squeak-dev mailing list |