RegressionTests__CompilerTests2.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Mon, 20 Jan 2014 14:48:00 +0100
changeset 1037 4bba0706b9ae
parent 1001 9478e093ee77
child 1138 cd03872a5b98
permissions -rw-r--r--
Added tests covering symbol parsing inconsistency in array literals.

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









































































































































































































































































































    ^self currentLineNumber

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

method_literals_array_01
    | literal |

    literal := #(
        _XXX:_:
        YYY
        _XXX:_:
    ).
    ^ literal

    "Created: / 20-01-2014 / 13:39:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

method_literals_symbol_01
    | literal |

    literal := #_XXX:_:.
    ^ literal.

    "Created: / 20-01-2014 / 13:43:24 / 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 - FFI'!

test_external_function_call_01
    "Test for stx bug for <cdecl> specs like

        <cdecl: Cairo::FontFace 'cairo_get_font_face' ( Cairo::GraphicsContext ) >

     i.e., when custom subclass of ExternalAddress is in namespace."
    
    | malloc  free |

    malloc := 'malloc: size

    <cdecl: RegressionTests::CompilerTests2ExternalBytes "malloc" ( int ) module: ''librun.so''>
    self primitive failed'.
    free := 'free: ptr

    <cdecl: void "free" ( RegressionTests::CompilerTests2ExternalBytes ) module: ''librun.so''>
    self primitive failed'.
    #( #bc #stc ) do:[:mode | 
        | ptr |

        self compile:malloc mode:mode.
        self compile:free mode:mode.
        ptr := self perform:(mode , '_malloc:') asSymbol with:1.
        self assert:ptr class == RegressionTests::CompilerTests2ExternalBytes.
        self perform:(mode , 'free:') asSymbol with:ptr.
    ]

    "Created: / 06-01-2014 / 11:29:10 / 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>"
!

test_argAndVarNames_06

    #(bc jit stc) do:[:mode |
        argAndVarNames := nil.
        self compile: (self class >> #method_argAndVarNames_06) source mode: mode.
        self perform: (mode , '_method_argAndVarNames_06') asSymbol.
        self assert: argAndVarNames = #(clsnm attributes cls superDef superNm)
    ]

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

test_literals_array_01
    | m l_stc l_bc |

    m := self class >> #method_literals_array_01.

    self compile: m source mode: #stc.
    self compile: m source mode: #bc.

    l_stc := self stc_method_literals_array_01.
    l_bc :=  self bc_method_literals_array_01.

    self assert: l_stc = l_bc.

    "Created: / 20-01-2014 / 13:46:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_literals_array_01_bc
    | m l |

    m := self class >> #method_literals_array_01.

    self compile: m source mode: #bc.

    l := self bc_method_literals_array_01.

    self assert: l size == 3.
    self assert: l first == #'_XXX:_:'.
    self assert: l first == #'YYY'.
    self assert: l third == #'_XXX:_:'.

    "Created: / 20-01-2014 / 13:42:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_literals_array_01_stc
    | m l |

    m := self class >> #method_literals_array_01.

    self compile: m source mode: #stc.

    l := self stc_method_literals_array_01.

    self assert: l size == 3.
    self assert: l first == #'_XXX:_:'.
    self assert: l first == #'YYY'.
    self assert: l third == #'_XXX:_:'.

    "Created: / 20-01-2014 / 13:40:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_literals_symbol_01_bc
    | m l |

    m := self class >> #method_literals_symbol_01.

    self compile: m source mode: #bc.

    l := self bc_method_literals_symbol_01.
    self assert: l == #'_XXX:_:'.

    "Created: / 20-01-2014 / 13:44:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

test_literals_symbol_01_stc
    | m l |

    m := self class >> #method_literals_symbol_01.

    self compile: m source mode: #stc.

    l := self stc_method_literals_symbol_01.
    self assert: l == #'_XXX:_:'.

    "Created: / 20-01-2014 / 13:44:37 / 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$'
! !