-
Notifications
You must be signed in to change notification settings - Fork 65
/
SpurImageSegmentTests.class.st
82 lines (78 loc) · 2.78 KB
/
SpurImageSegmentTests.class.st
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Class {
#name : #SpurImageSegmentTests,
#superclass : #LongTestCase,
#classVars : [
'CheckForLeaks'
],
#pools : [
'VMBasicConstants',
'VMClassIndices'
],
#category : #'VMMaker-OriginalTests'
}
{ #category : #accessing }
SpurImageSegmentTests class >> resources [
^{SpurTrunkImageTestResource}
]
{ #category : #private }
SpurImageSegmentTests >> initializedVM [
^self resources anyOne current initializedVM cloneSimulation
]
{ #category : #tests }
SpurImageSegmentTests >> testSaveHashedCollectionAndAllSubclasses [
SimulatorHarnessForTests new
withExecutableInterpreter: self initializedVM
do: [:vm :harness| | error objects |
CheckForLeaks == true ifTrue: "CheckForLeaks := self confirm: 'Check for leaks?'"
[vm objectMemory setCheckForLeaks: (vm objectMemory class bindingOf: #GCModeImageSegment) value].
error := harness findSymbol: #error.
self deny: error isNil.
objects := harness
interpreter: vm
object: (harness findClassNamed: 'Compiler')
perform: (harness findSymbol: #evaluate:)
withArguments: {vm objectMemory stringForCString:
'[| seg out roots result |
seg := WordArray new: 1024 * 1024.
out := Array new: 512.
roots := HashedCollection withAllSubclasses asArray.
roots := roots, (roots collect: [:ea| ea class]).
(thisContext isPrimFailToken: (nil tryPrimitive: 98 withArgs: { roots. seg. out })) ifTrue:
[^#error].
result := { seg. out }.
(thisContext isPrimFailToken: (nil tryPrimitive: 99 withArgs: result)) ifTrue:
[^#error].
result]
on: Error
do: [:ex| ^#error]'}.
self deny: objects = error]
]
{ #category : #tests }
SpurImageSegmentTests >> testSaveHashedCollectionSubclasses [
SimulatorHarnessForTests new
withExecutableInterpreter: self initializedVM
do: [:vm :harness| | error objects |
CheckForLeaks == true ifTrue: "CheckForLeaks := self confirm: 'Check for leaks?'"
[vm objectMemory setCheckForLeaks: (vm objectMemory class bindingOf: #GCModeImageSegment) value].
error := harness findSymbol: #error.
self deny: error isNil.
objects := harness
interpreter: vm
object: (harness findClassNamed: 'Compiler')
perform: (harness findSymbol: #evaluate:)
withArguments: {vm objectMemory stringForCString:
'[| seg out roots result |
seg := WordArray new: 1024 * 1024.
out := Array new: 256.
roots := HashedCollection subclasses asArray.
roots := roots, (roots collect: [:ea| ea class]).
(thisContext isPrimFailToken: (nil tryPrimitive: 98 withArgs: { roots. seg. out })) ifTrue:
[^#error].
result := { seg. out }.
(thisContext isPrimFailToken: (nil tryPrimitive: 99 withArgs: result)) ifTrue:
[^#error].
result]
on: Error
do: [:ex| ^#error]'}.
self deny: objects = error]
]