"{ 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'!

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

!

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>"

!

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"

! !

!STCCompilerTests class methodsFor:'documentation'!

version

    ^ '$Header$'

!

version_CVS

    ^ '$Header$'

! !