"{ Package: 'exept:regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#CompilerTests2

	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.

        | ttt |

        ttt := 123.

    "

    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_argAndVarNames_06

    (Smalltalk at:#exept_regression) classNamesAndAttributesDo:[:clsnm :attributes|

        | cls |

        cls := Smalltalk at: clsnm.

        ((Array with: self class) includes: cls) ifTrue:[

            (attributes includes: #autoload) ifTrue:[

                "/ Care for Object!!

                cls superclass notNil ifTrue:[

                    | superDef superNm |

                    superDef := ProjectDefinition definitionClassForPackage: cls superclass package.

                    superNm := cls superclass name.

                    argAndVarNames := thisContext argAndVarNames asArray.    

                    ^ self

                ].

            ].

        ].

    ].           

    "

    CompilerTests2 basicNew method_argAndVarNames_06

    "

    "Created: / 20-09-2013 / 11:44:12 / 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!!!!!!"