"{ 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'!
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 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.
executable := (Smalltalk getPackageDirectoryForPackage: package) / (OperatingSystem isMSWINDOWSlike ifTrue:[packageDef applicationNameConsole] ifFalse:[ packageDef applicationName ]).
self assert: executable exists.
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> $'
! !