15 poolDictionaries:'' |
15 poolDictionaries:'' |
16 privateIn:SnapshotRestartTests |
16 privateIn:SnapshotRestartTests |
17 ! |
17 ! |
18 |
18 |
19 |
19 |
20 !SnapshotRestartTests methodsFor:'asserting'! |
|
21 |
|
22 assertAllTestsPassed: logfile |
|
23 | innerSuite expected logfileContents | |
|
24 |
|
25 innerSuite := ToRunOnFreshAndRestartedSnapshotTests buildSuite. |
|
26 expected := '%1 run, %1 passed, 0 skipped, 0 failed, 0 errors ### HERE ### ' bindWith: innerSuite tests size. |
|
27 logfile readingFileDo:[:s | |
|
28 [ s atEnd ] whileFalse:[ |
|
29 | line | |
|
30 |
|
31 line := s nextLine. |
|
32 "/ Uss starts with because on Windows you get 0xD chars at the end, sigh |
|
33 (line startsWith: expected) ifTrue:[ ^ self ]. |
|
34 ] |
|
35 ]. |
|
36 " |
|
37 logfile contents asString |
|
38 " |
|
39 logfile readingFileDo: [ :f | |
|
40 "Read at most 5MB of the log to avoid reading gigabytes |
|
41 of output produced by a 'thundestorm'." |
|
42 logfileContents := f next: (logfile fileSize min: (16 * 1024"16Kb")). |
|
43 "/ logfileContents := 'Disabled'. |
|
44 ]. |
|
45 self assert: false description: ('Not all inner tests passed: ' , logfileContents). |
|
46 |
|
47 "Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
48 "Modified (format): / 31-05-2016 / 17:00:27 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
49 ! ! |
|
50 |
|
51 !SnapshotRestartTests methodsFor:'compilation'! |
20 !SnapshotRestartTests methodsFor:'compilation'! |
52 |
21 |
53 make |
22 make |
54 ^ self make:''. |
23 ^ self make:''. |
55 |
24 |
56 "Created: / 14-08-2013 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
25 "Created: / 14-08-2013 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
57 ! |
26 ! |
58 |
27 |
59 make: target |
28 make: target |
60 | cmd | |
29 | cmd | |
|
30 pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'. |
|
31 self assert: pkgdir notNil. |
|
32 self assert: pkgdir isDirectory. |
61 |
33 |
62 OperatingSystem isMSWINDOWSlike ifTrue:[ |
34 OperatingSystem isMSWINDOWSlike ifTrue:[ |
63 STCCompilerInterface getCCDefine = '__BORLANDC__' ifTrue:[ |
35 STCCompilerInterface getCCDefine = '__BORLANDC__' ifTrue:[ |
64 cmd := 'bmake.bat ' , target. |
36 cmd := 'bmake.bat ' , target. |
65 ]. |
37 ]. |
96 assert: (OperatingSystem executeCommand: cmd inDirectory: pkgdir) |
68 assert: (OperatingSystem executeCommand: cmd inDirectory: pkgdir) |
97 description: 'Failed to make target ''', target, ''' in test package'. |
69 description: 'Failed to make target ''', target, ''' in test package'. |
98 |
70 |
99 "Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
71 "Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
100 "Modified: / 05-11-2016 / 22:48:25 / jv" |
72 "Modified: / 05-11-2016 / 22:48:25 / jv" |
101 "Modified: / 10-11-2016 / 00:23:35 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
73 "Modified: / 06-01-2017 / 23:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
74 ! ! |
|
75 |
|
76 !SnapshotRestartTests methodsFor:'private'! |
|
77 |
|
78 do: setupBlock onRestartDo: restartBlock |
|
79 self assert: setupBlock byteCode notNil description: 'setupBlock must have bytecode - stc-compiled blocks not supported'. |
|
80 self assert: restartBlock byteCode notNil description: 'restartBlock must have bytecode - stc-compiled blocks not supported'. |
|
81 |
|
82 setupBlock value. |
|
83 Smalltalk addImageStartBlock:[ |
|
84 [ |
|
85 Stdout nextPutLine:'===> Restarted from snapshot'. |
|
86 restartBlock value. |
|
87 Smalltalk exit: EXIT_CODE_SUCCESS. |
|
88 ] fork |
|
89 ]. |
|
90 Stdout nextPutLine:'===> Saving snapshot to ', testSelector , '.img'. |
|
91 ObjectMemory snapShotOn: testSelector , '.img'. |
|
92 Smalltalk exit: EXIT_CODE_SUCCESS. |
|
93 |
|
94 "Created: / 06-01-2017 / 22:14:51 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
95 "Modified: / 06-01-2017 / 23:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
96 ! |
|
97 |
|
98 performTest |
|
99 | tempDir imageFile | |
|
100 |
|
101 [ |
|
102 tempDir := Filename newTemporary. |
|
103 tempDir makeDirectory. |
|
104 self spawnSelector:#performTestInternal inDirectory:tempDir. |
|
105 |
|
106 imageFile := tempDir / (testSelector , '.img'). |
|
107 self assert: imageFile exists description: 'Image file does not exist - did test save it?'. |
|
108 self spawnSmalltalk: { '--image' . imageFile pathName } inDirectory: tempDir |
|
109 ] ensure:[ |
|
110 (tempDir notNil and:[ tempDir exists ]) ifTrue:[ |
|
111 [ |
|
112 tempDir recursiveRemove. |
|
113 ] on:Error |
|
114 do:[:ex | |
|
115 OperatingSystem isMSWINDOWSlike ifFalse:[ |
|
116 ex reject. |
|
117 ]. |
|
118 ] |
|
119 ]. |
|
120 ]. |
|
121 |
|
122 "Created: / 06-01-2017 / 22:05:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
123 ! |
|
124 |
|
125 performTestInternal |
|
126 super performTest. |
|
127 |
|
128 "Created: / 06-01-2017 / 22:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
102 ! ! |
129 ! ! |
103 |
130 |
104 !SnapshotRestartTests methodsFor:'running'! |
131 !SnapshotRestartTests methodsFor:'running'! |
105 |
|
106 runTestsOnFreshImage |
|
107 | script log logfile | |
|
108 |
|
109 script := pkgdir / 'run-ToRunOnFreshAndRestartedSnapshotTests-tests.st'. |
|
110 self assert: script exists. |
|
111 log := FileStream newTemporaryIn: Filename currentDirectory nameTemplate: ('RegressionTests__SnapshotRestartTests-' , testSelector , '%1-%2.log'). |
|
112 logfile := log fileName. |
|
113 [ |
|
114 OperatingSystem executeCommand: ('%1 --execute %2' bindWith: exe with: script asAbsoluteFilename pathName) outputTo: log errorTo: log inDirectory: tmpdir pathName. |
|
115 ] ensure:[ |
|
116 log close. |
|
117 ]. |
|
118 |
|
119 self assertAllTestsPassed: logfile. |
|
120 |
|
121 "Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
122 "Modified: / 13-09-2013 / 12:54:53 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
123 ! |
|
124 |
|
125 runTestsOnRestartedImage |
|
126 | log logfile | |
|
127 |
|
128 log := FileStream newTemporaryIn: Filename currentDirectory nameTemplate: ('RegressionTests__SnapshotRestartTests-' , testSelector , '%1-%2.log'). |
|
129 logfile := log fileName. |
|
130 [ |
|
131 OperatingSystem executeCommand: ('%1 -i %2' bindWith: exe with: (tmpdir / 'restart.img') pathName ) outputTo: log errorTo: log inDirectory: tmpdir pathName |
|
132 ] ensure:[ |
|
133 log close. |
|
134 ]. |
|
135 self assertAllTestsPassed: logfile. |
|
136 |
|
137 "Created: / 14-08-2013 / 20:10:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
138 "Modified: / 13-09-2013 / 12:54:48 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
139 ! |
|
140 |
132 |
141 setUp |
133 setUp |
142 tmpdir := Filename newTemporaryDirectory. |
134 tmpdir := Filename newTemporaryDirectory. |
143 pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'. |
|
144 self assert: pkgdir notNil. |
|
145 self assert: pkgdir isDirectory. |
|
146 |
|
147 exe := OperatingSystem pathOfSTXExecutable. |
135 exe := OperatingSystem pathOfSTXExecutable. |
148 |
|
149 self make:'clobber'. |
136 self make:'clobber'. |
150 |
137 |
151 "Created: / 14-08-2013 / 18:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
138 "Created: / 14-08-2013 / 18:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
152 "Modified: / 14-08-2013 / 20:17:01 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
139 "Modified (format): / 06-01-2017 / 23:21:54 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
153 ! |
140 ! |
154 |
141 |
155 tearDown |
142 tearDown |
156 tmpdir recursiveRemove. |
143 tmpdir recursiveRemove. |
157 |
144 |
159 ! ! |
146 ! ! |
160 |
147 |
161 !SnapshotRestartTests methodsFor:'tests'! |
148 !SnapshotRestartTests methodsFor:'tests'! |
162 |
149 |
163 test_bc |
150 test_bc |
164 |
151 "Test restart with bytecode-compiled package" |
165 "Test restsrt with bytecode-compiled package" |
152 |
166 |
153 | result | |
167 self runTestsOnFreshImage. |
154 |
168 self runTestsOnRestartedImage. |
155 self do:[ |
|
156 result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run. |
|
157 self assert: result errorCount == 0. |
|
158 self assert: result failureCount == 0. |
|
159 ] onRestartDo:[ |
|
160 result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run. |
|
161 self assert: result errorCount == 0. |
|
162 self assert: result failureCount == 0. |
|
163 ]. |
169 |
164 |
170 "Created: / 14-08-2013 / 19:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
165 "Created: / 14-08-2013 / 19:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
166 "Modified: / 06-01-2017 / 23:37:48 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
171 ! |
167 ! |
172 |
168 |
173 test_stc |
169 test_stc |
174 |
170 "Test restart with bytecode-compiled package" |
175 "Test restsrt with bytecode-compiled package" |
171 |
176 |
172 | result | |
177 self make. |
173 |
178 self runTestsOnFreshImage. |
174 self do:[ |
179 self runTestsOnRestartedImage. |
175 self make. |
|
176 result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run. |
|
177 self assert: result errorCount == 0. |
|
178 self assert: result failureCount == 0. |
|
179 ] onRestartDo:[ |
|
180 result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run. |
|
181 self assert: result errorCount == 0. |
|
182 self assert: result failureCount == 0. |
|
183 ]. |
180 |
184 |
181 "Created: / 14-08-2013 / 20:26:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
185 "Created: / 14-08-2013 / 20:26:06 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
186 "Modified: / 06-01-2017 / 23:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
182 ! ! |
187 ! ! |
183 |
188 |
184 !SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'running'! |
189 !SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'running'! |
185 |
190 |
186 setUp |
191 setUp |