"{ Package: 'exept: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>"