RegressionTests__MakefileTests.st
author Claus Gittinger <cg@exept.de>
Thu, 09 Jun 2016 12:32:55 +0200
changeset 1436 6d0ae1c7a22b
parent 1148 341a95374920
child 1447 2351db93aa5b
child 1474 54b7f76f0e68
permissions -rw-r--r--
initial checkin

"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

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

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

!MakefileTests class methodsFor:'documentation'!

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 |

    cmd := OperatingSystem isMSWINDOWSlike 
            ifTrue:['bmake.bat ', target]
            ifFalse:['make -f Makefile.init ', target].
    self 
        assert: (OperatingSystem executeCommand: cmd inDirectory: packageDir)
        description: 'Failed to make target ''', target, ''' in test package'.

    "Created: / 14-08-2013 / 18:26:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 19-11-2013 / 18:49:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests methodsFor:'running'!

setUp
    self setUpForPackage:'tmp:makefiletests'.

    "Created: / 19-11-2013 / 12:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-11-2013 / 22:23:33 / 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_01

    self run:#'test_application_01' type:ProjectDefinition nonGuiApplicationType toolchain:nil

    "Created: / 19-11-2013 / 14:05:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_application_02

    self setUpForPackage: 'tmp:makefiletests2/test_application_02'.
    self run:#'test_application_01' type:ProjectDefinition nonGuiApplicationType toolchain:nil

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

!MakefileTests methodsFor:'tests-helpers'!

run:packageIdent type:packageType toolchain:toolchain 
    | packageDef  startup |

    "/ Compile all classes...
    Class packageQuerySignal answer:package do:[
        (self class privateClasses select:[:cls | cls packageIdent = packageIdent ]) 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 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 | 
        | file |

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

    self make.

    "Created: / 19-11-2013 / 14:07:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-06-2014 / 17:47:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!MakefileTests::TestApplication01 class methodsFor:'accessing'!

packageIdent
    ^ #test_application_01

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

!MakefileTests::TestApplication01 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 class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !