compiler/tests/extras/PPCSetUpBeforeTearDownAfterResource.st
changeset 515 b5316ef15274
child 516 3b81c9e53352
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/compiler/tests/extras/PPCSetUpBeforeTearDownAfterResource.st	Mon Aug 17 12:13:16 2015 +0100
@@ -0,0 +1,125 @@
+"{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }"
+
+"{ NameSpace: Smalltalk }"
+
+TestResource subclass:#PPCSetUpBeforeTearDownAfterResource
+	instanceVariableNames:''
+	classVariableNames:'CachedResources'
+	poolDictionaries:''
+	category:'PetitCompiler-Extras-Tests-Support'
+!
+
+PPCSetUpBeforeTearDownAfterResource class instanceVariableNames:'testCaseClass'
+
+"
+ The following class instance variables are inherited by this class:
+
+	TestResource - current
+	TestAsserter - 
+	Object - 
+"
+!
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'initialization'!
+
+initialize
+    "Invoked at system start or when the class is dynamically loaded."
+
+    CachedResources := Dictionary new
+
+    "Modified: / 30-07-2015 / 07:47:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'accessing'!
+
+testCaseClass
+    ^ testCaseClass
+
+    "Created: / 29-07-2015 / 16:19:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testCaseClass: aClass
+    testCaseClass := aClass
+
+    "Created: / 29-07-2015 / 16:19:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource 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 == PPCSetUpBeforeTearDownAfterResource.
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'running'!
+
+availableFor: aTestAsserter
+        aTestAsserter
+                assert: self isAvailable
+                description: 'Unavailable resource ', PPCSetUpBeforeTearDownAfterResource name ,' for: ', testCaseClass name , ' requested by ', aTestAsserter printString.
+
+    "Created: / 29-07-2015 / 16:42:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource class methodsFor:'subclass creation'!
+
+for: aClass
+    ^ CachedResources at: aClass ifAbsentPut:[
+        | resourceMeta resourceClass |
+
+        ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
+            resourceMeta := Metaclass new.
+            resourceMeta setSuperclass: self class.
+            resourceMeta instSize: self class instSize.  
+            resourceClass := resourceMeta new.
+            resourceClass setSuperclass: self.
+            resourceClass instSize: self instSize.  
+        ] ifFalse:[
+            " Assumes Pharo 5.0"
+            resourceMeta := Metaclass new.
+            resourceMeta
+                superclass: self class
+                withLayoutType: FixedLayout
+                slots: #().
+            resourceClass := resourceMeta new.
+            resourceClass superclass: self 
+                withLayoutType: FixedLayout
+                slots: #().			
+        ].
+        resourceClass testCaseClass: aClass.
+        resourceClass
+    ]
+
+    "Created: / 29-07-2015 / 16:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified (format): / 30-07-2015 / 07:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!PPCSetUpBeforeTearDownAfterResource methodsFor:'setup & teardown'!
+
+setUp
+    | testCaseClass |
+
+    testCaseClass := self class testCaseClass.
+    (testCaseClass lookupSelector: #setUpBefore) notNil ifTrue:[ 
+        testCaseClass new setUpBefore.
+    ].
+
+    "Created: / 29-07-2015 / 16:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+tearDown
+    | testCaseClass |
+
+    testCaseClass := self class testCaseClass.
+    (testCaseClass lookupSelector: #tearDownAfter) notNil ifTrue:[ 
+        testCaseClass new tearDownAfter
+    ].
+
+    "Created: / 29-07-2015 / 16:33:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+
+PPCSetUpBeforeTearDownAfterResource initialize!