"
 COPYRIGHT (c) Claus Gittinger / eXept Software AG
 COPYRIGHT (c) 2015-2018 Jan Vrany
 COPYRIGHT (c) 2021 LabWare
              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 }"

TestCase subclass:#MakefileTests
	instanceVariableNames:'package packageDir make'
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression'
!

StandaloneStartup subclass:#TestApplication01StartUp
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:MakefileTests
!

StandaloneStartup subclass:#TestIssue214StartUp
	instanceVariableNames:''
	classVariableNames:''
	poolDictionaries:''
	privateIn:MakefileTests
!

!MakefileTests class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) Claus Gittinger / eXept Software AG
 COPYRIGHT (c) 2015-2018 Jan Vrany
 COPYRIGHT (c) 2021 LabWare
              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.
"
!

documentation
"
    This testcase tests St/X makefiles used to build
    standalone applications.

    [author:]
	Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!MakefileTests 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 / 20:35:31 / jv"
! !

!MakefileTests methodsFor:'running'!

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



    self setUpForPackage:('tmp:', testSelector) asSymbol.

    "Created: / 19-11-2013 / 12:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 23-11-2017 / 20:34:37 / jv"
    "Modified: / 30-05-2018 / 14:25:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setUpForPackage: pkg
    | components |
    package := pkg.
    packageDir := (Smalltalk getPackageDirectoryForPackage: Object package) directory directory.
    components := (package copyReplaceAll: $: with:$/) tokensBasedOn: $/.
    components do:[:each |
	packageDir := packageDir / each.
    ].
    packageDir exists ifTrue:[
	packageDir recursiveRemove.
    ].
    packageDir recursiveMakeDirectory

    "Created: / 24-11-2013 / 22:23:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests methodsFor:'tests'!

test_application_01a
    <timeout: 600> "600sec = 10min"

    self compile:(Array with:TestApplication01StartUp) type:ProjectDefinition nonGuiApplicationType.

    "Created: / 30-05-2018 / 14:22:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 31-05-2018 / 21:39:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_application_01b
    <timeout: 600> "600sec = 10min"

    self setUpForPackage:('tmp:' , testSelector , '/' , testSelector) asSymbol.
    self compile:(Array with:TestApplication01StartUp) type:ProjectDefinition nonGuiApplicationType.

    "Created: / 30-05-2018 / 14:23:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (format): / 31-05-2018 / 21:39:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests methodsFor:'tests -  regression'!

test_issue_214a
    "
    https://swing.fit.cvut.cz/projects/stx-jv/ticket/214
    "
    <timeout: 600> "600sec = 10min"

    | exe |

    Screen current isNil ifTrue:[
        Smalltalk openDisplay.
    ].
    self skipIf:Screen current isNil description:'No display connection'.

    exe := self compile:(Array with:TestIssue214StartUp) type:ProjectDefinition guiApplicationType.
    self assert: (OperatingSystem executeCommand: exe)

    "Created: / 30-05-2018 / 14:52:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 31-05-2018 / 21:39:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests methodsFor:'tests-helpers'!

compile: classes type:packageType
    "
    Create a new application package with copy of given classes
    and compile it. Return the path to compiled executable.
    "
    | packageDef  startup executable1 executable2 executable |

    "/ Compile all classes...
    Class packageQuerySignal answer:package do:[
        classes do:[:cls |
                | copy |

                copy := cls superclass
                        subclass: cls nameWithoutPrefix
                        instanceVariableNames:(cls instVarNames asStringWith:' ')
                        classVariableNames:(cls classVarNames asStringWith:' ')
                        poolDictionaries:cls poolDictionaries
                        category:'** tmp **'.
                cls methodDictionary do:[:each |
                    copy compile:each source classified:each category.
                ].
                cls class methodDictionary do:[:each |
                    copy class compile:each source classified:each category.
                ].
                (copy inheritsFrom:StandaloneStartup) ifTrue:[
                    startup := copy.
                ].
            ].
        ].

    "/ Create project definition class.
    Class packageQuerySignal answer:package do:[
        packageDef := ProjectDefinition
                definitionClassForPackage:package
                projectType:packageType
                createIfAbsent:true.

        packageDef class compile:'applicationIconFileName ^ nil'.
        packageDef theNonMetaclass
            forEachContentsMethodsCodeToCompileDo:[:code :category | packageDef theMetaclass compile:code classified:category ]
            "/ignoreOldEntries: false
            ignoreOldDefinition: false.
        packageDef isApplicationDefinition ifTrue:[
            packageDef class compile:'startupClassName ^ ' , startup fullName storeString.
        ].
    ].
    "/ Fileout to package directory...

    packageDef classes do:[:class |
        | container |

        container := (class fullName copyReplaceAll:$: with:$_) , '.st'.
        (packageDir / container)
            writingFileDo:[:f |
                AbstractSourceCodeManager
                    fileOutSourceCodeOf:class
                    on:f
                    withTimeStamp:false
                    withInitialize:true
                    withDefinition:true
                    methodFilter:[:mth | mth package = package ]
            ]
    ].

    "/ Generate build support files...

    packageDef fileNamesToGenerate keys do:[:filename |
        | contents file |

        contents := packageDef generateFile:filename.
        contents notNil ifTrue:[ 
            file := (packageDir / filename).
            file directory recursiveMakeDirectory.
            file writingFileDo:[:f | f nextPutAll: contents].
        ]
    ].

    self make.
    "/ To make it work with both in-tree and out-of-tree builds,
    "/ construct the executable name in both modes and asserts
    "/ that either one exists.
    executable1 := (Smalltalk getPackageDirectoryForPackage: package) / (OperatingSystem isMSWINDOWSlike ifTrue:[packageDef applicationNameConsole] ifFalse:[ packageDef applicationName ]).
    executable2 := (Smalltalk getPackageDirectoryForPackage: package) / 'build' / Smalltalk configuration / (OperatingSystem isMSWINDOWSlike ifTrue:[packageDef applicationNameConsole] ifFalse:[ packageDef applicationName ]).

    executable1 exists ifTrue:[
        executable := executable1.
    ] ifFalse: [ 
        executable2 exists ifTrue: [ 
            executable := executable2.            
        ]ifFalse: [ 
            self assert: false message: 'No executable build!!'
        ] 
    ].
    self assert:(OperatingSystem canExecuteCommand: executable pathName).
    ^ executable pathName

    "Created: / 30-05-2018 / 14:22:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests::TestApplication01StartUp class methodsFor:'startup-to be redefined'!

main:args
    args isEmpty ifTrue:[
	Smalltalk exit: 0.
    ].
    args size ~~ 1 ifTrue:[
	Smalltalk exit: 127.
    ].

    [
	Smalltalk exit: args first asInteger.
    ] on: Error do:[:ex|
	Smalltalk exit: 126.
    ].

    "Created: / 19-11-2013 / 13:12:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests::TestIssue214StartUp class methodsFor:'startup-to be redefined'!

main:args
    [  
        Smalltalk ignoreAssertions: false.
        Display isNil ifTrue:[ Smalltalk openDisplay ].
        SimpleView setDefaultStyle.

        Stdout nextPutAll: 'Smalltalk packagePath   "/ -> '; nextPutLine: Smalltalk packagePath storeString.
        Stdout nextPutAll: 'Smalltalk realSystemPath"/ -> '; nextPutLine: Smalltalk realSystemPath storeString.
        Stdout nextPutAll: 'SimpleView defaultStyle "/ -> '; nextPutLine: SimpleView defaultStyle storeString.
        Stdout nextPutAll: 'SimpleView styleSheet name"/ -> '; nextPutLine: SimpleView styleSheet name storeString.

        self assert: SimpleView defaultStyle notNil description: 'SimpleView defaultStyle == nil'.
        self assert: (SimpleView styleSheet fileReadFailed not) description: 'SimpleView styleSheet fileReadFailed not'.
    ] on: Error do:[:ex | 
        Stderr nextPutAll: 'ERROR '; nextPutLine: ex description.
        ex suspendedContext fullPrintAllOn: Stderr.  
        Smalltalk exitIfStandalone: 1.
    ].
    Smalltalk exitIfStandalone
    "
    TestIssue214StartUp main: #()
    "

    "Created: / 30-05-2018 / 14:50:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 04-06-2018 / 09:39:11 / jv"
! !

!MakefileTests class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_HG

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