Package renamed from exept:regression to stx:goodies/regression. Hooray!
"{ Package: 'stx:goodies/regression' }"
"{ NameSpace: RegressionTests }"
TestCase subclass:#STCCompilerTests
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'tests-Regression-Compilers'
!
!STCCompilerTests class methodsFor:'documentation'!
documentation
"
documentation to be added.
[author:]
cg
[instance variables:]
[class variables:]
[see also:]
"
! !
!STCCompilerTests methodsFor:'code templates'!
inlinedBlockVariables1
"stc generates wrong code for inlined variables"
| b |
b := [:arg1 |
|local1|
local1 := #local1.
1 to:3 do:[:argb_1 |
|localb_1 localb_2|
localb_1 := #localb_1.
localb_2 := #localb_2.
1 to:5 do:[:argbb_1 |
|localbb_1 localbb_2|
localbb_1 := #localbb_1.
localbb_2 := #localbb_2.
argbb_1 == 3 ifTrue:[
^ [:argbbb_1 |
|localbbb_1 localbbb_2|
localbbb_1 := #localbbb_1.
localbbb_2 := #localbbb_2.
localb_1 "/ here, in old stc versions, localb_2 is returned
].
].
]
]
].
^ b value:#arg1
!
inlinedBlockVariables2
"stc generates wrong code for inlined variables"
| b |
b := [:arg1 |
|local1|
local1 := #local1.
1 to:3 do:[:argb_1 |
|localb_1 localb_2|
localb_1 := #localb_1.
localb_2 := #localb_2.
1 to:5 do:[:argbb_1 |
|localbb_1 localbb_2|
localbb_1 := #localbb_1.
localbb_2 := #localbb_2.
argbb_1 == 3 ifTrue:[
^ [:argbbb_1 |
|localbbb_1 localbbb_2|
localbbb_1 := #localbbb_1.
localbbb_2 := #localbbb_2.
argbb_1
].
].
]
]
].
^ b value:#arg1
!
nextLittleEndianNumber: n from:bytes
"stc generates wrong code for the following s := assignment"
| s |
s := 0.
n to: 1 by: -1 do: [:i | s := (s bitShift: 8) bitOr: (bytes at: i)].
^ s
"Created: / 17-09-2011 / 10:32:29 / cg"
! !
!STCCompilerTests methodsFor:'tests'!
test01_compilation
"checks for an stc compiler bug (detected Sep 2011).
stc generates bad code for the bitOr expression in nextLittleEndianNumber"
Class withoutUpdatingChangesDo:[
(STCCompilerInterface new)
compileToMachineCode:'hello
%{
console_printf("hello world\n");
%}
'
forClass:self class
selector:#'hello'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
self hello.
self class removeSelector:#hello.
].
"
self run:#test01_compilation
self new test01_compilation
"
"Created: / 17-09-2011 / 10:32:18 / cg"
!
test02_compilation
"checks for an stc compiler bug (detected Sep 2011).
stc generates bad code for the bitOr expression in nextLittleEndianNumber"
|val|
Class withoutUpdatingChangesDo:[
(STCCompilerInterface new)
compileToMachineCode:'x123
%{
RETURN(__MKSMALLINT(123));
%}
'
forClass:self class
selector:#'x123'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
val := self x123.
self assert:(val == 123).
self class removeSelector:#x123.
].
"
self run:#test02_compilation
self new test02_compilation
"
"Created: / 17-09-2011 / 10:32:18 / cg"
!
test03_compilation
"As of 2013-09-04, instance variables of Class are not visible
in class methods of ordinary classes.
For bytecode-compiled method they are.
This tests checks for this bug.
"
|val|
[
Class withoutUpdatingChangesDo:[
"/ Check bytecode version first...
self class class compile:'returnMyName
^ name
'.
val := self class returnMyName.
self assert:(val == self class name).
self class class removeSelector:#returnMyName.
"/ Now, compile the same source using stc and check...
(STCCompilerInterface new)
compileToMachineCode:'returnMyName
^ name
'
forClass:self class class
selector:#'returnMyName'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
val := self class returnMyName.
self assert:(val == self class name).
self class class removeSelector:#returnMyName.
].
] ensure:[
self class class removeSelector:#returnMyName.
]
"
self run:#test02_compilation
self new test02_compilation
"
"Created: / 04-09-2013 / 09:35:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test04_doubleArraySize_bug
"As of 2014-03-11, __doubleArraySize() seem to return off-by-one size
on Windows. Under Linux it seem to work just fine.
This tests checks for this bug.
"
| sizes |
[
Class withoutUpdatingChangesDo:[
(STCCompilerInterface new)
compileToMachineCode:'doubleArraySize
| arr size1 size2 |
arr := DoubleArray new: 8.
size1 := arr size.
%{
size2 = __MKINT(__doubleArraySize(arr));
%}.
^ Array with: size1 with: size2.
'
forClass:self class class
selector:#'doubleArraySize'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
sizes := self class perform: #doubleArraySize.
self assert:(sizes first == 8).
self assert:(sizes second == 8).
self class class removeSelector:#doubleArraySize.
].
] ensure:[
self class class removeSelector:#doubleArraySize.
]
"
self run:#test02_compilation
self new test02_compilation
"
"Created: / 11-02-2014 / 23:50:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 04-03-2014 / 10:13:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test10_bitor_bug
"checks for an stc compiler bug (detected Sep 2011).
stc generates bad code for the bitOr expression in nextLittleEndianNumber"
|val mthd|
Class withoutUpdatingChangesDo:[
self class recompile:#'nextLittleEndianNumber:from:'.
val := self nextLittleEndianNumber:4 from:#[1 2 3 4].
self assert:(val = 16r04030201).
val := self nextLittleEndianNumber:8 from:#[1 2 3 4 5 6 7 8].
self assert:(val = 16r0807060504030201).
mthd := self class compiledMethodAt:#'nextLittleEndianNumber:from:'.
(STCCompilerInterface new)
compileToMachineCode:mthd source
forClass:self class
selector:#'nextLittleEndianNumber:from:'
inCategory:mthd category
notifying:nil
install:true
skipIfSame:false
silent:true.
self
assert:mthd ~= (self class compiledMethodAt:#'nextLittleEndianNumber:from:')
description:'Could not compile with STC'.
val := self nextLittleEndianNumber:4 from:#[1 2 3 4].
self assert:(val = 16r04030201).
val := self nextLittleEndianNumber:8 from:#[1 2 3 4 5 6 7 8].
self assert:(val = 16r0807060504030201).
].
"
self run:#test10_bitor_bug
self new test10_bitor_bug
"
"Created: / 17-09-2011 / 10:32:18 / cg"
!
test20_localsOfInlinedBlock_bug
"checks for an stc compiler bug (detected Sep 2011).
stc generates bad code for the bitOr expression in nextLittleEndianNumber"
|blk mthd|
Class withoutUpdatingChangesDo:[
self class recompile:#'inlinedBlockVariables1'.
blk := self inlinedBlockVariables1.
self assert:((blk value:#argbbb_1) == #localb_1).
mthd := self class compiledMethodAt:#'inlinedBlockVariables1'.
(STCCompilerInterface new)
compileToMachineCode:mthd source
forClass:self class
selector:#'inlinedBlockVariables1'
inCategory:mthd category
notifying:nil
install:true
skipIfSame:false
silent:true.
self
assert:mthd ~= (self class compiledMethodAt:#'inlinedBlockVariables1')
description:'Could not compile with STC'.
blk := self inlinedBlockVariables1.
self assert:((blk value:#argbbb_1) == #localb_1).
].
"
self run:#test20_localsOfInlinedBlock_bug
self new test20_localsOfInlinedBlock_bug
"
"Created: / 17-09-2011 / 10:32:18 / cg"
!
test21_localsOfInlinedBlock_bug
"checks for an stc compiler bug (detected Sep 2011).
stc generates bad code for the bitOr expression in nextLittleEndianNumber"
|blk mthd|
Class withoutUpdatingChangesDo:[
self class recompile:#'inlinedBlockVariables2'.
blk := self inlinedBlockVariables2.
self assert:((blk value:#argbbb_1) == 3).
mthd := self class compiledMethodAt:#'inlinedBlockVariables2'.
(STCCompilerInterface new)
compileToMachineCode:mthd source
forClass:self class
selector:#'inlinedBlockVariables2'
inCategory:mthd category
notifying:nil
install:true
skipIfSame:false
silent:true.
self
assert:mthd ~= (self class compiledMethodAt:#'inlinedBlockVariables2')
description:'Could not compile with STC'.
blk := self inlinedBlockVariables2.
self assert:((blk value:#argbbb_1) == 3).
].
"
self run:#test21_localsOfInlinedBlock_bug
self new test21_localsOfInlinedBlock_bug
"
"Created: / 17-09-2011 / 10:32:18 / cg"
!
test_LongIntegerArray_01
|sizes|
[
Class
withoutUpdatingChangesDo:[
"/ Now, compile the same source using stc and check...
(STCCompilerInterface new)
compileToMachineCode:'longIntegerArray_size
| arr size1 size2 |
arr := LongIntegerArray new: 8.
size1 := arr size.
%{
size2 = __MKINT(__longIntegerArraySize(arr));
%}.
^ Array with: size1 with: size2.
'
forClass:self class class
selector:#'longIntegerArray_size'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
sizes := self class perform:#'longIntegerArray_size'.
self assert:(sizes first == 8).
self assert:(sizes second == 8).
self class class removeSelector:#'longIntegerArray_size'.
].
] ensure:[ self class class removeSelector:#'longIntegerArray_size'. ]
"
self run:#test02_compilation
self new test02_compilation"
"Created: / 04-03-2014 / 10:20:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_LongIntegerArray_02
|sizes verbose|
verbose := false.
[
Class
withoutUpdatingChangesDo:[
(STCCompilerInterface new)
compileToMachineCode:'longIntegerArray_i_element
| arr v1 v8 |
arr := LongIntegerArray new: 8.
arr at: 1 put: 11123456789.
arr at: 8 put: 11123456789.
self assert: (arr at: 1) = 11123456789.
self assert: (arr at: 8) = 11123456789.
%{
__uint64__ val;
console_printf("arr: arr = 0x%x\n", (INT)arr);
#if defined(__x86_64__)
val = 0x0001000100010001;
#else
val.lo = 1; val.hi = 1;
#endif
val = __LongIntegerArrayInstPtr(arr)->i_element[0];
// console_printf("v1: val.lo = %d, val.hi = %d\n", val.lo, val.hi);
v1 = __MKUINT64(&val);
val = __LongIntegerArrayInstPtr(arr)->i_element[7];
// console_printf("v2: val.lo = %d, val.hi = %d\n", val.lo, val.hi);
v8 = __MKUINT64(&val);
%}.
v1 errorPrintCR.
v8 errorPrintCR.
^ Array with: v1 with: v8.
'
forClass:self class class
selector:#'longIntegerArray_i_element'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
1 to:100 do:[:i |
verbose ifTrue:[
('Pass ' , i printString) errorPrintCR.
].
sizes := self class perform:#'longIntegerArray_i_element'.
self assert:(sizes first = 11123456789) description:('failed in pass ',i printString).
self assert:(sizes second = 11123456789) description:('failed in pass ',i printString).
].
self class class removeSelector:#'longIntegerArray_i_element'.
].
] ensure:[ self class class removeSelector:#'longIntegerArray_i_element'. ]
"
self run:#test02_compilation
self new test02_compilation"
"Created: / 04-03-2014 / 10:21:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 26-06-2014 / 10:44:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_LongIntegerArray_03
"does many scavenges to check if the moved LongIntegerArray remains at
an aligned address"
|verbose arr scaveneges|
verbose := false.
verbose ifTrue:[
('=====') errorPrintCR
].
arr := LongIntegerArray new:8.
arr at:1 put:11123456789.
arr at:8 put:11123456789.
self assert:(arr at:1) = 11123456789.
self assert:(arr at:8) = 11123456789.
verbose ifTrue:[
(' arr = 0x' , (ObjectMemory addressOf:arr) hexPrintString) errorPrintCR.
].
1 to:100 do:[:i |
verbose ifTrue:[
('Pass ' , i printString) errorPrintCR.
].
scaveneges := ObjectMemory scavengeCount.
[
scaveneges == ObjectMemory scavengeCount
] whileTrue:[
"/ Allocate some gagbage"
Array new:(Random nextIntegerBetween:1 and:100)
].
verbose ifTrue:[
('B: arr = 0x' , (ObjectMemory addressOf:arr) hexPrintString) errorPrintCR.
(' arr at: 1 ==> ' , (arr at:1) printString) errorPrintCR.
(' arr at: 8 ==> ' , (arr at:8) printString) errorPrintCR.
].
self assert:(arr at:1) = 11123456789 description:('failed in pass ',i printString).
self assert:(arr at:8) = 11123456789 description:('failed in pass ',i printString).
verbose ifTrue:[
('A: arr = 0x' , (ObjectMemory addressOf:arr) hexPrintString) errorPrintCR.
]
]
"
self run:#test_LongIntegeraArray_03
self new test_LongIntegeraArray_03"
"Created: / 26-06-2014 / 12:21:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_SignedLongIntegerArray_01
|sizes|
[
Class
withoutUpdatingChangesDo:[
"/ Now, compile the same source using stc and check...
(STCCompilerInterface new)
compileToMachineCode:'signedLongIntegerArray_size
| arr size1 size2 |
arr := SignedLongIntegerArray new: 8.
size1 := arr size.
%{
size2 = __MKINT(__signedLongIntegerArraySize(arr));
%}.
^ Array with: size1 with: size2.
'
forClass:self class class
selector:#'signedLongIntegerArray_size'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
sizes := self class perform:#'signedLongIntegerArray_size'.
self assert:(sizes first == 8).
self assert:(sizes second == 8).
self class class removeSelector:#'signedLongIntegerArray_size'.
].
] ensure:[ self class class removeSelector:#'signedLongIntegerArray_size'. ]
"
self run:#test02_compilation
self new test02_compilation"
"Created: / 04-03-2014 / 10:11:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
test_SignedLongIntegerArray_02
|sizes|
[
Class
withoutUpdatingChangesDo:[
(STCCompilerInterface new)
compileToMachineCode:'signedLongIntegerArray_i_element
| arr v1 v8 |
arr := SignedLongIntegerArray new: 8.
arr at: 1 put: 1123456789.
arr at: 8 put: 1123456789.
%{
__int64__ val;
val = __SignedLongIntegerArrayInstPtr(arr)->i_element[0];
v1 = __MKINT64(&val);
val = __SignedLongIntegerArrayInstPtr(arr)->i_element[7];
v8 = __MKINT64(&val);
%}.
^ Array with: v1 with: v8.
'
forClass:self class class
selector:#'signedLongIntegerArray_i_element'
inCategory:'tests'
notifying:nil
install:true
skipIfSame:false
silent:true.
sizes := self class perform:#'signedLongIntegerArray_i_element'.
self assert:(sizes first = 1123456789).
self assert:(sizes second = 1123456789).
self class class removeSelector:#'signedLongIntegerArray_i_element'.
].
] ensure:[ self class class removeSelector:#'signedLongIntegerArray_i_element'. ]
"
self run:#test02_compilation
self new test02_compilation"
"Created: / 04-03-2014 / 10:13:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!STCCompilerTests class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !