"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#STCCompilerTests

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression'

!

!STCCompilerTests class methodsFor:'documentation'!

documentation

"

    documentation to be added.

    [author:]

        cg

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!STCCompilerTests methodsFor:'code templates'!

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|

    "

     self run:#test02_compilation

     self new test02_compilation

    "

    "Created: / 04-09-2013 / 09:35:35 / 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"

! !

!STCCompilerTests class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !