RegressionTests__ClassAndMethodCompilingTestCase.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Wed, 29 Jun 2016 21:40:53 +0100
branchjv
changeset 1499 26a16a04219b
parent 1286 caf550ad0254
child 1500 d406a10b2965
permissions -rw-r--r--
Package renamed from exept:regression to stx:goodies/regression. Hooray!

"{ Encoding: utf8 }"

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

"{ NameSpace: RegressionTests }"

TestCase subclass:#ClassAndMethodCompilingTestCase
	instanceVariableNames:'classes'
	classVariableNames:''
	poolDictionaries:''
	category:'tests-Regression-Abstract'
!

!ClassAndMethodCompilingTestCase class methodsFor:'documentation'!

documentation
"
    An abstract superclass for all tests that create classes and/or methods.
    Implementation of #setUp & #tearDown removes any class or method created during
    the test.

    [author:]
        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"
! !

!ClassAndMethodCompilingTestCase class methodsFor:'queries'!

isAbstract
    "Return if this class is an abstract class.
     True is returned here for myself only; false for subclasses.
     Abstract subclasses must redefine again."

    ^ self == RegressionTests::ClassAndMethodCompilingTestCase.
! !

!ClassAndMethodCompilingTestCase methodsFor:'change & update'!

update: aspect with: param from: sender
    aspect == #newClass ifTrue:[
        "remember the classes to be deleted on #tearDown"
        classes add: param.
    ].

    "Created: / 20-11-2012 / 14:47:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!ClassAndMethodCompilingTestCase methodsFor:'running'!

setUp
    Smalltalk addDependent: self.
    classes := Set new.

    "Created: / 20-11-2012 / 14:46:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

tearDown
    | removeBlock|

    Smalltalk removeDependent: self.
    removeBlock := [:cls|
        | name realcls |

        name := cls name.
        (name startsWith: 'Mock') ifFalse:[
            "/ Just to make sure no system class is removed, all test classes should 
            "/ begin with 'Mock'.
            self breakPoint:#jv.  
            self breakPoint:#cg.
        ].
        realcls := Smalltalk at: name.
        realcls notNil ifTrue:[
            Smalltalk removeClass: realcls.
        ].
    ].
    classes select:[:each| each isPrivate] thenDo:removeBlock.
    classes select:[:each| each isNameSpace not and:[each isPrivate not]] thenDo:removeBlock.
    classes select:[:each| each isNameSpace] thenDo:removeBlock.

    "Created: / 20-11-2012 / 14:46:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 13-05-2014 / 11:13:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!ClassAndMethodCompilingTestCase class methodsFor:'documentation'!

version
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !