initial checkin
authorJan Vrany <jan.vrany@fit.cvut.cz>
Tue, 19 Nov 2013 20:10:53 +0100
changeset 1008 37bb72c774c2
parent 1007 ad329f1d5fcf
child 1009 01c50a83793a
initial checkin
RegressionTests__MakefileTests.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/RegressionTests__MakefileTests.st	Tue Nov 19 20:10:53 2013 +0100
@@ -0,0 +1,195 @@
+"{ 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
+    package := 'tmp/makefiletests'.
+    packageDir := (Smalltalk getPackageDirectoryForPackage: Object package) directory directory / 'tmp' / 'makefiletests'.
+    packageDir exists ifTrue:[
+        packageDir recursiveRemove.
+    ].
+    packageDir recursiveMakeDirectory
+
+    "Created: / 19-11-2013 / 12:57:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-11-2013 / 18:38:41 / 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>"
+! !
+
+!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: / 19-11-2013 / 18:49:53 / 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$'
+! !
+