|
1 "{ Package: 'stx:goodies/petitparser/compiler/tests/extras' }" |
|
2 |
|
3 "{ NameSpace: Smalltalk }" |
|
4 |
|
5 TestResource subclass:#PPCSetUpBeforeTearDownAfterResource |
|
6 instanceVariableNames:'' |
|
7 classVariableNames:'CachedResources' |
|
8 poolDictionaries:'' |
|
9 category:'PetitCompiler-Extras-Tests-Support' |
|
10 ! |
|
11 |
|
12 PPCSetUpBeforeTearDownAfterResource class instanceVariableNames:'testCaseClass' |
|
13 |
|
14 " |
|
15 The following class instance variables are inherited by this class: |
|
16 |
|
17 TestResource - current |
|
18 TestAsserter - |
|
19 Object - |
|
20 " |
|
21 ! |
|
22 |
|
23 !PPCSetUpBeforeTearDownAfterResource class methodsFor:'initialization'! |
|
24 |
|
25 initialize |
|
26 "Invoked at system start or when the class is dynamically loaded." |
|
27 |
|
28 CachedResources := Dictionary new |
|
29 |
|
30 "Modified: / 30-07-2015 / 07:47:41 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
31 ! ! |
|
32 |
|
33 !PPCSetUpBeforeTearDownAfterResource class methodsFor:'accessing'! |
|
34 |
|
35 testCaseClass |
|
36 ^ testCaseClass |
|
37 |
|
38 "Created: / 29-07-2015 / 16:19:23 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
39 ! |
|
40 |
|
41 testCaseClass: aClass |
|
42 testCaseClass := aClass |
|
43 |
|
44 "Created: / 29-07-2015 / 16:19:36 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
45 ! ! |
|
46 |
|
47 !PPCSetUpBeforeTearDownAfterResource class methodsFor:'queries'! |
|
48 |
|
49 isAbstract |
|
50 "Return if this class is an abstract class. |
|
51 True is returned here for myself only; false for subclasses. |
|
52 Abstract subclasses must redefine again." |
|
53 |
|
54 ^ self == PPCSetUpBeforeTearDownAfterResource. |
|
55 ! ! |
|
56 |
|
57 !PPCSetUpBeforeTearDownAfterResource class methodsFor:'running'! |
|
58 |
|
59 availableFor: aTestAsserter |
|
60 aTestAsserter |
|
61 assert: self isAvailable |
|
62 description: 'Unavailable resource ', PPCSetUpBeforeTearDownAfterResource name ,' for: ', testCaseClass name , ' requested by ', aTestAsserter printString. |
|
63 |
|
64 "Created: / 29-07-2015 / 16:42:37 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
65 ! ! |
|
66 |
|
67 !PPCSetUpBeforeTearDownAfterResource class methodsFor:'subclass creation'! |
|
68 |
|
69 for: aClass |
|
70 ^ CachedResources at: aClass ifAbsentPut:[ |
|
71 | resourceMeta resourceClass | |
|
72 |
|
73 ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[ |
|
74 resourceMeta := Metaclass new. |
|
75 resourceMeta setSuperclass: self class. |
|
76 resourceMeta instSize: self class instSize. |
|
77 resourceClass := resourceMeta new. |
|
78 resourceClass setSuperclass: self. |
|
79 resourceClass instSize: self instSize. |
|
80 ] ifFalse:[ |
|
81 " Assumes Pharo 5.0" |
|
82 resourceMeta := Metaclass new. |
|
83 resourceMeta |
|
84 superclass: self class |
|
85 withLayoutType: FixedLayout |
|
86 slots: #(). |
|
87 resourceClass := resourceMeta new. |
|
88 resourceClass superclass: self |
|
89 withLayoutType: FixedLayout |
|
90 slots: #(). |
|
91 ]. |
|
92 resourceClass testCaseClass: aClass. |
|
93 resourceClass |
|
94 ] |
|
95 |
|
96 "Created: / 29-07-2015 / 16:17:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
97 "Modified (format): / 30-07-2015 / 07:48:30 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
98 ! ! |
|
99 |
|
100 !PPCSetUpBeforeTearDownAfterResource methodsFor:'setup & teardown'! |
|
101 |
|
102 setUp |
|
103 | testCaseClass | |
|
104 |
|
105 testCaseClass := self class testCaseClass. |
|
106 (testCaseClass lookupSelector: #setUpBefore) notNil ifTrue:[ |
|
107 testCaseClass new setUpBefore. |
|
108 ]. |
|
109 |
|
110 "Created: / 29-07-2015 / 16:33:19 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
111 ! |
|
112 |
|
113 tearDown |
|
114 | testCaseClass | |
|
115 |
|
116 testCaseClass := self class testCaseClass. |
|
117 (testCaseClass lookupSelector: #tearDownAfter) notNil ifTrue:[ |
|
118 testCaseClass new tearDownAfter |
|
119 ]. |
|
120 |
|
121 "Created: / 29-07-2015 / 16:33:34 / Jan Vrany <jan.vrany@fit.cvut.cz>" |
|
122 ! ! |
|
123 |
|
124 |
|
125 PPCSetUpBeforeTearDownAfterResource initialize! |