src/TestletTestCaseProxy.st
author vranyj1
Tue, 14 Jun 2011 13:25:53 +0000
branchjk_new_structure
changeset 855 809b1dc41615
parent 854 e165b3da9adb
child 859 56bc5e063b7d
permissions -rw-r--r--
use nameForHDTestReport and selectorForHDTestReport to identify test

"{ Package: 'stx:libjava' }"

TestCase subclass:#TestletTestCaseProxy
	instanceVariableNames:'harness'
	classVariableNames:'TestCases'
	poolDictionaries:''
	category:'Languages-Java-JUnit'
!

TestletTestCaseProxy class instanceVariableNames:'javaClassName shouldFork'

"
 The following class instance variables are inherited by this class:

	TestCase - lastTestRunResultOrNil lastTestRunsPassedTests lastTestRunsFailedTests lastTestRunsErrorTests
	TestAsserter - 
	Object - 
"
!


!TestletTestCaseProxy class methodsFor:'initialization'!

initialize

    TestCases := Dictionary new.

    "Created: / 01-03-2011 / 10:43:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

setJavaClassName: aSymbol

    javaClassName ifNotNil:
        [self error: 'Attempting to set java class name twice'].
    javaClassName := aSymbol.

    "Created: / 01-03-2011 / 10:43:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TestletTestCaseProxy class methodsFor:'accessing'!

javaClass

    ^Java at: javaClassName

    "Created: / 01-03-2011 / 11:30:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-03-2011 / 14:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

javaClassName

    ^javaClassName

    "Created: / 01-03-2011 / 11:30:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

lookupHierarchyRoot
    ^ TestletTestCaseProxy

    "Created: / 01-03-2011 / 11:41:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-03-2011 / 14:54:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-04-2011 / 10:25:26 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!

selector: aSymbol

    ^super selector: aSymbol

    "Created: / 01-03-2011 / 11:55:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

shouldFork
    ^ shouldFork ? false

    "Modified: / 13-06-2011 / 16:34:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

shouldFork:something
    shouldFork := something.
! !

!TestletTestCaseProxy class methodsFor:'private'!

testSelectors
    "testlet always has only one test method, but maybe for the future.."

    ^ #( #'test(Lgnu.testlet.TestHarness;)' ).

    "Created: / 01-03-2011 / 10:49:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2011 / 00:34:39 / Marcel Hlopko <hlopik@gmail.com>"
    "Modified: / 04-03-2011 / 00:05:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-05-2011 / 22:54:06 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !

!TestletTestCaseProxy class methodsFor:'queries'!

isTestlet
	^ true

!

isAbstract
    ^ self == TestletTestCaseProxy

    "Created: / 28-02-2011 / 22:32:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 01-03-2011 / 14:54:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-04-2011 / 10:21:51 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !

!TestletTestCaseProxy class methodsFor:'subclass creation'!

for: javaClass 
    "Answers a new (anonymous) testcase proxy for
     given javaClass"
    
    | meta  cls  name |

    self assert: javaClass isJavaClass description: 'Not a java class'.
    self assert: javaClass isTestletLike
        description: 'Not a testcase-like class'.
    name := javaClass name.
    TestCases at: name ifPresent: [:c | ^ c ].
    meta := Metaclass new.
    meta setSuperclass: TestletTestCaseProxy class.
    meta instSize: TestletTestCaseProxy class instSize.
    cls := meta new.
    cls setSuperclass: TestletTestCaseProxy.
    cls flags: TestletTestCaseProxy flags.
    cls instSize: TestletTestCaseProxy instSize.
    cls setJavaClassName: name.
    cls 
        setName: ('TestletTestCase for: (Java classForName: ' , name storeString 
                , ')') asSymbol.
    cls setCategory: javaClass category.
    TestCases at: name put: cls.
    ^ cls

    "Created: / 01-03-2011 / 10:30:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-03-2011 / 00:20:49 / Marcel Hlopko <hlopik@gmail.com>"
    "Modified: / 01-04-2011 / 16:02:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-04-2011 / 10:21:39 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
! !

!TestletTestCaseProxy methodsFor:'accessing'!

javaClass

    | javaClass |

    self 
        assert: (javaClass := self class javaClass) isJavaClass
        description: 'java class does not exists'.
    ^javaClass

    "Created: / 01-03-2011 / 14:48:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

nameForHDTestReport

    ^(self class javaClassName copyReplaceAll:$/ with: $.) copyTo: (self class javaClassName lastIndexOf: $/) - 1.

    "Created: / 01-04-2011 / 16:10:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectorForHDTestReport

    ^self class javaClassName copyFrom: 
		(self class javaClassName lastIndexOf: $/) + 1



! !

!TestletTestCaseProxy methodsFor:'error handling'!

doesNotUnderstand: aMessage

    aMessage selector == #'check(Z)V' ifTrue: [
        aMessage arg1 == 0 ifTrue:
            [TestResult failure sunitSignalWith: 'Testlet failed']
    ] ifFalse:[ aMessage selector == #'check(ZLjava/lang/String;)V' ifTrue:[
        aMessage arg1 == 0 ifTrue:        
            [TestResult failure sunitSignalWith: (Java as_ST_String: aMessage arguments second)]
    ]].
    (harness respondsTo: aMessage selector) ifTrue:
        [^aMessage sendTo: harness].
    ^super doesNotUnderstand: aMessage

    "Created: / 31-05-2011 / 16:30:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TestletTestCaseProxy methodsFor:'private'!

harnessMock
    ^ (Java classForName: 'stx.libjava.tests.mocks.TestletHarnessMock') new.

    "Modified: / 29-04-2011 / 10:52:53 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
!

performTest
    | handlerBlock |

    handlerBlock := [:ex | TestResult failure sunitSignalWith: ex description].

    harness := self harnessMock.
    
    [ JavaVM unimplementedNativeMethodSignal 
        handle:
            handlerBlock
        do: [
            self javaClass new 
                perform: 'test(Lgnu/testlet/TestHarness;)V' sunitAsSymbol
                with: self
       ].
    ] on: JavaError do: [:ex | 
        TestResult failure sunitSignalWith: ex description
    ].

    "/((harness instVarNamed: 'passed') = 0 ) ifTrue: [ TestResult failure sunitSignalWith: 'Test failed' ].

    "Created: / 01-03-2011 / 14:50:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 29-05-2011 / 23:19:07 / Marcel Hlopko <hlopkmar@fel.cvut.cz>"
    "Modified: / 13-06-2011 / 17:03:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!TestletTestCaseProxy class methodsFor:'documentation'!

version_SVN
    ^ '$Id$'
! !

TestletTestCaseProxy initialize!