"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#CompilerTests2

	instanceVariableNames:'methods enabledJIT'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression'

!

!CompilerTests2 methodsFor:'private'!

assertSendersMethodIsIdenticalTo: sendersMethod

    "Do not assert here, pass down to have some immediate, possibly lazy contexts

     in between"

    self assertSendersSendersMethodIsIdenticalTo: sendersMethod

    "Created: / 25-04-2013 / 15:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

assertSendersSendersMethodIsIdenticalTo: thisMethod

    | ctx m |

    ctx := thisContext sender sender.

    "/ Now, DO NOT USE Context>>method as it searches for the method

    "/ if it is not set!!

    m := ctx instVarAt: (Context instVarIndexFor: #method).

    self assert: m == thisMethod

    "Created: / 25-04-2013 / 15:30:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

compile: source mode: mode

    "Compile given source and returns the new method.

     The from the source is prepended the mode + underscore

     (i.e., foo -> stc_foo).

     If mode is:

       #stc....then the method is stc-compiled.

       #jit....then the method is bytecode compiled and left

               to the jitter

       #bc.....them the method is bytecode compiled and marked

               as checked so JIT won't even try.

    "

    | m |

    Class withoutUpdatingChangesDo:[

        mode == #stc ifTrue:[

            ParserFlags withSTCCompilation:#always do:[

                m := self class compile: (mode, '_', source) classified: 'private - *dynamic*'.

            ].

        ] ifFalse:[

            ParserFlags withSTCCompilation:#never do:[

                m := self class compile: (mode, '_', source) classified: 'private - *dynamic*'.

                m checked: (mode == #bc)

            ].

        ].

    ].

    methods add: m.

    ^m

    "Created: / 25-04-2013 / 15:18:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

currentLineNumber

    thisContext fixAllLineNumbers.

    ^thisContext sender lineNumber.

    "Created: / 12-04-2013 / 21:20:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 13-04-2013 / 10:12:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompilerTests2 methodsFor:'private-mock methods'!

method_lineno_002

    1 factorial. ^self currentLineNumber

    "Created: / 12-04-2013 / 21:22:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_lineno_300

    "DO NOT MAKE THIS METHOD SHORTER, DO NOT REMOVE BLANK LINES!!!!!!"

    ^self currentLineNumber

    "Created: / 12-04-2013 / 21:23:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_methodslot_01: thisMethod

    self assertSendersMethodIsIdenticalTo: thisMethod

    "Created: / 25-04-2013 / 15:28:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_methodslot_02: thisMethod

     [ self assertSendersMethodIsIdenticalTo: thisMethod ]

        valueWithArguments:#() "/ don't use #value, it gets optimized!!

    "Created: / 25-04-2013 / 15:36:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_methodslot_03: thisMethod

    "Deep block nesting...."

    [

        [

            [

                [ 

                    self assertSendersMethodIsIdenticalTo: thisMethod 

                ] valueWithArguments:#() "/ don't use #value, it gets optimized!!

            ] valueWithArguments:#() "/ don't use #value, it gets optimized!!

        ] valueWithArguments:#() "/ don't use #value, it gets optimized!!

    ] valueWithArguments:#() "/ don't use #value, it gets optimized!!

    "Created: / 25-04-2013 / 15:38:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompilerTests2 methodsFor:'setup'!

setUp

    methods := Set new.

    enabledJIT := ObjectMemory justInTimeCompilation:true.

    "Created: / 25-04-2013 / 15:20:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

tearDown

    ObjectMemory justInTimeCompilation: enabledJIT.

    Class withoutUpdatingChangesDo:[

        (Smalltalk at: #'exept_regression_testData_CompilerTests2') notNil ifTrue:[

            (Smalltalk at: #'exept_regression_testData_CompilerTests2') classes do:[:e|

                e notNil ifTrue:[

                    Smalltalk removeClass: e

                ].

            ]

        ].

        methods do:[:m|

            m mclass removeSelector: m selector.

        ]

    ]

    "Created: / 26-10-2012 / 11:32:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompilerTests2 methodsFor:'tests'!

test_01

    "JV@2012-10-26:

     When a package is loaded from source using

        Smalltalk loadPackage:'...'

     expression __EVALUATED FROM WORKSPACE__ AND a method from loaded class

     uses a class from the same package that is not yet loaded (i.e., it will

     be loaded later),

     then the compiler as of 2012-10-26 generates access to a workspace variable

     instead of access to a global

     This tests checks for this bug

    "

    | ws |

    "/ this test only works with a Display...

    self skipIf:[Display isNil] description:'Test requires a Display'.

    "/First, make sure that package is not yet loaded...

    self

        assert: (Smalltalk at: #'exept_regression_testData_CompilerTests2') isNil

        description: 'Mock package already loaded'.

    ws := WorkspaceApplication new.

        contents: '(Smalltalk loadPackage: #''exept:regression/testData/CompilerTests2'')';

        selectAll;

        doIt.

    self assert: (Smalltalk at: #'RegressionTests::CompilerTests2Mock1') new foo class

                    == (Smalltalk at: #'RegressionTests::CompilerTests2Mock2')