"

 COPYRIGHT (c) Claus Gittinger / eXept Software AG

 COPYRIGHT (c) 2015-2016 Jan Vrany

 COPYRIGHT (c) 2018 Jan Vrany

 COPYRIGHT (c) 2021 LabWare

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:goodies/regression' }"

"{ NameSpace: RegressionTests }"

TestCase subclass:#CompilerTests2

	instanceVariableNames:'methods enabledJIT savedContext savedContextArgAndVarNames

		savedContextArgAndVarValues savedContextArgAndVarValuesUsingEval

		savedContextLine verbose parserFlags'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-Compilers'

!

!CompilerTests2 class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) Claus Gittinger / eXept Software AG

 COPYRIGHT (c) 2015-2016 Jan Vrany

 COPYRIGHT (c) 2018 Jan Vrany

 COPYRIGHT (c) 2021 LabWare

              All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

! !

!CompilerTests2 class methodsFor:'accessing'!

libraryName

    OperatingSystem isUNIXlike ifTrue:[^'librun.so'].

    OperatingSystem isMSWINDOWSlike ifTrue:[^'kernel32.dll'].

    self error:'Library name for host OS is not known'

    "Created: / 14-07-2016 / 10:10:56 / jv"

! !

!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 methodSlotIndex method |

    ctx := thisContext sender sender.

    methodSlotIndex := Context instVarIndexFor: #method.

    [ ctx isBlockContext ] whileTrue:[

        | block |

        block := ctx instVarAt: methodSlotIndex.

        self assert: block isBlock.

        self assert: block home == ctx home.

        ctx := ctx home.

    ].

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

    "/ if it is not set!!

    method := ctx instVarAt: methodSlotIndex.

    self assert: method == thisMethod

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

    "Modified: / 08-09-2016 / 11:15:44 / 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>"

!

compile: source mode: mode andPerform: args

    "Compile given `source` in given `mode` and perform

     compiled method with given `args`. Return method's

     return value.

     For possible values of `mode`, see #compile:mode:.

    "

    | 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: / 15-07-2018 / 11:42:54 / 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>"

!

saveContext

    self saveContext: thisContext sender.

    "Created: / 26-09-2014 / 12:49:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

saveContext: aContext

    | dbgVariables |

    savedContext := aContext.

    savedContextArgAndVarNames := savedContext argAndVarNames asArray.

    savedContextArgAndVarValues := savedContext argsAndVars.

    savedContextArgAndVarValuesUsingEval := savedContextArgAndVarNames 

        collect:[ :each | 

            Compiler evaluate:each

                             in:savedContext

                             receiver:savedContext receiver

                             notifying:nil

                             logged:false

                             ifFail:[ '*Error when evaluating*'].

        ].

    savedContextLine := savedContext lineNumber.

    self assert: savedContextArgAndVarNames size == savedContextArgAndVarValues size.

    self assert: savedContextArgAndVarNames size == savedContextArgAndVarValuesUsingEval size.

    1 to: savedContextArgAndVarNames size do:[:i | 

        | v1 v2 |

        v1 := savedContextArgAndVarValues at: i.

        v2 := savedContextArgAndVarValuesUsingEval at: i.

        self assert: v1 == v2. "HAS to be IDENTICAL"

    ].

    dbgVariables := savedContext dbgVariables.

    self assert: savedContextArgAndVarNames size = dbgVariables size.

    savedContextArgAndVarNames withIndexDo:[ :name :index |

        | var |

        var := dbgVariables detect:[:e | e frameOffset = index ].

        self assert: var notNil.

        self assert: var name = name.

        self assert: var frameOffset = index.

    ].

    "Created: / 26-09-2014 / 12:49:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-02-2019 / 08:49:52 / 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.

        self saveContext.

    ].

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

    "Modified: / 26-09-2014 / 13:00:53 / 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.

        self saveContext.

    ].

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

    "Modified: / 26-09-2014 / 13:00:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_argAndVarNames_03

    "Reported by Stefan"

    savedContextArgAndVarNames := 1.

    (Smalltalk isStandAloneApp | (savedContextArgAndVarNames == 1)) ifTrue:[

        | ttt |

        ttt := 123.

        self saveContext.

    ].

    self halt.

    "

    CompilerTests2 basicNew method_argAndVarNames_03

    "

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

    "Modified: / 26-09-2014 / 13:01:04 / 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.

            self saveContext.

        ]

    ].

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

    "Modified: / 26-09-2014 / 13:01:08 / 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:[

                self saveContext.

            ]

        ]

    ].

    b value: 5

    "

    CompilerTests2 basicNew method_argAndVarNames_05

    "

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

    "Modified: / 26-09-2014 / 13:01:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_argAndVarNames_06

    (Smalltalk at:#stx_goodies_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.

                    self saveContext.

                    ^ self

                ].

            ].

        ].

    ].           

    "

    CompilerTests2 basicNew method_argAndVarNames_06

    "

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

    "Modified: / 11-07-2016 / 09:42:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

method_argAndVarNames_07

    | b |

    b := [:len |

        1 to: len do:[:i|

            i == 1 ifTrue:[

                self saveContext.

            ]

        ]

    ].

    b value: 5

    "

    CompilerTests2 basicNew method_argAndVarNames_05

    "

    "Created: / 23-12-2015 / 18:40:11 / 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!!!!!!"