"{ 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 |
    pkgdir := Smalltalk getPackageDirectoryForPackage: #'stx:goodies/regression/testData/packages/snapshot_restart'.
    self assert: pkgdir notNil.
    self assert: pkgdir isDirectory.     

    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: / 06-01-2017 / 23:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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
    | tempDir imageFile |

    [
        tempDir := Filename newTemporary.
        tempDir makeDirectory.
        self spawnSelector:#performTestInternal inDirectory:tempDir.

        imageFile := tempDir / (testSelector , '.img').
        self assert: imageFile exists description: 'Image file does not exist - did test save it?'.
        self spawnSmalltalk: { '--image' . imageFile pathName } inDirectory: tempDir
    ] ensure:[
        (tempDir notNil and:[ tempDir exists ]) ifTrue:[
            [
                tempDir recursiveRemove.
            ] on:Error
                    do:[:ex | 
                OperatingSystem isMSWINDOWSlike ifFalse:[
                    ex reject.
                ].
            ]
        ].
    ].       

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

performTestInternal
    super performTest.

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

!SnapshotRestartTests methodsFor:'running'!

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

tearDown
    tmpdir recursiveRemove.

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

!SnapshotRestartTests methodsFor:'tests'!

test_bc
    "Test restart with bytecode-compiled package"

    | result |

    self do:[
        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: / 06-01-2017 / 23:37:48 / 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:[
        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: / 06-01-2017 / 23:31:50 / 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$'
! !