RegressionTests__ClassAndMethodCompilingTestCase.st
changeset 1127 3c7db84897fb
child 1283 bb15790e8cdc
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/RegressionTests__ClassAndMethodCompilingTestCase.st	Tue May 13 12:28:52 2014 +0200
@@ -0,0 +1,99 @@
+"{ Package: 'exept: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:[
+        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
+    | ns |
+
+    Smalltalk removeDependent: self.
+    classes do:[:cls|
+        | name realcls |
+
+        name := cls name.
+        (name startsWith: 'Mock') ifFalse:[
+            "/ Just to make sure no system class is remove, all test classes should 
+            "/ begin with 'Mock'.
+            self breakPoint:#jv.  
+            self breakPoint:#cg.
+        ].
+        realcls := Smalltalk at: name.
+        Smalltalk removeClass: realcls.
+    ].
+
+    #(Mocks Mocks2 Mocks3) do:[:nsName|
+        (ns := Smalltalk at:nsName) notNil ifTrue:[
+            Smalltalk removeClass: ns
+        ].
+    ].
+
+    "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$'
+! !
+