"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#SnapshotRestartTests
instanceVariableNames:'pkgdir exe tmpdir'
classVariableNames:''
poolDictionaries:''
category:'tests-Regression'
!
TestCase subclass:#ToRunOnFreshAndRestartedSnapshotTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
privateIn:SnapshotRestartTests
!
!SnapshotRestartTests methodsFor:'asserting'!
assertAllTestsPassed: logfile
| innerSuite expected |
innerSuite := ToRunOnFreshAndRestartedSnapshotTests buildSuite.
expected := '%1 run, %1 passed, 0 skipped, 0 failed, 0 errors ### HERE ### ' bindWith: innerSuite tests size.
logfile readingFileDo:[:s |
[ s atEnd ] whileFalse:[
| line |
line := s nextLine.
"/ Uss starts with because on Windows you get 0xD chars at the end, sigh
(line startsWith: expected) ifTrue:[ ^ self ].
]
].
"
logfile contents asString
"
self assert: false description: ('Not all inner tests passed. Check log in ' , logfile asAbsoluteFilename pathName).
"Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-09-2013 / 12:06:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 08-09-2014 / 15:21:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests methodsFor:'compilation'!
make
^ self make:''.
"Created: / 14-08-2013 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
make: target
| cmd |
cmd := ParserFlags makeCommand.
OperatingSystem isUNIXlike ifTrue:[
cmd := cmd, ' -f Makefile.init ', target.
] ifFalse:[
cmd := cmd, ' ', target.
].
self
assert: (OperatingSystem executeCommand: cmd inDirectory: pkgdir)
description: 'Failed to make target ''', target, ''' in test package'.
"Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 30-07-2018 / 09:31:34 / Stefan Vogel"
! !
!SnapshotRestartTests methodsFor:'initialize / release'!
setUp
tmpdir := Filename newTemporaryDirectory.
pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'.
self assert: pkgdir notNil.
self assert: pkgdir isDirectory.
exe := OperatingSystem pathOfSTXExecutable.
self make:'clobber'.
"Created: / 14-08-2013 / 18:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 14-08-2013 / 20:17:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
tearDown
tmpdir recursiveRemove.
"Created: / 14-08-2013 / 20:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests methodsFor:'running'!
runTestsOnFreshImage
| script log logfile |
script := pkgdir / 'run-ToRunOnFreshAndRestartedSnapshotTests-tests.st'.
self assert: script exists.
log := FileStream newTemporaryIn: Filename currentDirectory nameTemplate: ('RegressionTests__SnapshotRestartTests-' , testSelector , '%1-%2.log').
logfile := log fileName.
[
OperatingSystem executeCommand: ('%1 --execute %2' bindWith: exe with: script asAbsoluteFilename pathName) outputTo: log errorTo: log inDirectory: tmpdir pathName.
] ensure:[
log close.
].
self assertAllTestsPassed: logfile.
"Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-09-2013 / 12:54:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runTestsOnRestartedImage
| log logfile |
log := FileStream newTemporaryIn: Filename currentDirectory nameTemplate: ('RegressionTests__SnapshotRestartTests-' , testSelector , '%1-%2.log').
logfile := log fileName.
[
OperatingSystem executeCommand: ('%1 -i %2' bindWith: exe with: (tmpdir / 'restart.img') pathName ) outputTo: log errorTo: log inDirectory: tmpdir pathName
] ensure:[
log close.
].
self assertAllTestsPassed: logfile.
"Created: / 14-08-2013 / 20:10:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 13-09-2013 / 12:54:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests methodsFor:'tests'!
test_bc
"Test restsrt with bytecode-compiled package"
self runTestsOnFreshImage.
self runTestsOnRestartedImage.
"Created: / 14-08-2013 / 19:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_stc
"Test restsrt with bytecode-compiled package"
self make.
self runTestsOnFreshImage.
self runTestsOnRestartedImage.
"Created: / 14-08-2013 / 20:26:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!SnapshotRestartTests::ToRunOnFreshAndRestartedSnapshotTests methodsFor:'initialize / release'!
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_SVN
^ '$Id$'
! !