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

Object subclass:#TestCaseOutcome

	instanceVariableNames:'testCase result properties'

	classVariableNames:'RemeberedOutcomes'

	poolDictionaries:''

	category:'SUnit-Base'

!

!TestCaseOutcome class methodsFor:'documentation'!

documentation

"

    will keep additional info for a testCase run:

        startTime, endTime,

        backtrace (if fail or error)

        and collectedStdout

"

! !

!TestCaseOutcome class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    RemeberedOutcomes := SUnitNameResolver weakIdentityDictionaryClass new

    "Modified: / 14-07-2014 / 09:59:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome class methodsFor:'instance creation'!

forCase: aTestCase

    ^self new testCase: aTestCase; yourself

    "Created: / 16-08-2011 / 15:24:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome class methodsFor:'notifying'!

notifyOutcomeChanged: currentOutcome ifDifferentFrom: previousOutcome

    "Notifies whoever is interested that the current outcome for a testcase has

     changed, but only if result of the current (pass, fail or error) is actually 

     different the result of previous outcome"   

    (previousOutcome isNil or:[ previousOutcome result ~~ currentOutcome result ]) ifTrue:[ 

        currentOutcome testCase class lastTestRunResultChanged:currentOutcome testCase selector         

    ].

    "Created: / 14-07-2014 / 21:07:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome class methodsFor:'remembering'!

rememberOutcome: current

    | method outcomes previous |    

    method := current method.                                    

    outcomes := RemeberedOutcomes at: method ifAbsent:[ RemeberedOutcomes at: method put: TestCaseOutcomeWeakIdentityDictionary new ]. 

    previous := outcomes at: current testCase class ifAbsent:[ nil ].

    outcomes at: current testCase class put: current.

    self notifyOutcomeChanged: current ifDifferentFrom: previous.

    "Created: / 13-07-2014 / 23:28:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 14-07-2014 / 21:16:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rememberedOutcomeFor: selector in: class

    | implementor method outcomes |

    implementor := class.

    implementor isNil ifTrue:[ ^ nil ].

    method := implementor compiledMethodAt: selector.                   

    outcomes := RemeberedOutcomes at: method ifAbsent:[ ^ nil ].

    ^ outcomes at: class ifAbsent: [ nil ]

    "Created: / 13-07-2014 / 23:56:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome methodsFor:'accessing'!

collectedOutput

    ^self propertyAt: #collectedOutput

    "Modified: / 16-08-2011 / 15:27:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Created: / 16-08-2011 / 18:19:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

collectedOutput: aString

    ^self propertyAt: #collectedOutput put: aString

    "Modified: / 16-08-2011 / 15:28:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Created: / 16-08-2011 / 18:19:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

endTime

    ^self propertyAt: #endTime

    "Modified: / 16-08-2011 / 15:28:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

endTime: anObject

    ^self propertyAt: #endTime put: anObject

    "Modified: / 16-08-2011 / 15:28:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

exceptionDetail

    ^self propertyAt: #exceptionDetail

    "Modified: / 16-08-2011 / 15:29:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

exceptionDetail: anObject

    ^self propertyAt: #exceptionDetail put: anObject

    "Modified: / 16-08-2011 / 15:29:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

executionTime

    "the execution time in millis; nil if not yet executed"

    |startTime endTime|

    (startTime := self startTime) isNil ifTrue:[

        "/ not yet executed

        ^ nil

    ].

    (endTime := self endTime) isNil ifTrue:[

        "/ assume it is still running...

        endTime := Timestamp now

    ].

    ^ (endTime millisecondDeltaFrom:startTime)

    "Modified (format): / 18-08-2011 / 21:02:28 / cg"

!

method

    "Return the CompiledMethod corresponding to this test case in as dialect-neutral a way as possible.  We code on the assumption there must be one. If there isn't and we work up to nil superclass then fail, not bothering with implementor isNil ifTrue: [^nil] as we assume the caller would immediately fail in that case."

    | implementor |

    implementor := testCase class.

    [implementor includesSelector: testCase selector]

            whileFalse: [implementor := implementor superclass].

    ^ implementor compiledMethodAt: testCase selector

    "Created: / 13-07-2014 / 23:31:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

propertyAt: aSymbol

    ^ self propertyAt: aSymbol ifAbsent: [nil]

    "Created: / 16-08-2011 / 15:26:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 18-08-2011 / 21:03:01 / cg"

!

propertyAt: aSymbol ifAbsent: aBlock

    properties isNil ifTrue: [^aBlock value].

    ^properties at: aSymbol ifAbsent:aBlock.

    "Created: / 16-08-2011 / 15:27:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

propertyAt: aSymbol put: anObject

    properties isNil ifTrue: [properties := Dictionary new].

    properties at: aSymbol put: anObject.

    "Created: / 16-08-2011 / 15:28:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

result

    ^ result

!

result:aSymbol

    ((aSymbol ~= TestResult statePass) 

    and:[ aSymbol ~= TestResult stateFail 

    and:[ aSymbol ~= TestResult stateError

    and:[ aSymbol ~= TestResult stateSkip ]]]) ifTrue:[

        self error:'invalid result'.

    ].

    result := aSymbol.

    "Modified: / 20-08-2011 / 12:52:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selector

    ^testCase selector

    "Created: / 16-08-2011 / 15:38:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

startTime

    ^self propertyAt: #startTime

    "Modified: / 16-08-2011 / 15:29:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

startTime: anObject

    ^self propertyAt: #startTime put: anObject

    "Modified: / 16-08-2011 / 15:29:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

testCase

    ^ testCase

!

testCase:something

    testCase := something.

! !

!TestCaseOutcome methodsFor:'comparing'!

= anotherOutcome

    ^(anotherOutcome isKindOf: self class) 

        and:[self testCase class == anotherOutcome testCase class

            and:[self testCase selector == anotherOutcome testCase selector]].

    "Created: / 20-08-2011 / 14:24:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

hash

    ^testCase hash bitXor: result hash

    "Created: / 20-08-2011 / 14:23:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome methodsFor:'printing & storing'!

printOn:aStream

    "append a printed representation if the receiver to the argument, aStream"

    super printOn:aStream.

    aStream nextPut:$(.

    testCase printOn: aStream.

    aStream nextPut:$).

    "Modified: / 17-07-2013 / 17:59:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome methodsFor:'remembering'!

remember

    ^TestCaseOutcome rememberOutcome: self.

    "Created: / 20-08-2011 / 12:45:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 14-07-2014 / 21:35:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestCaseOutcome class methodsFor:'documentation'!

version_CVS

    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCaseOutcome.st,v 1.6 2014-04-16 22:06:04 cg Exp $'

! !

TestCaseOutcome initialize!