"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
VMSpawningTestCase subclass:#SnapshotRestartTests
instanceVariableNames:'pkgdir exe tmpdir'
classVariableNames:''
poolDictionaries:''
category:'tests-Regression'
!
TestCase subclass:#ToRunOnFreshAndRestartedSnapshotTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:SnapshotRestartTests
!
!SnapshotRestartTests methodsFor:'compilation'!
make
^ self make:''.
"Created: / 14-08-2013 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
make: target
| cmd output success |
pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'.
self assert: pkgdir notNil.
self assert: pkgdir isDirectory.
OperatingSystem isMSWINDOWSlike ifTrue:[
"/ Hack: generally we don't require Borland tools to be installed anymore.
"/ However, package build is driwen by Borland make so we distribute
"/ it with rakefiles. It's likely not in the PATH, so add it.
"/ This code assumes the test is run from build environment.
OperatingSystem setEnvironment: 'PATH' to:
(OperatingSystem pathOfSTXExecutable asFilename directory / '..' / '..' / '..' / '..' / 'bin') pathName , ';',
(OperatingSystem getEnvironment: 'PATH').
STCCompilerInterface getCCDefine = '__BORLANDC__' ifTrue:[
cmd := 'bmake.bat ' , target.
].
STCCompilerInterface getCCDefine = '__MINGW32__' ifTrue:[
(OperatingSystem getEnvironment: 'MINGW_DIR') isNil ifTrue:[
| mingwDir |
mingwDir := #('C:\MSYS64\MINGW32' 'C:\MINGW') detect:[:path | path asFilename isDirectory ] ifNone: [ nil ].
self assert: mingwDir notNil description: 'MINGW_DIR environment variable not set and MINGW32 not found at standard places'.
OperatingSystem setEnvironment: 'MINGW_DIR' to: mingwDir.
].
OperatingSystem setEnvironment: 'MINGW' to: '__MINGW32__'.
OperatingSystem setEnvironment: 'USEMINGW_ARG' to: '-DUSEMINGW32'.
OperatingSystem setEnvironment: 'PATH' to: (OperatingSystem getEnvironment: 'PATH') , ';' , (OperatingSystem getEnvironment: 'MINGW_DIR') , '\bin'.
cmd := 'mingwmake.bat ' , target.
].
STCCompilerInterface getCCDefine = '__MINGW64__' ifTrue:[
(OperatingSystem getEnvironment: 'MINGW_DIR') isNil ifTrue:[
| mingwDir |
mingwDir := #('C:\MSYS64\MINGW64' 'C:\MINGW64') detect:[:path | path asFilename isDirectory ] ifNone: [ nil ].
self assert: mingwDir notNil description: 'MINGW_DIR environment variable not set and MINGW64 not found at standard places'.
OperatingSystem setEnvironment: 'MINGW_DIR' to: mingwDir.
].
OperatingSystem setEnvironment: 'MINGW' to: '__MINGW64__'.
OperatingSystem setEnvironment: 'USEMINGW_ARG' to: '-DUSEMINGW64'.
OperatingSystem setEnvironment: 'PATH' to: (OperatingSystem getEnvironment: 'PATH') , ';' , (OperatingSystem getEnvironment: 'MINGW_DIR') , '\bin'.
cmd := 'mingwmake.bat ' , target.
].
] ifFalse:[
cmd := 'make -f Makefile.init ', target
].
output := String streamContents:[ :s|
success := OperatingSystem executeCommand: cmd outputTo: s inDirectory: pkgdir
].
"/ Following is just to ease debugging on Jenkins since stdout
"/ is shown in the report.
success ifFalse:[
Stdout nextPutLine: 'Failed to make target ''', target, ''' in test package'.
Stdout nextPutLine: output.
].
self
assert: success
description: 'Failed to make target ''', target, ''' in test package'.
"Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-01-2017 / 23:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 10-06-2017 / 21:47:51 / jv"
! !
!SnapshotRestartTests methodsFor:'private'!
do: setupBlock onRestartDo: restartBlock
self assert: setupBlock byteCode notNil description: 'setupBlock must have bytecode - stc-compiled blocks not supported'.
self assert: restartBlock byteCode notNil description: 'restartBlock must have bytecode - stc-compiled blocks not supported'.
setupBlock value.
Smalltalk addImageStartBlock:[
[
Stdout nextPutLine:'===> Restarted from snapshot'.
restartBlock value.
Smalltalk exit: EXIT_CODE_SUCCESS.
] fork
].
Stdout nextPutLine:'===> Saving snapshot to ', testSelector , '.img'.
ObjectMemory snapShotOn: testSelector , '.img'.
Smalltalk exit: EXIT_CODE_SUCCESS.
"Created: / 06-01-2017 / 22:14:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-01-2017 / 23:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
performTest
| imageFile |
imageFile := tmpdir / (testSelector , '.img').
self spawnSelector:#performTestInternal inDirectory:tmpdir.
self assert: imageFile exists description: 'Image file does not exist - did test save it?'.
"/ For debugging purposes, save output.txt
( tmpdir / 'output.txt' ) exists ifTrue:[
(tmpdir / 'output.txt') moveTo: (tmpdir / 'output0.txt')
].
self spawnSmalltalk: { '--image' . imageFile pathName } inDirectory: tmpdir.
"/ If control reaches this point, the test was successful. In that case.
"/ remove the temp directory.
[
tmpdir recursiveRemove
] on: Error do:[:ex |
OperatingSystem isMSWINDOWSlike ifTrue:[
"/ Argh, Windows and its file locking...
Delay waitForSeconds: 1.
Error ignoreIn: [ tmpdir recursiveRemove ] .
] ifFalse:[
ex reject.
].
].
"Created: / 06-01-2017 / 22:05:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-02-2017 / 09:35:37 / jv"
!
performTestInternal
super performTest.
"Created: / 06-01-2017 / 22:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests methodsFor:'running'!
setUp
super setUp.
tmpdir := Filename newTemporaryDirectory.
exe := OperatingSystem pathOfSTXExecutable.
self make:'clobber'.
"Created: / 14-08-2013 / 18:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 06-01-2017 / 23:21:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 27-02-2017 / 09:32:41 / jv"
!
tearDown
super tearDown.
"/ No, don't remove the temp directory here. This is done in
"/ #performTest and only if test is successful. If not, leave
"/ it behind for debugging purposes.
"/ tmpdir recursiveRemove.
"Created: / 14-08-2013 / 20:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 27-02-2017 / 09:32:38 / jv"
! !
!SnapshotRestartTests methodsFor:'tests'!
test_bc
"Test restart with bytecode-compiled package"
| result |
self do:[
Display isNil ifTrue:[Smalltalk openDisplay].
self skipIf: (OperatingSystem isMSWINDOWSlike and:[Display isNil]) description: 'No display available'.
result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.
self assert: result errorCount == 0.
self assert: result failureCount == 0.
] onRestartDo:[
result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.
self assert: result errorCount == 0.
self assert: result failureCount == 0.
].
"Created: / 14-08-2013 / 19:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-03-2017 / 12:25:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_gui_reopening
"
Test that GUI reopens just fine.
"
| workspace browser |
self do:[
Display isNil ifTrue:[Smalltalk openDisplay].
self skipIf: Display isNil description: 'No display available'.
workspace := WorkspaceApplication new.
workspace open.
workspace window waitUntilVisible.
browser := Tools::NewSystemBrowser new.
browser open.
browser window waitUntilVisible.
self assert: workspace window notNil.
self assert: workspace window reallyRealized.
self assert: browser window notNil.
self assert: browser window reallyRealized.
] onRestartDo:[
Delay waitForSeconds: 1. "Give windows a chance to come up"
self assert: workspace window notNil.
self assert: workspace window reallyRealized.
self assert: browser window notNil.
self assert: browser window reallyRealized.
].
"Created: / 06-01-2017 / 23:44:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stc
"Test restart with bytecode-compiled package"
| result |
self do:[
Display isNil ifTrue:[Smalltalk openDisplay].
self skipIf:(OperatingSystem isMSWINDOWSlike and:[Display isNil]) description: 'No display available'.
self make.
result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.
self assert: result errorCount == 0.
self assert: result failureCount == 0.
] onRestartDo:[
result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.
self assert: result errorCount == 0.
self assert: result failureCount == 0.
].
"Created: / 14-08-2013 / 20:26:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-03-2017 / 12:25:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'running'!
setUp
(Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') isNil ifTrue:[
Smalltalk loadPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'.
].
"Created: / 14-08-2013 / 19:47:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'tests'!
test_01
"/ Use Smalltalk at: to workaround compiler bug...
self assert: (Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') notNil.
self assert: ((Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') new addSimple: 12 to: 12) == 24
"Created: / 14-08-2013 / 19:46:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-08-2013 / 08:20:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_02
"/ Use Smalltalk at: to workaround compiler bug...
self assert: (Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') notNil.
self assert: ((Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') new addUsingBlock: 10 to: 10) == 20
"Created: / 14-08-2013 / 19:46:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-08-2013 / 08:20:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'tests - disabled'!
disabled_test_03
"/ Not yet supported, but JV has an idea how to fix it :-)
self assert: (Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') notNil.
self assert: ((Smalltalk at: #'RegressionTests::SnapshotRestartTestsObject') new addThirteenUsingRememberedBlockTo: 2) == 15
"Created: / 14-08-2013 / 19:53:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-08-2013 / 08:20:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
!
version_HG
^ '$Changeset: <not expanded> $'
!
version_SVN
^ '$Id$'
! !