The Trunk: KernelTests-ul.400.mcz

Nicolas Cellier uploaded a new version of KernelTests to project The Trunk:
http://source.squeak.org/trunk/KernelTests-ul.400.mcz

==================== Summary ====================

Name: KernelTests-ul.400
Author: ul
Time: 14 April 2021, 12:14:51.757056 pm
UUID: 6234d088-bf14-4d00-8734-dde043b756ba
Ancestors: KernelTests-nice.399

WriteBarrierTest changes:
- removed symbol mutator methods
        - both #testMutateByteSymbolUsingPrivateAtPut and #testMutateWideSymbolUsingPrivateAtPut reference a non-existent #privateAt:put: method, and make the accessed symbol permanently writeable
        - with the removal of #pvtAt:put: from ByteSymbol and WideSymbol, the tests seem to be unnecessary (see Collections-ul.939)
- fix copy-paste error in #testMutateObjectInstVarUsingBasicAtPut: test #basicAt:put: instead of #at:put:
- avoid having MirrorPrimitives in Undeclared by removing direct references to it in WriteBarrierTest. Perhaps MirrorPrimitives should be moved to the Trunk from VMMaker


- use temporaries in CompiledMethodComparisonTest >> #testHash to improve legibility

=============== Diff against KernelTests-nice.399 ===============

Item was changed:
  ----- Method: CompiledMethodComparisonTest>>testHash (in category 'tests') -----
  testHash
  <timeout: 120>
 
  | ai |
  ai := CompiledMethod allInstances.
  "We assume here that if two CompiledMethods are equal then they have the same size and header."
  (ai groupBy: [ :method | { method size. method header } ]) values
  replace: [ :each | each asArray ];
  do: [ :methods |
  1 to: methods size do: [ :i |
+ | firstMethod |
+ firstMethod := methods at: i.
  i to: methods size do: [ :j |
+ | secondMethod |
+ secondMethod := methods at: j.
+ firstMethod = secondMethod ifTrue: [
+ self assert: firstMethod hash equals: secondMethod hash ] ] ] ]
- (methods at: i) = (methods at: j) ifTrue: [
- self assert: (methods at: i) hash equals: (methods at: j) hash ] ] ] ]
  displayingProgress: 'Testing hashes'.
  self assert: (ai collect: [ :cm | cm hash ] as: Set) size * 2 >= ai asSet size!

Item was changed:
  ----- Method: WriteBarrierTest>>expectedFailures (in category 'expected failures') -----
  expectedFailures
  Smalltalk supportsReadOnlyObjects ifFalse:
  [^self class testSelectors].
  ^#( testMutateByteArrayUsingDoubleAtPut testMutateByteArrayUsingFloatAtPut ),
+  (self mirrorPrimitives
-  ((Smalltalk classNamed: #MirrorPrimitives)
  ifNil: [#(testBasicProxyReadOnly testBasicProxyWritable testSetIsReadOnlySuccessProxy)]
  ifNotNil: [#()])!

Item was added:
+ ----- Method: WriteBarrierTest>>mirrorPrimitives (in category 'tests - helper') -----
+ mirrorPrimitives
+
+ ^Smalltalk classNamed: #MirrorPrimitives!

Item was changed:
  ----- Method: WriteBarrierTest>>testBasicProxyReadOnly (in category 'tests - proxy') -----
  testBasicProxyReadOnly
  self alwaysReadOnlyObjects do: [ :each |
+ self assert: (self mirrorPrimitives isObjectReadOnly: each) equals: true ]!
- self assert: (MirrorPrimitives isObjectReadOnly: each) equals: true ]!

Item was changed:
  ----- Method: WriteBarrierTest>>testBasicProxyWritable (in category 'tests - proxy') -----
  testBasicProxyWritable
  self alwaysWritableObjects , self maybeReadOnlyObjects do: [ :each |
+ self assert: (self mirrorPrimitives isObjectReadOnly: each) equals: false ]!
- self assert: (MirrorPrimitives isObjectReadOnly: each) equals: false ]!

Item was removed:
- ----- Method: WriteBarrierTest>>testMutateByteSymbolUsingPrivateAtPut (in category 'tests - object') -----
- testMutateByteSymbolUsingPrivateAtPut
- | guineaPig |
- [guineaPig := #hello.
- guineaPig beReadOnlyObject.
-
- self
- should: ((guineaPig class includesSelector: #pvtAt:put:)
- ifTrue: [[ guineaPig perform: #pvtAt:put: with: 1 with: $q ]] "Squeak refuses to compile non-self sends of pvt* selectors."
- ifFalse: [[ guineaPig privateAt: 1 put: $q ]])
- raise: ModificationForbidden ]
- ensure:
- [ guineaPig beWritableObject ].
-
- self assert: guineaPig first equals: $h!

Item was changed:
  ----- Method: WriteBarrierTest>>testMutateObjectInstVarUsingBasicAtPut (in category 'tests - object') -----
  testMutateObjectInstVarUsingBasicAtPut
  | guineaPig |
  guineaPig := Array new: 5.
  guineaPig beReadOnlyObject.
 
  self
  should: [ guineaPig basicAt: 1 put: #test  ]
  raise: ModificationForbidden.
 
+ [ guineaPig basicAt: 1 put: #test ]
- [ 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!

Item was removed:
- ----- Method: WriteBarrierTest>>testMutateWideSymbolUsingPrivateAtPut (in category 'tests - object') -----
- testMutateWideSymbolUsingPrivateAtPut
- | guineaPig |
- [ guineaPig := ('hello', (Character codePoint: 8002) asString) asSymbol.
- guineaPig beReadOnlyObject.
-
- self
- should: ((guineaPig class includesSelector: #pvtAt:put:)
- ifTrue: [[ guineaPig perform: #pvtAt:put: with: 1 with: $A ]] "Squeak refuses to compile non-self sends of pvt* selectors."
- ifFalse: [[ guineaPig privateAt: 1 put: $A ]])
- raise: ModificationForbidden ]
- ensure: [ guineaPig beWritableObject ].
-
- self assert: guineaPig first  equals: $h!

Item was changed:
  ----- Method: WriteBarrierTest>>testProxyObject:initialState:tuples: (in category 'tests - helper') -----
  testProxyObject: object initialState: initialState tuples: tuples
  self
  testObject: object
  initialState: initialState
  tuples: tuples
  setReadOnlyBlock: [ :value |
+ self mirrorPrimitives makeObject: object readOnly: value ]!
- MirrorPrimitives makeObject: object readOnly: value ]!