"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

	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:[ 

        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

    ].

    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: / 05-11-2016 / 22:48:25 / jv"

    "Modified: / 10-11-2016 / 00:23:35 / 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_HG

    ^ '$Changeset: <not expanded> $'

!

version_SVN

    ^ '$Id$'

! !