RegressionTests__SnapshotRestartTests.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 01 Jun 2016 23:32:01 +0200
branchjv
changeset 1495 1430b808086b
parent 1491 a86224e74f3a
child 1499 26a16a04219b
permissions -rw-r--r--
Fix in SnapshotRestartTest: log at most 16K of VM log

"{ 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: logfile
    | innerSuite expected logfileContents |

    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
    "
    logfile readingFileDo: [ :f |
        "Read at most 5MB of the log to avoid reading gigabytes 
         of output produced by a 'thundestorm'."
        logfileContents := f next: (logfile fileSize min: (16 * 1024"16Kb")).
	"/ logfileContents := 'Disabled'.
    ].
    self assert: false description: ('Not all inner tests passed: ' , logfileContents).

    "Created: / 14-08-2013 / 20:06:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 31-05-2016 / 17:00:27 / 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 |

    OperatingSystem isMSWINDOWSlike ifTrue:[ 
        OperatingSystem getCCDefine = '__BORLANDC__' ifTrue:[ 
            cmd := 'bmake.bat ' , target.
        ].
        OperatingSystem getCCDefine = '__MINGW32__' ifTrue:[ 
            (OperatingSystem getEnvironment: 'MINGW_DIR') isNil ifTrue:[ 
                self assert: 'C:\MINGW' asFilename exists description: 'MINGW_DIR environment variable not set and C:\MINGW does not exist'.
                OperatingSystem setEnvironment: 'MINGW_DIR'     to: 'C:\MINGW'.
            ].
            OperatingSystem setEnvironment: 'MINGW'         to: '__MINGW32__'.
            OperatingSystem setEnvironment: 'USEMINGW_ARG'  to: '-DUSEMINGW32'.
            OperatingSystem setEnvironment: 'PATH'          to: (OperatingSystem getEnvironment: 'PATH') , ';C:\MINGW\bin'.
            cmd := 'mingwmake.bat ' , target.
        ].
        OperatingSystem getCCDefine = '__MINGW64__' ifTrue:[ 
            (OperatingSystem getEnvironment: 'MINGW_DIR') isNil ifTrue:[ 
                self assert: 'C:\MINGW64' asFilename exists description: 'MINGW_DIR environment variable not set and C:\MINGW does not exist'.
                OperatingSystem setEnvironment: 'MINGW_DIR'     to: 'C:\MINGW64'.
            ].
            OperatingSystem setEnvironment: 'MINGW'         to: '__MINGW64__'.
            OperatingSystem setEnvironment: 'USEMINGW_ARG'  to: '-DUSEMINGW64'.
            OperatingSystem setEnvironment: 'PATH'          to: (OperatingSystem getEnvironment: 'PATH') , ';C:\MINGW64\bin'.
            cmd := 'mingwmake.bat ' , target.
        ].
    ] ifFalse:[
        cmd := '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>"
    "Modified: / 27-04-2016 / 09:32:26 / jv"
! !

!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: #'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_HG

    ^ '$Changeset: <not expanded> $'
!

version_SVN
    ^ '$Id$'
! !