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

"{ NameSpace: RegressionTests }"

VMSpawningTestCase subclass:#SnapshotRestartTests

	instanceVariableNames:'pkgdir exe tmpdir'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression'

!

TestCase subclass:#ToRunOnFreshAndRestartedSnapshotTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:SnapshotRestartTests

!

!SnapshotRestartTests methodsFor:'compilation'!

make

    ^ self make:''.

    "Created: / 14-08-2013 / 18:27:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

make: target

    | cmd output success |

    pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'.

    self assert: pkgdir notNil.

    self assert: pkgdir isDirectory.     

    OperatingSystem isMSWINDOWSlike ifTrue:[

        "/ Hack: generally we don't require Borland tools to be installed anymore.

        "/ However, package build is driwen by Borland make so we distribute

        "/ it with rakefiles. It's likely not in the PATH, so add it.

        "/ This code assumes the test is run from build environment.

        OperatingSystem setEnvironment: 'PATH' to: 

            (OperatingSystem pathOfSTXExecutable asFilename directory / '..' / '..' / '..' / '..' / 'bin') pathName , ';',

            (OperatingSystem getEnvironment: 'PATH').

        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

    ].

    output := String streamContents:[ :s|

        success := OperatingSystem executeCommand: cmd outputTo: s inDirectory: pkgdir

    ].

    "/ Following is just to ease debugging on Jenkins since stdout

    "/ is shown in the report.

    success ifFalse:[ 

        Stdout nextPutLine: 'Failed to make target ''', target, ''' in test package'.

        Stdout nextPutLine: output.

    ].

    self

        assert: success

        description: 'Failed to make target ''', target, ''' in test package'.

    "Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-01-2017 / 23:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 10-06-2017 / 21:47:51 / jv"

! !

!SnapshotRestartTests methodsFor:'private'!

do: setupBlock onRestartDo: restartBlock

    self assert: setupBlock byteCode notNil   description: 'setupBlock must have bytecode - stc-compiled blocks not supported'.

    self assert: restartBlock byteCode notNil description: 'restartBlock must have bytecode - stc-compiled blocks not supported'.

    setupBlock value.

    Smalltalk addImageStartBlock:[

        [ 

            Stdout nextPutLine:'===> Restarted from snapshot'.

            restartBlock value.

            Smalltalk exit: EXIT_CODE_SUCCESS.

        ] fork

    ].

    Stdout nextPutLine:'===> Saving snapshot to ', testSelector , '.img'.

    ObjectMemory snapShotOn: testSelector , '.img'.

    Smalltalk exit: EXIT_CODE_SUCCESS.

    "Created: / 06-01-2017 / 22:14:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-01-2017 / 23:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

performTest

    | imageFile |

    imageFile := tmpdir / (testSelector , '.img').

    self spawnSelector:#performTestInternal inDirectory:tmpdir.

    self assert: imageFile exists description: 'Image file does not exist - did test save it?'.

    "/ For debugging purposes, save output.txt

    ( tmpdir / 'output.txt' ) exists ifTrue:[ 

        (tmpdir / 'output.txt') moveTo: (tmpdir / 'output0.txt')

    ].

    self spawnSmalltalk: { '--image' . imageFile pathName } inDirectory: tmpdir.

    "/ If control reaches this point, the test was successful. In that case.

    "/ remove the temp directory.

    [ 

        tmpdir recursiveRemove

    ] on: Error do:[:ex | 

        OperatingSystem isMSWINDOWSlike ifTrue:[ 

            "/ Argh, Windows and its file locking...

            Delay waitForSeconds: 1.

            Error ignoreIn: [ tmpdir recursiveRemove ] .

        ] ifFalse:[ 

            ex reject.

        ].

    ].

    "Created: / 06-01-2017 / 22:05:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 27-02-2017 / 09:35:37 / jv"

!

performTestInternal

    super performTest.

    "Created: / 06-01-2017 / 22:04:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!SnapshotRestartTests methodsFor:'running'!

setUp

    super setUp.

    tmpdir := Filename newTemporaryDirectory.

    exe := OperatingSystem pathOfSTXExecutable.

    self make:'clobber'.

    "Created: / 14-08-2013 / 18:21:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 06-01-2017 / 23:21:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 27-02-2017 / 09:32:41 / jv"

!

tearDown

    super tearDown.

    "/ No, don't remove the temp directory here. This is done in

    "/ #performTest and only if test is successful. If not, leave

    "/ it behind for debugging purposes.

    "/ tmpdir recursiveRemove.

    "Created: / 14-08-2013 / 20:17:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (comment): / 27-02-2017 / 09:32:38 / jv"

! !

!SnapshotRestartTests methodsFor:'tests'!

test_bc

    "Test restart with bytecode-compiled package"

    | result |

    self do:[

        Display isNil ifTrue:[Smalltalk openDisplay].

        self skipIf: (OperatingSystem isMSWINDOWSlike and:[Display isNil]) description: 'No display available'.     

        result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.

        self assert: result errorCount == 0.

        self assert: result failureCount == 0.

    ] onRestartDo:[ 

        result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.

        self assert: result errorCount == 0.

        self assert: result failureCount == 0.

    ].

    "Created: / 14-08-2013 / 19:58:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 04-03-2017 / 12:25:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_gui_reopening

    "

    Test that GUI reopens just fine.

    "

    | workspace browser |

    self do:[

    	Display isNil ifTrue:[Smalltalk openDisplay].

    	self skipIf: Display isNil description: 'No display available'.

        workspace := WorkspaceApplication new.

        workspace open.

        workspace window waitUntilVisible.

        browser := Tools::NewSystemBrowser new.

        browser open.

        browser window waitUntilVisible.

        self assert: workspace window notNil.

        self assert: workspace window reallyRealized.

        self assert: browser window notNil.

        self assert: browser window reallyRealized.       

    ] onRestartDo:[ 

    	Delay waitForSeconds: 1. "Give windows a chance to come up"

        self assert: workspace window notNil.

        self assert: workspace window reallyRealized.

        self assert: browser window notNil.

        self assert: browser window reallyRealized.       

    ].

    "Created: / 06-01-2017 / 23:44:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_stc

    "Test restart with bytecode-compiled package"

    | result |

    self do:[

        Display isNil ifTrue:[Smalltalk openDisplay].

        self skipIf:(OperatingSystem isMSWINDOWSlike and:[Display isNil]) description: 'No display available'.     

        self make.

        result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.

        self assert: result errorCount == 0.

        self assert: result failureCount == 0.

    ] onRestartDo:[ 

        result := ToRunOnFreshAndRestartedSnapshotTests buildSuite run.

        self assert: result errorCount == 0.

        self assert: result failureCount == 0.

    ].

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

    "Modified: / 04-03-2017 / 12:25:05 / 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$'

! !