RegressionTests__SnapshotRestartTests.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Thu, 15 Aug 2013 09:31:02 +0200
changeset 980 baea090b0fc1
child 990 4ee55eedd9aa
permissions -rw-r--r--
initial checkin

"{ Package: 'exept: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: string
    | innerSuite expected |

    innerSuite := ToRunOnFreshAndRestartedSnapshotTests buildSuite.
    expected := '%1 run, %1 passed, 0 skipped, 0 failed, 0 errors ### HERE ### ' bindWith: innerSuite tests size.
    string asStringCollection do:[:line|
        line = expected ifTrue:[ ^ self ].
    ].
    self assert: false description: 'Not all inner tests passed'.

    "Created: / 14-08-2013 / 20:06:30 / 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 ', 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 output |

    script := pkgdir / 'run-ToRunOnFreshAndRestartedSnapshotTests-tests.st'.
    self assert: script exists.
    output := String streamContents: [:s |
        OperatingSystem executeCommand: ('%1 --execute %2' bindWith: exe with: script asAbsoluteFilename pathName) outputTo: s errorTo: s inDirectory: tmpdir pathName
    ].
    self assertAllTestsPassed: output.

    "Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-08-2013 / 08:26:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

runTestsOnRestartedImage
    | output |

    output := String streamContents: [:s |
        OperatingSystem executeCommand: ('%1 -i %2' bindWith: exe with: (tmpdir / 'restart.img') pathName ) outputTo: s errorTo: s inDirectory: tmpdir pathName
    ].
    self assertAllTestsPassed: output.

    "Created: / 14-08-2013 / 20:10:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 15-08-2013 / 08:26:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setUp
    tmpdir := Filename newTemporaryDirectory.
    pkgdir := Smalltalk getPackageDirectoryForPackage: #'exept: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: #'exept: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$'
! !