"{ Package: 'jv:dragonfly' }"

"{ NameSpace: Smalltalk }"

TestCase subclass:#CompiledCodeObjectTests

	instanceVariableNames:'jitEnabled'

	classVariableNames:''

	poolDictionaries:'CompiledCodeObjectSectionFormat'

	category:'System-Compiler-Interface-Tests'

!

!CompiledCodeObjectTests class methodsFor:'documentation'!

documentation

"

    documentation to be added.

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!CompiledCodeObjectTests methodsFor:'running'!

setUp

    "common setup - invoked before testing."

    super setUp.

    jitEnabled := ObjectMemory justInTimeCompilation: true.

    "Modified: / 06-12-2015 / 00:10:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

tearDown

    "common cleanup - invoked after testing."

    super tearDown.

    ObjectMemory justInTimeCompilation: jitEnabled

    "Modified: / 06-12-2015 / 00:11:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompiledCodeObjectTests methodsFor:'test data'!

methodWithConstant

    ^ 123

    "Created: / 06-12-2015 / 00:15:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

methodWithLiteral

    ^ #(Literal 2)

    "Created: / 07-12-2015 / 16:52:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

methodWithSend

    ^ OrderedCollection size + 10

    "Created: / 07-12-2015 / 16:51:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompiledCodeObjectTests methodsFor:'tests'!

test_01

    | object section |

    self ensureCompiled: #methodWithConstant.

    object := (self class >> #methodWithConstant) codeObject.

    self assert: object compiledCode == (self class >> #methodWithConstant).

    self assert: object sections size == 2. "/ No literals no ILC's, only code and special cells

    section := object sectionNamed: '.text'.

    self assert: section format = SectionFormatText.

    self assert: section size > 1.

    self assert: ((1 to: section size) allSatisfy:[:i | (section at: i) <= 255 ]).

    section := object sectionNamed: '.stx.codeobj.specialcells'. 

    self assert: section format = SectionFormatINTVector.

    self assert: section size == 1.

    self should: [ section at: 0 ] raise: PrimitiveFailure.

    self assert: (section at: 1) isInteger.

    self should: [ section at: 2 ] raise: PrimitiveFailure.

    self should: [ section at: 0 put: 123 ] raise: PrimitiveFailure.

    self should: [ section at: 1 put: 'Invalid' ] raise: PrimitiveFailure.

    self should: [ section at: 2 put: 123 ] raise: PrimitiveFailure.

    section at: 1 put: 10.

    self assert: (section at: 1) == 10.

    self ensureCompiled: #methodWithLiteral.

    object := (self class >> #methodWithLiteral) codeObject.

    self assert: object sections size == 3. "/ No ILC's but literals, code and special cells

    section := object sectionNamed: '.text'.

    section := object sectionNamed: '.stx.codeobj.specialcells'. 

    section := object sectionNamed: '.stx.codeobj.literals'. 

    self assert: section format = SectionFormatOBJVector.

    self assert: section size == 1.

    self assert: (section at: 1) = #(#Literal 2). 

    self assert: (self methodWithLiteral) = #(#Literal 2). 

    section at: 1 put: 123.

    self assert: (section at: 1) == 123. 

    self assert: (self methodWithLiteral) == 123.

    self ensureCompiled: #methodWithSend.

    object := (self class >> #methodWithSend) codeObject.

    self assert: object sections size == 4. "/ Literals (for the selector), ILC, code and special cells

    section := object sectionNamed: '.text'.

    section := object sectionNamed: '.stx.codeobj.specialcells'. 

    section := object sectionNamed: '.stx.codeobj.ilcs'. 

    self assert: section format = SectionFormatILCVector.

    self assert: section size == 2.

    "Created: / 06-12-2015 / 00:15:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-01-2016 / 22:15:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_02a

    "Tests creation of new code object for method which has

     not yet been compiled"

    | method object section |

    method := Method new.

    method numberOfArgs: 0.

    method numberOfVars: 0.

    method stackSize: 0.          

    object := CompiledCodeObject forCompiledCode: method text: 6 literals: 1 ilcs: 0.

    self assert: object compiledCode == method.

    section := object sectionNamed: '.text'.

    self assert: section format = SectionFormatText.

    self assert: section size == 6.

    self assert: ((1 to: section size) allSatisfy:[:i | (section at: i) == 0 ]).

    section := object sectionNamed: '.stx.codeobj.literals'.

    self assert: section format = SectionFormatOBJVector.

    self assert: section size == 1.

    self assert: ((1 to: section size) allSatisfy:[:i | (section at: i) isNil ]).

    "Created: / 24-01-2016 / 20:49:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

test_02b

    "Tests creation of new code object for method which has

     not yet been compiled"

    | method object section |

    method := Method new.

    method numberOfArgs: 0.

    method numberOfVars: 0.

    method stackSize: 0.          

    object := CompiledCodeObject forCompiledCode: method text: 0 literals: 1 ilcs: 0.

    self assert: object compiledCode == method.

    self assert: (object hasSectionNamed: '.text') not.

    object allocateTextSection: 10.

    section := object sectionNamed: '.text'.

    self assert: section format = SectionFormatText.

    self assert: section size == 10.

    self assert: ((1 to: section size) allSatisfy:[:i | (section at: i) == 0 ]).

    "Created: / 24-01-2016 / 20:50:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompiledCodeObjectTests methodsFor:'utilities'!

ensureCompiled: selector

    ((self class >> selector) code isNil or:[ (self class >> selector) byteCode isNil ]) ifTrue:[

        self class recompile: selector.

        self assert: (self class >> selector) code isNil.

        self perform: selector.

        self assert: (self class >> selector) code notNil.

    ]

    "Created: / 06-12-2015 / 00:13:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!CompiledCodeObjectTests class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !