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

"{ NameSpace: RegressionTests }"

TestCase subclass:#CompilerTests2

	instanceVariableNames:'methods enabledJIT savedContext savedContextArgAndVarNames

		savedContextArgAndVarValues savedContextArgAndVarValuesUsingEval

		savedContextLine'

	classVariableNames:''

	poolDictionaries:''

	category:'tests-Regression-Compilers'

!

!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>"

!

saveContext

    self saveContext: thisContext sender.

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

!

saveContext: aContext

    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"

    ].

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

    "Modified: / 26-09-2014 / 14:58:12 / 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: / 26-09-2014 / 13:01:17 / 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!!!!!!"