"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#CompilerTests2
	instanceVariableNames:'methods enabledJIT argAndVarNames'
	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_argAndVarNames_01
    #(1 2 3 4) select:[:each |
        | isEven |

        isEven := each even.
        argAndVarNames := thisContext argAndVarNames asArray.
    ].

    "Created: / 20-08-2013 / 09:04:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

method_argAndVarNames_02
    #(1 2 3 4) select:[:each |
        | isEven |

        '1234' select:[:char |
            | someOtherLocal |

            someOtherLocal := char == $1.
        ].
        isEven := each even.
        argAndVarNames := thisContext argAndVarNames asArray.
    ].

    "Created: / 20-08-2013 / 09:17:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

method_argAndVarNames_03
    "Reported by Stefan"

    argAndVarNames := 1.
    Smalltalk isStandAloneApp ifTrue:[
        | ttt |

        ttt := 123.
        argAndVarNames := thisContext argAndVarNames asArray.    
    ]

    "
    CompilerTests2 basicNew method_argAndVarNames_03
    "

    "Created: / 20-08-2013 / 09:22:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

method_argAndVarNames_04
    #(1 2 3 4) select:[:each |
        | isEven |

        isEven := each even.
        isEven ifTrue:[
            | isOddNot |

            isOddNot := each odd not.
            argAndVarNames := thisContext argAndVarNames asArray.
        ]
    ].

    "Created: / 20-08-2013 / 10:11:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

method_argAndVarNames_05
    | b |

    b := [:len |
        1 to: len do:[:i|
            | local1 local2 |

            local1 := #local1.
            local2 := 42.

            i == 1 ifTrue:[
                argAndVarNames := thisContext argAndVarNames asArray.
            ]
        ]
    ].

    b value: 5

    "
    CompilerTests2 basicNew method_argAndVarNames_05
    "

    "Created: / 22-08-2013 / 15:48:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

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.
    argAndVarNames := nil.

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

tearDown
    ObjectMemory justInTimeCompilation: enabledJIT.
    Class withoutUpdatingChangesDo:[
        | classesToRemove |
        (Smalltalk at: #'exept_regression_testData_CompilerTests2') notNil ifTrue:[
            (Smalltalk at: #'exept_regression_testData_CompilerTests2') classes do:[:e|
                e notNil ifTrue:[
                    Smalltalk removeClass: e
                ].
            ].
        ].
        Smalltalk allClassesDo:[:cls|
            (#(
                'exept:regression/testData/CompilerTests2'
                "/Add more...
            ) includes: cls package) ifTrue:[
                Smalltalk removeClass: cls
            ]
        ].

        methods do:[:m|
            m mclass removeSelector: m selector.
        ]
    ]

    "Created: / 26-10-2012 / 11:32:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-06-2013 / 14:12:22 / 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.
    ws selectedWorkspace
        autoDefineVariables: #workspace;
        contents: '(Smalltalk loadPackage: #''exept:regression/testData/CompilerTests2'')';
        selectAll;
        doIt.

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

    "Created: / 26-10-2012 / 11:59:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 24-06-2013 / 15:30:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_02
    "JV@2012-10-26:

     When a package is loaded from source using

	Smalltalk loadPackage:'...'

     expression and a method from loaded class in namespace uses a class from the
     same package and same namespace, that is not yet loaded (i.e., it will be loaded
     later),

     then the compiler as of 2012-10-26 generates access to class in no namespace.

     This test checks for this bug
    "

    "/First, make sure that package is not yet loaded...
    self
	assert: (Smalltalk at: #'exept_regression_estData_CompilerTests2') isNil
	description: 'Mock package already loaded'.

    self
	assert: (Smalltalk loadPackage: #'exept:regression/testData/CompilerTests2')
	description: 'Cannot load mock package!!'.


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

    "Created: / 26-10-2012 / 12:26:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified (comment): / 12-02-2013 / 16:24:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_03
    "JV@2013-10-27:

     As of 2013-10-27 parser crashes on DNU when a message
     is constant-folded.
    "

    self compile: 'mock_03 ^ 1 perform: #+ with: 2' mode: #bc.
    self assert: self bc_mock_03 == 3

    "Created: / 24-06-2013 / 14:06:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-08-2013 / 02:38:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_04
    "JV@2013-10-27:

     As of 2013-10-27 bytecode compiler generates invalid code
     for perform:* with constant symbol. That's because
     in Parser, rev 1.781 >> keywordExpressionFor:, line 57 the
     selector is reser back to the original, overwriting the one
     set by constant-folding method.
    "

    self compile: 'mock_04:x ^x perform: #+ with: 2' mode: #bc.
    self assert: (self bc_mock_04:2) == 4

    "Created: / 27-08-2013 / 02:37:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 27-08-2013 / 10:32:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CompilerTests2 methodsFor:'tests - arg & var names'!

test_argAndVarNames_01

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_01) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_01') asSymbol.
        self assert: argAndVarNames = #(each isEven)
    ]

    "Created: / 20-08-2013 / 09:05:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_argAndVarNames_02

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_02) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_02') asSymbol.
        self assert: argAndVarNames = #(each isEven)
    ]

    "Created: / 20-08-2013 / 09:17:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_argAndVarNames_03

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_03) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_03') asSymbol.
        self assert: argAndVarNames = #(ttt)
    ]

    "Created: / 20-08-2013 / 09:23:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_argAndVarNames_04

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_04) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_04') asSymbol.
        self assert: argAndVarNames = #(each isEven isOddNot)
    ]

    "Created: / 20-08-2013 / 10:12:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_argAndVarNames_05

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_05) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_05') asSymbol.
        self assert: argAndVarNames = #(len i local1 local2)
    ]

    "Created: / 22-08-2013 / 15:49:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CompilerTests2 methodsFor:'tests - line numbers'!

test_lineno_01_bci
    | m002 m300 l |

    m002 := self compile: (self class >> #method_lineno_002) source mode: #bc.
    m300 := self compile: (self class >> #method_lineno_300) source mode: #bc.

    self assert: (l := self bc_method_lineno_002) == 2.
    self assert: (l := self bc_method_lineno_300) == 300.

    self assert: m002 code isNil.
    self assert: m300 code isNil.

    "Created: / 12-04-2013 / 21:24:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 25-04-2013 / 15:24:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_lineno_01_jit
    | m002 m300 l |

    m002 := self compile: (self class >> #method_lineno_002) source mode: #jit.
    m300 := self compile: (self class >> #method_lineno_300) source mode: #jit.

    self assert: (l := self jit_method_lineno_002) == 2.
    self assert: (l := self jit_method_lineno_300) == 300.

    self assert: m002 code notNil.
    self assert: m300 code notNil.

    "Created: / 12-04-2013 / 21:41:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 10-05-2013 / 18:23:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_lineno_01_stc
    | m002 m300 l |

    m002 := self class >> #method_lineno_002.
    m300 := self class >> #method_lineno_300.

    self compile: m002 source mode: #stc.
    self compile: m300 source mode: #stc.

    self assert: (l := self stc_method_lineno_002) == 2.
    self assert: (l := self stc_method_lineno_300) == 300.

    "Created: / 12-04-2013 / 21:50:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 25-04-2013 / 15:22:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!CompilerTests2 methodsFor:'tests - method slot'!

test_methodslot_01_bci
    | m |

    m := self compile: (self class >> #method_methodslot_01:) source mode: #bc.
    self bc_method_methodslot_01: m.
    self assert: m code isNil.

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

test_methodslot_01_jit
    | m |

    m := self compile: (self class >> #method_methodslot_01:) source mode: #jit.
    self jit_method_methodslot_01: m.
    self assert: m code notNil.

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

test_methodslot_01_stc
    | m |

    m := self compile: (self class >> #method_methodslot_01:) source mode: #stc.
    self stc_method_methodslot_01: m.
    self assert: m code notNil.

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

test_methodslot_02_bci
    | m |

    m := self compile: (self class >> #method_methodslot_02:) source mode: #bc.
    self bc_method_methodslot_02: m.
    self assert: m code isNil.

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

test_methodslot_02_jit
    | m |

    m := self compile: (self class >> #method_methodslot_02:) source mode: #jit.
    self jit_method_methodslot_02: m.
    self assert: m code notNil.

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

test_methodslot_02_stc
    | m |

    m := self compile: (self class >> #method_methodslot_02:) source mode: #stc.
    self stc_method_methodslot_02: m.
    self assert: m code notNil.

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

test_methodslot_03_bci
    | m |

    m := self compile: (self class >> #method_methodslot_03:) source mode: #bc.
    self bc_method_methodslot_03: m.
    self assert: m code isNil.

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

test_methodslot_03_jit
    | m |

    m := self compile: (self class >> #method_methodslot_03:) source mode: #jit.
    self jit_method_methodslot_03: m.
    self assert: m code notNil.

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

test_methodslot_03_stc
    | m |

    m := self compile: (self class >> #method_methodslot_03:) source mode: #stc.
    self stc_method_methodslot_03: m.
    self assert: m code notNil.

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

!CompilerTests2 class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
!

version_SVN
    ^ '$Id$'
! !