"

 COPYRIGHT (c) Claus Gittinger / eXept Software AG

 COPYRIGHT (c) 2016-2017 Jan Vrany

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

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

"{ NameSpace: RegressionTests }"

VMSpawningTestCase subclass:#SnapshotRestartTests

	instanceVariableNames:'packageDir exe tmpdir make'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression'

!

TestCase subclass:#ToRunOnFreshAndRestartedSnapshotTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	privateIn:SnapshotRestartTests

!

!SnapshotRestartTests class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) Claus Gittinger / eXept Software AG

 COPYRIGHT (c) 2016-2017 Jan Vrany

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

! !

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

    cmd := make , ' ' , target.

    output := String streamContents:[ :s|

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

    ].

    "/ 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: / 10-11-2016 / 00:22:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-11-2017 / 23:16:28 / 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'.

    self setUp.

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

    "Modified: / 24-11-2017 / 00:10:11 / jv"

!

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.

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

    self assert: packageDir notNil.

    self assert: packageDir isDirectory.         

    OperatingSystem isMSWINDOWSlike ifTrue:[

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

        "/ However, package build on Windows 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.

        | path separator binDir mingwBinDir |

        separator := OperatingSystem isMSWINDOWSlike ifTrue:[$;] ifFalse:[$:].

        path := ((OperatingSystem getEnvironment: 'PATH') ? '') tokensBasedOn: separator. 

        binDir := (OperatingSystem pathOfSTXExecutable asFilename directory / '..' / '..' / '..' / '..' / 'bin') pathName.

        STCCompilerInterface getCCDefine = '__BORLANDC__' ifTrue:[ 

            make := 'bmake.bat'

        ].

        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'.

            make := 'mingwmake.bat'.

        ].

        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'.

            make := 'mingwmake.bat'.

        ].

        mingwBinDir := (OperatingSystem getEnvironment: 'MINGW_DIR') , '\bin'.

        (path includes: mingwBinDir) ifFalse:[path addLast: mingwBinDir].

        (path includes: binDir) ifFalse:[path addFirst: binDir].

        OperatingSystem setEnvironment: 'PATH' to: (path asStringWith:$;)

    ] ifFalse:[

        make := 'make -f Makefile.init'

    ].

    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: / 23-11-2017 / 23:16:35 / 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>"

    "Modified: / 24-11-2017 / 00:10:40 / jv"

! !

!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$'

! !