"{ 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 := OperatingSystem isMSWINDOWSlike

	    ifTrue:['bmake.bat ', target]

	    ifFalse:['make -f Makefile.init ', 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>"

! !

!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>"

!

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:'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:'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_SVN

    ^ '$Id$'

! !