forked from newspeaklanguage/newspeak
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Minitest.ns
935 lines (865 loc) · 48.5 KB
/
Minitest.ns
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
Newspeak3
'Root'
class Minitest usingPlatform: platform = (
(* Minitest is the unit testing framework of Newspeak.
Users familiar with SUnit should note that Minitest is not an SUnit port or clone, but rather a complete redesign that revises the core structures and mechanisms to simplify test definitions and to make use of language facilities unique to Newspeak.
CORE CLASSES
Most of the classes defined by this module are internal to its implementation and are not intended to be subclassed or directly instantiated by the framework users. SUnit users, note: this includes the class named TestCase! The only class the typical test writer imports and subclasses is TestContext. A developer working on IDE tools may also need access to TestCatalog and Tester.
BASIC TESTS
Defining tests begins with defining the test module--a top-level class to hold everything else. As the arguments, the factory of a test module typically takes an instance of the Newspeak platform, an instance of the Minitest module, and the factory or factories that create the tested object(s).
class ListTesting usingPlatform: platform minitest: minitest listClass: listClass = (
|
private TestContext = minitest TestContext.
private List = listClass.
|
...
The actual tests are defined as methods of a test context, a subclass of TestContext nested inside the test module.
( * nested inside MyCollectionsTest * )
class ListTests = TestContext (
| list = List new. |
) (
public testAddition = (
list add: 1.
assert: (list includes: 1)
)
public testRemoval = (
list add: 1; remove: 1.
deny: (list includes: 1)
)
) : (
TEST_CONTEXT = ()
)
This test context defines two test methods, recognized as such because they begin with the word 'test'. To run each of those, the framework will create a fresh instance of the ListTests class and send it the message required to invoke the method. A separate instance is created to run each of the test methods in a test context, so the List used by testRemoval is different from the one used by testAddition.
Note the empty class-side method named TEST_CONTEXT. This is what makes the test framework recognize this class as a test context and scan it for test methods. Eventually, when Newspeak supports it, class metadata will be used instead to mark classes as test contexts.
This important point is worth reiterating. A class is a test context if and only if it contains a class-side method named TEST_CONTEXT. Inheriting from TestContext by itself does NOT make a class a test context, it only provides it with behavior such as the various #assert:... messages useful in test methods. Being a test context means that the class is scanned for test methods by the framework, and instantiated to run each of those methods.
SHARED STATE
Each test method of a test context runs within a context instance created and initialized specifically to run that method. In cases when tests need access to information which is too expensive to create for each individual test, such as a group of Newspeak modules or a database session, it is possible to share the information between the tests. To do that, we introduce a _shared state class_ between the module and the test context, as in the following nesting diagram:
CompilerTests (top level)
CompilerHolder (holds onto a compiler instance; not marked a test context)
StatementsTests (a test context)
In this example, StatementsTests is a test context class with a number of test methods, all of which require a compiler instance to test. Assuming that creating a compiler is expensive, we instead nest the test context in a class called CompilerHolder, defined something like
class CompilerHolder = (
| compiler = Compiler configuredInAParticularWay.
...
We assume that 'Compiler' is a name appropriately bound by the CompilerTests module. The CompilerHolder class is not marked as a test context, and does not require any particular behavior other than supporting the #new factory message.
The CompilerHolder class is instantiated only once before running all the tests of the CompilerTests module. The StatementsTests class of the CompilerHolder instance is repeatedly instantiated for each test it defines. Each instance of StatementsTests sees the 'compiler' slot of its enclosing object, which allows all of the tests defined in StatementsTests to use the same compiler instance.
More precisely, the behavior in the general case is this. To detect and run tests, the test framework recursively traverses class declarations starting from that of the top-level module and stopping at classes marked as test contexts. Classes nested inside a test context, if any, are ignored. In the resulting tree, the framework considers three distinct parts. The root of the tree is the class of the top-level test module instance (which already exists). The leaves of the tree are test context classes. Any nodes between the root and the leaves are shared state classes. Instances of shared state classes are created once before running the entire batch of tests defined in all test contexts of the module. Instances of test contexts are created multiple times, once for each test method of a context.
RUNNING IT: TEST CONFIGURATIONS
Like any Newspeak module, a test module expects the platform and other necessary information to be provided at the time an instance is created. That information includes the factory such as a class object, that will create the actual instances to test. At different times it may make sense to instantiate a module with different sets of parameters, for example to test different versions of a class or different classes implementing the same interface. Any such specific configuration of a test module is captured as a _test configuration_ class.
A test configuration is defined as a top-level class, similar to an application configuration. The test configuration class always has #packageTestsUsing: as its factory method. Like an application configuration, a test configuration is supplied with a manifest that provides access to all top-level modules it will need. Also like an application configuration, a test configuration is expected to capture in its private slots ('import') references to any modules it will eventually instantiate. For example, a configuration for the ListTesting module above may look something like
class ListTestingConfiguration using: manifest = (
|
private ListTesting = manifest ListTesting.
private LinkedList = manifest Collections LinkedList.
|
...
A configuration class should implement one instance-side method named testModulesUsingPlatform:minitest:. The method should instantiate and return a collection of configured test modules (in our example, only one).
public testModulesUsingPlatform: platform minitest: minitest = (
^{ListTesting usingPlatform: platform minitest: minitest listClass: LinkedList}
If the Collections module includes other implementors of the List interface, the example can be extended to use multiple instances of ListTesting to test other implementors. For example, provided there is a collection class named ArrayList in Collections and it has been 'imported' into a slot of ListTestingConfiguration, we could rewrite the method to test both implementations:
testModulesUsingPlatform: platform minitest: minitest = (
^{
ListTesting usingPlatform: platform minitest: minitest listClass: LinkedList.
ListTesting usingPlatform: platform minitest: minitest listClass: ArrayList.
}
Alternatively, we may define a separate test configuration to test ArrayList.
REEDUCATION FOR SUNIT USERS
The following is a comparison of the key differences between the traditional SUnit API and the goodthinkful way of doing the same thing.
TestCase vs TestContext
In SUnit, tests are defined as methods of a subclass of TestCase, while in Minitest TestContext takes it place. This is not a simple renaming. SUnit's TestCase suffers from a split personality. It is both a test fixture, which is a particular configuration of tested object on which a set of tests can be performed, and a command to run one of those tests. It is also another thing that we will eventually get to. The author believes this confusion, repeated in SUnit clones for other languages, leads to increased complexity and inconsistencies in terms and concepts (for example, by defining 'a TestCase' in SUnit, we in fact define many test cases). In contrast, Minitest assigns these responsibilities to separate classes, which are TestContext and TestCase. A test context defines a configuration of tested objects and the actual tests, while a TestCase is a command object for running a particular test of a test context. Minitests's TestCase is internal to the framework implementation and not normally exposed to the framework users.
The role of TestCase/TestContext as a superclass
Because of the merging of two independent concepts in SUnit's TestCase, the TestCase class in SUnit must be a superclass of a user-defined set of tests. In Minitest, a test context is recognized as a class marked as such (currently with a marker method, eventually in the class's metadata). A test context class usually inherits from TestContext, however that is not required by the framework. The only reason for this inheritance is to allow the use in test methods of the various #assert: methods defined by TestContext. A test context class is free not to inherit from TestContext, as long as it has some other way to signal the TestFailureException in case of a test failure. (This is why this text usually refers to a Minitest test context as 'a test context' rather than 'a TestContext').
The #setUp method vs instance initializer
In SUnit, any necessary initialization of a TestCase subclass is performed by the #setUp method. In Minitest, instances of text contexts are initialized (naturally) by their initializers. Again, the reason for this difference is the split personality of SUnit's TestCase, leading to what in essense are multiple initialization schemes for those personalities.
The #tearDown method vs the #cleanUp method
A test context (or a shared class instance) can define any necessary clean up behavior as a method named #cleanUp. A similar method in SUnit is named #tearDown. Minitest makes this API change because of the necessary change to the other half of lifecycle management (#setUp vs instance initializer), and also because the author believes cleanUp is a more natural name, which is now free of danger of being confused with setUp.
TestResources vs shared state classes
SUnit provides test resources as a mechanism to share expensive to create objects between a batch of test cases. Minitest does that using enclosing shared state classes. There is no dedicated TestResource class in Minitest because the framework expects nothing from the shared state class API other than the ability to create an instance using #new. At the same time, the framework takes care of creating and cleaning up their instances, so the test programmer is free from concerns of maintaining resource instances and managing their lifecycle. Shared state is naturally accessible to all tests that require it a part of the lexical scope. Lexical containment also naturally specifies which tests require which resources, without the fragility and obscurity of the various #resources methods of SUnit.
TestCases vs test configurations
A TestCase subclass in SUnit is a concrete runnable test artifact (in the sense that we can select one in a UI tool and run its tests). In Minitest, a test module with any tests it contains is only an abstract declaration. It needs a test configuration to instantiate it with a specific set of parameters. Test configuration is the third personality of SUnit's TestCase separated into an independent class in Minitest. More about this in the next section.
TestCase subclassing vs parameterizable tests
SUnit supports further subclassing of TestCase subclasses. For example, tests for a widget library can define, say, WidgetTestCase with LabelTestCase and ButtonTestCase as subclasses. WidgetTestCase is an abstract class defining tests of the API common to all widgets, while ButtonTestCase specializes it with tests specific to buttons. It also defines the concrete class tests inherited from WidgetTestCase apply to. Running ButtonTestCase is supposed to run both the tests defined locally as well as those inherited from WidgetTestCase.
Minitest does not--and more importantly, does not need to--support test context inheritance to accomplish what is described above. More precisely, any class in a test module is free to inherit from any other class, be it a test context or not. However, if a test context class inherits from another test context class, only test methods defined locally in that particular class are recognized and executed by the framework. This is not a limitation, but rather the test parameterization story made straight. Let's begin with an example of the Minitest way of organizing the tests described above.
We define 3 test modules with the following factory signatures:
WidgetTesting usingPlatform: platform minitest: minitest widgetClass: aClass
LabelTesting usingPlatform: platform minitest: minitest labelClass: aClass
ButtonTesting usingPlatform: platform minitest: minitest buttonClass: aClass
Each would have at least one test context class with all the appropriate tests. We also define two configuration classes, LabelTestConfiguration and ButtonTestConfiguration. As an example, LabelTestConfiguration would import the Label class from the widget library and define this method:
testModulesUsingPlatform: platform minitest: minitest = (
^{
WidgetTesting usingPlatform: platform minitest: minitest widgetClass: Label.
LabelTesting usingPlatform: platform minitest: minitest labelClass: Label.
}
Here is why this approach is cleaner. Remember the point from the discussion of TestCases and test configurations above. The third overloaded responsibility of TestCase in SUnit is test configuration. A LabelTestCase needs to inherit from WidgetTestCase so that the tests of the Widget interface defined in that abstract class can be applied to a concrete implementation (Label). The Minitest example uses the fact test definition is parameterizable by test configuration to organize the code around this pattern:
1. A module does not hardcode the actual implementation class it tests, instead expecting a _factory_ (in this case a class metaobject) that can manufacture instances to test on request.
2. All tests in a module are written to test a particular _interface_. Different interfaces should be tested by different modules.
3. A test configuration is what chooses a particular _implementation class_ to test. The configuration creates test modules for all interfaces the class implements, parameterized with the class being tested.
This pattern is the recommended way to organize tests using Minitest. You can see that the ListTesting and ListTestingConfiguration follow a similar idea. ListTesting defines tests of the List interface, while the configuration applies it to two concrete implementation classes.
LICENSE
Copyright (c) 2010 Vassili Bykov
Copyright (c) 2012 Cadence Design Systems, Inc.
Licensed under the MIT license:
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
files (the ''Software''), to deal in the Software without
restriction, including without limitation the rights to use,
copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following
conditions:
The above copyright notice and this permission notice shall be
included in all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED ''AS IS'', WITHOUT WARRANTY OF ANY KIND,
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
OTHER DEALINGS IN THE SOFTWARE. *)
|
private Exception = platform kernel Exception.
private UnhandledError = platform kernel UnhandledError.
private Map = platform collections Map.
private IdentityMap = platform collections IdentityMap.
private IdentitySet = platform collections IdentitySet.
private List = platform collections List.
private Set = platform collections Set.
private Promise = platform actors Promise.
private ObjectMirror = platform mirrors ObjectMirror.
private Message = platform kernel Message.
|) (
class TestCase environment: testEnvironment <TestEnvironment> selector: s <Symbol> = (
(* Represents a particular test (a method with the selector that begins with 'test') in a text context. This class, unlike SUnit's class by the same name, is internal to the framework and is not intended to be subclassed or instantiated by framework users. See TestContext.
An instance holds onto a test environment (which indirectly identifies the test context class) and a selector within the class. While a test is running, an instance also holds onto the test context's instance created to run the test. That instance is created prior to running the test. If the test is successful, the instance is immediately discarded. In case of a failure or an error, the instance is retained so that its state can be examined. *)
|
public environment <TestEnvironment> = testEnvironment.
public selector <Symbol> = s.
testContextInstance <TestContext>
|) (
public cleanUp = (
(* Clean up and forget the test context instance. This method runs within an exception handler established by the runUsing: method, so any errors in test context instance cleanup are ok. *)
testContextInstance isNil ifFalse:
[testContextInstance cleanUp.
testContextInstance:: nil]
)
instantiateTestContextUsing: tester <Tester> = (
testContextInstance:: environment createInstanceIn: (tester instanceFor: environment parent)
)
public printOn: stream <WriteStream> = (
super printOn: stream.
stream nextPutAll: ' ('.
environment printOn: stream.
stream nextPutAll: ' '.
selector printOn: stream.
stream nextPutAll: ')'.
)
public runToDebugFailureUsing: tester <Tester> ^<TestResult> = (
instantiateTestContextUsing: tester.
[sendTestMessage]
ensure: [cleanUp]
)
public runUsing: tester <Tester> ^<TestResult> = (
^[self runUnsafeUsing: tester]
on: Error
do: [:ex | ^nil = testContextInstance
ifTrue: [TestError case: self exception: ex]
ifFalse: [testContextInstance createErrorResultFor: self exception: ex]]
)
sendTestMessage = (
^(Message selector: selector arguments: {})
sendTo: testContextInstance
)
public isKindOfTestCase ^ <Boolean> = (
^true
)
public runUnsafeUsing: tester <Tester> ^<TestResult> = (
| testSuccess |
instantiateTestContextUsing: tester.
[sendTestMessage.
(* At this point the test has been successful, so create the TestSuccess before it is removed. *)
testSuccess:: testContextInstance createSuccessResultFor: self.
(* Clean up immediately after a successful test. This makes the test context instance
immediately garbage-collectable, which is an important property for large test suites. *)
cleanUp]
on: TestFailureException
do: [:ex | ^nil = testContextInstance (* testContextInstance should never be nil at this point, but just in case. *)
ifTrue: [TestFailure case: self description: ex messageText]
ifFalse: [testContextInstance createFailureResultFor: self description: ex messageText]].
^testSuccess
)
public runAsyncUsing: tester <Tester> ^<Promise[TestResult]> = (
instantiateTestContextUsing: tester.
^Promise
when: [self sendTestMessage] <-: value
fulfilled:
[:resolution |
(* At this point the test has been successful, so create the TestSuccess before it is removed. *)
| testSuccess = testContextInstance createSuccessResultFor: self. |
(* Clean up immediately after a successful test. This makes the test context instance
immediately garbage-collectable, which is an important property for large test suites. *)
cleanUp.
testSuccess]
broken:
[:problem |
problem isKindOfTestFailureException ifTrue: [
nil = testContextInstance
ifTrue: [TestFailure case: self description: problem messageText]
ifFalse: [testContextInstance createFailureResultFor: self description: problem messageText].
] ifFalse: [
nil = testContextInstance
ifTrue: [TestError case: self exception: problem]
ifFalse: [testContextInstance createErrorResultFor: self exception: problem]]]
)
) : (
)
public class TestCatalog forModule: testModule = (
(* A catalog of test suites defined by a given test module instance. A catalog is created using the primary forModule: factory method. Each of test context classes of the module produces a TestSuite that lists all test methods in the class. The catalog can report the names of all test context classes, and return a TestSuite corresponding to each class. It can also return a TestSuite with the union of all the class-level TestSuites. *)
|
testModule <Object> = testModule.
testsByContextName <Map[String, TestSuite]> = Map new.
|Initializer new populate) (
class Initializer = (
(* An initializer populates the enclosing catalog with content extracted from the test module. This class is internal to the TestCatalog implementation. *)
) (
examineClass: mirror <ClassDeclarationMirror> under: parentEnvironment <TestEnvironment> = (
(* Examine the given class. If it is a test context, create a test suite listing its test cases and add it to the catalog. *)
| thisEnvironment |
thisEnvironment:: TestEnvironment parent: parentEnvironment classDeclarationMirror: mirror.
(isTestContext: mirror) ifTrue:
[thisEnvironment testCases: (testCasesIn: mirror environment: thisEnvironment).
parentEnvironment addNestedEnvironment: thisEnvironment.
(* Nested test contexts do not appear to be useful, so once a test context is found
we do not look inside it. The framework's own tests rely on this. *)
^self].
mirror instanceSide nestedClasses do:
[:each |
examineClass: each under: thisEnvironment].
(* If after all the examination thisEnvironment ends up with no test cases, or child
environments containing test cases, its class need not to be instantiated at runtime.
In that case we can forget it right here - no need to add it to the parent. *)
thisEnvironment hasTestCasesTransitively ifTrue:
[parentEnvironment addNestedEnvironment: thisEnvironment]
)
isTestContext: mirror <ClassDeclarationMirror> = (
^mirror classSide methods includesMirrorNamed: testContextMarkerSelector
)
isTestMethod: methodMirror <MethodMirror> = (
| selector |
selector:: methodMirror name.
^(selector startsWith: 'test') and: [(selector endsWith: ':') not]
)
public populate = (
(* Populate the testsByContextName dictionary of the enclosing TestCatalog instance with information extracted from the module. *)
| moduleMirror moduleEnvironment |
moduleEnvironment:: TopLevelTestEnvironment module: testModule.
moduleMirror:: (ObjectMirror reflecting: testModule) getClass.
moduleMirror nestedClasses do:
[:each | examineClass: each under: moduleEnvironment].
moduleEnvironment withAllNestedEnvironmentsDo:
[:each |
each hasTestCases ifTrue:
[testsByContextName at: each name put: each testSuite]]
)
testCasesIn: classMirror <ClassDeclarationMirror> environment: environment <TestEnvironment> ^<Collection[TestCase]> = (
(* Return a collection of TestCases describing test methods in the given class. *)
| testCases |
testCases:: List new.
classMirror instanceSide methods do:
[:each <MethodMirror> |
(isTestMethod: each) ifTrue:
[testCases add:
(TestCase environment: environment selector: each name)]].
^testCases
)
testContextMarkerSelector = (
(* A class that has a class-side method with this selector is recognized by the Initializer as a test context class. (The class's superclass chain is unimportant--test contexts inherit from TestContext only in order to get testing behavior such as the #assert: method). *)
^#TEST_CONTEXT
)
) : (
)
public allTests ^<TestSuite> = (
(* Returns a test suite containing all test cases defined in all test context classes of the catalogued module. *)
| allTestCases |
allTestCases:: List new: testsByContextName size + 1 * 20.
testsByContextName do: [:each | allTestCases addAll: each testCases].
^TestSuite testCases: allTestCases
)
public testSuiteNamed: key <String> = (
(* Returns a test suite containing all test cases of the given class. *)
^testsByContextName at: key
)
public testSuiteNames ^<Collection[String]> = (
(* Returns the (short) names of test context classes of the module. *)
^testsByContextName keys
)
) : (
)
public class TestContext = (
(* An object for defining and running individual tests. In this respect, it is the same thing as the TestCase class of the traditional SUnit framework. Unlike SUnit's TestCase, an instance does not double as a command for running a particular test method.
This class provides the behavior useful for running tests, such as the various #assert: methods inheritable by the user's TestContext subclasses. Inheriting that behavior is the only real reason to inherit from TestContext. The test framework does NOT recognize the user's test contexts on the basis of their inheritance. Instead, each class to be treated as a test context should be marked as such. Currently, it is done with a class-side marker method named TEST_CONTEXT. In the future, marker methods will be superseded by proper class metadata.
An instance is initialized by its 'natural' initializer. If any special cleanup behavior is required after running a test, a subclass may reimplement the #cleanUp method to define it. *)
) (
assert: aBlockOrValue <[Boolean] | Boolean> = (
assert: aBlockOrValue description: 'Assertion failed'
)
assert: aBlockOrValue <[Boolean] | Boolean> description: messageText <String> = (
assert: aBlockOrValue descriptionBlock: [messageText]
)
assert: aBlockOrValue <[Boolean] | Boolean> descriptionBlock: messageBlock <[String]> = (
aBlockOrValue isKindOfClosure
ifTrue: [aBlockOrValue value ifFalse: [failWithMessage: messageBlock value]]
ifFalse: [aBlockOrValue ifFalse: [failWithMessage: messageBlock value]].
)
assert: anObject equals: expectedObject = (
(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
assert: anObject = expectedObject descriptionBlock:
['Equality assertion failed; expected: ',
expectedObject printString,
', was: ',
anObject printString]
)
assert: anObject equals: anotherObject description: messageText = (
(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
assert: anObject = anotherObject description: messageText
)
assert: anObject equals: anotherObject descriptionBlock: messageBlock = (
(* Succeed if anObject = anotherObject. Preferrable to a simple 'assert: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
assert: anObject = anotherObject descriptionBlock: messageBlock
)
assertList: actualList equals: expectedList = (
assert: actualList size = expectedList size descriptionBlock:
['List equality assertion failed; expected: ',
expectedList printString,
', was: ',
actualList printString].
1 to: actualList size do:
[:index | assert: (actualList at: index) equals: (expectedList at: index)].
)
public cleanUp = (
(* Sent after a successful completion of a test, to clean up if simple garbage collection at some point in the future is not enough (which it normally should be). If a test completes abnormally, with either a failure or an error, the test context is retained by the test case which in turn is retained by the test result. In this case, the message is not sent until a later time when the test results are discarded. *)
)
public createErrorResultFor: testCase <TestCase> exception: ex <Error> = (
^TestError case: testCase exception: ex
)
public createSuccessResultFor: testCase <TestCase> = (
^TestSuccess case: testCase
)
deny: aBlockOrBoolean <[Boolean] | Boolean> = (
deny: aBlockOrBoolean description: 'Denial failed'
)
deny: aBlockOrBoolean <[Boolean] | Boolean> description: messageText <String> = (
deny: aBlockOrBoolean descriptionBlock: [messageText]
)
deny: aBlockOrBoolean <[Boolean] | Boolean> descriptionBlock: messageBlock <[String]> = (
aBlockOrBoolean isKindOfClosure
ifTrue: [aBlockOrBoolean value ifTrue: [failWithMessage: messageBlock value]]
ifFalse: [aBlockOrBoolean ifTrue: [failWithMessage: messageBlock value]].
)
deny: anObject equals: expectedObject = (
(* Succeed if (anObject = anotherObject) not. Preferrable to a simple 'deny: [a = b]' in a test method because in case of a failure the values compared are available for inspection as this method's arguments. *)
deny: anObject = expectedObject descriptionBlock:
['Inequality assertion failed; expected not: ',
expectedObject printString,
', was: ',
anObject printString]
)
failWithMessage: messageText <String | nil> = (
TestFailureException new signal: messageText
)
should: aBlock signal: anException = (
should: aBlock signal: anException description: 'Expected exception not signalled'
)
should: aBlock signal: anException <Class | ExceptionSet> description: failureMessage <String> = (
should: aBlock signal: anException descriptionBlock: [failureMessage]
)
should: aBlock signal: anException <Class | ExceptionSet> descriptionBlock: descriptionBlock <[String]> = (
| signalled ::= false. |
[aBlock value]
on: anException
do: [:ex | signalled:: true].
signalled ifFalse: [failWithMessage: descriptionBlock value].
)
shouldnt: aBlock signal: anException = (
shouldnt: aBlock signal: anException description: 'Exception signalled'
)
shouldnt: aBlock signal: anException <Class | ExceptionSet> description: failureMessage <String> = (
shouldnt: aBlock signal: anException descriptionBlock: [failureMessage]
)
shouldnt: aBlock signal: anException <Class | ExceptionSet> descriptionBlock: descriptionBlock <[String]> = (
[aBlock value]
on: anException
do: [:ex | failWithMessage: descriptionBlock value]
)
public createFailureResultFor: testCase <TestCase> description: description <String> ^ <TestFailure> = (
^TestFailure case: testCase description: description
)
) : (
)
class TestEnvironment parent: parent classDeclarationMirror: mirror = (
(* Describes a class nested inside a test module. The class can be either a test context or a parent (direct or indirect) of at least one test context. Environments form a tree, with those that represent test contexts being the leaves. Environment are used by the framework to orchestrate the instantiation of their classes when running tests.
An instance holds onto the parent and a collection of child environments. The class accessor name is the selector of a message that can be sent to a class metaobject corresponding to the parent environment to obtain a class metaobject corresponding to this environment. For an environment representing a test context, testCases holds a collection (not a real TestSuite) of TestCases defined in the test context. *)
|
public parent <TestEnvironment | TopLevelTestEnvironment> = parent.
nestedEnvironments <Collection[TestEnvironment]> = List new.
public testCases <Collection[TestCase]> ::= List new.
public classDeclarationMirror <ClassDeclarationMirror> = mirror.
|) (
public addNestedEnvironment: environment = (
nestedEnvironments add: environment
)
classAccessorName = (
(* The class accessor name is the selector of a message that can be sent to a class metaobject corresponding to the parent environment to obtain a class metaobject corresponding to this environment. *)
^classDeclarationMirror simpleName
)
classIn: parentObject <Object> ^<Class> = (
(* Returns a class metaobject represented by this environment specific for the given instance of the class corresponding to this environment's parent. *)
^(Message selector: classAccessorName arguments: {})
sendTo: parentObject
)
public createInstanceIn: parentObject <Object> ^<Object> = (
(* Creates and returns an instance of the class represented by this environment. *)
^(classIn: parentObject) new
)
public hasTestCases ^<Boolean> = (
(* True if the class represented by this environment defines any test methods. *)
^testCases isEmpty not
)
public hasTestCasesTransitively ^<Boolean> = (
(* True if either the class represented by this environment or any of its nested classes define any test methods. *)
hasTestCases ifTrue: [^true].
nestedEnvironments do: [:any | any hasTestCasesTransitively ifTrue: [^true]].
^false
)
public isRoot ^<Boolean> = (
(* True if this is a top-level environment representing the entire test module. *)
^false
)
public name = (
^classAccessorName
)
public parentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with direct and indirect parents of this environment, starting with the direct one and proceeding up to the top level. *)
parent withAllParentEnvironmentsDo: aBlock
)
public printOn: stream <WriteStream> = (
super printOn: stream.
stream nextPutAll: ' '.
classAccessorName printOn: stream.
)
public testSuite = (
^TestSuite testCases: testCases
)
public withAllNestedEnvironmentsDo: aBlock = (
(* Evaluate aBlock with the receiver and all members of the transitive closure of its nested environments, in preorder. *)
aBlock value: self.
nestedEnvironments do: [:each | each withAllNestedEnvironmentsDo: aBlock]
)
public withAllParentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with the receiver and all environment in its parent chain all the way up to the top level, beginning with the receiver. *)
aBlock value: self.
parent withAllParentEnvironmentsDo: aBlock
)
) : (
)
public class TestError case: testCase exception: exception = TestResult case: testCase (
(* Represents a test case that didn't complete because an error was signaled and not handled while running the test case. The instance holds onto the exception instance representing the error. *)
|
public exception ::= exception.
|) (
public isError = (
^true
)
public isKindOfTestError ^ <Boolean> = (
^true
)
) : (
)
public class TestFailure case: testCase description: text <String> = TestResult case: testCase (
(* Represents a failed assertion in a test case. *)
|
public description ::= text.
|) (
public isFailure = (
^true
)
public isKindOfTestFailure ^ <Boolean> = (
^true
)
) : (
)
class TestFailureException = Exception (
(* An exception thrown when an assertion fails inside a test. The description of the failure is the exception's message text. *)
) (
public defaultAction = (
UnhandledError signalForException: self
)
public isKindOfTestFailureException ^ <Boolean> = (
^true
)
) : (
)
class TestResult case: testCase = (
(* The result of running a TestCase. An abstract class. *)
|
public testCase ::= testCase.
|) (
public cleanUp = (
testCase cleanUp
)
public isError ^<Boolean> = (
^false
)
public isFailure ^<Boolean> = (
^false
)
public isSuccess ^<Boolean> = (
^false
)
public isKindOfTestResult ^ <Boolean> = (
^true
)
) : (
)
public class TestSuccess case: testCase = TestResult case: testCase (
(* Represents a successful run of a test case. *)
) (
public isSuccess = (
^true
)
public isKindOfTestSuccess ^ <Boolean> = (
^true
)
) : (
)
public class TestSuite testCases: testCases <Collection[TestCase]> = (
(* A TestSuite is a collection of TestCases. TestSuites are usually obtained from a TestCatalog created on an instance of a test module. *)
|
private testCases_slot <Collection[TestCase]> = testCases.
|) (
+ another <TestSuite> ^<TestSuite> = (
(* Returns a new TestSuite that contains TestCases of the receiver and the argument. *)
^TestSuite testCases: testCases, another testCases
)
public ++ another <TestSuite> ^<TestSuite> = (
(* Returns a new TestSuite that contains TestCases of the receiver and the argument. *)
^TestSuite testCases: testCases, another testCases
)
modules ^<Collection[Object]> = (
(* Returns a collection of test module instances that contain test cases of the suite. *)
| result |
result:: IdentitySet new.
testCases do: [:each | result add: each module].
^result
)
public size ^<Integer> = (
(* Returns the number of test cases in the suite. *)
^testCases size
)
public testCases ^<Collection[TestCase]> = (
(* Returns a collection of test cases of the receiver. *)
^testCases_slot
)
) : (
)
public class Tester testSuite: suite <TestSuite> = (
(* A tool for executing TestCases. TestCases are supplied to it in the form of a TestSuite. An instance is single-use only. First it is created using the testSuite: primary factory method. Then the tests are executed, either by sending the #runAll message, or by reproducing the steps defined by #runAll in an external tool. Finally, the results can be retrieved from the 'errors', 'failures' and 'successes' slots. *)
|
public errors <List[TestError]>
public failures <List[TestFailure]>
public successes <List[TestSuccess]>
public disabled <Collection[TestCase]> = List new.
active_slot <Collection[TestCase]>
public inactive <Collection[TestCase]> = suite testCases copyFrom: 1 to: suite testCases size.
private testSuite <TestSuite> = suite.
public testCaseList
private testsPerformed_ <Integer>
private instanceManager <TestContextManager> = TestContextManager new.
|) (
class TestContextManager = (
(* Creates and keeps track of instances of shared state classes for a test run. Shared state classes are classes nested inside a test module that in turn contain other shared state classes and/or test context classes. In other words, they are the classes that are neither the root nor the leaves of the class nesting tree. Within this class, instances of these classes are referred to as 'core instances'. *)
|
instancesByEnvironment ::= IdentityMap new.
|) (
public cleanUpCoreInstances = (
(* Send the #cleanUp message to all core instances able to understand that message. *)
instancesByEnvironment do:
[:each |
(understandsCleanUp: each) ifTrue: [each cleanUp]].
instancesByEnvironment:: IdentityMap new.
)
public ensureInstanceFor: environment <TestEnvironment> ^<Object> = (
(* Return an instance of the class represented by the argument, creating one if necessary. *)
environment isRoot ifTrue: [^environment moduleInstance].
^instancesByEnvironment at: environment ifAbsent:
[| instance |
instance:: environment createInstanceIn: (ensureInstanceFor: environment parent).
instancesByEnvironment at: environment put: instance.
instance]
)
understandsCleanUp: object = (
(* Answer true if the object understands the #cleanUp message. *)
| mirror |
mirror:: (ObjectMirror reflecting: object) getClass.
^mirror methods includesMirrorNamed: #cleanUp
)
public createCoreInstancesForGroup: testCases <Collection[TestCase]> = (
(* Create instances of shared state classes required to run the argument testCase. See #createCoreInstances. *)
(coreEnvironmentsForGroup: testCases) do:
[:each |
ensureInstanceFor: each]
)
public createCoreInstances = (
(* Create instances of all shared state classes, which are the classes that are not test contexts themselves but rather contain test contexts directly or indirectly. Such classes are instantiated once before running a suite of tests and cleaned up afterwards. *)
coreEnvironments do:
[:each <TestEnvironment> |
ensureInstanceFor: each]
)
public createCoreInstancesFor: testCase <TestCase> = (
(* Create instances of shared state classes required to run the argument testCase. See #createCoreInstances. *)
(coreEnvironmentsFor: testCase) do:
[:each <TestEnvironment> |
ensureInstanceFor: each]
)
coreEnvironments ^ <Set[TestEnvironment]> = (
(* The core of the environment tree are the environments between the roots of the class tree and its fringe. They have to be instantiated once before running the suite and cleaned up after. *)
| result <Set[TestEnvironment]> |
result:: Set new.
testSuite testCases do:
[:each |
each environment parentEnvironmentsDo:
[:eachParent <TestEnvironment> |
eachParent isRoot ifFalse: [result add: eachParent]]].
^result
)
coreEnvironmentsForGroup: testCases <Collection[TestCase]> ^ <Set[TestEnvironment]> = (
(* The core of the environment tree are the environments between the roots of the class tree and its fringe. They have to be instantiated once before running the suite and cleaned up after. *)
| result <Set[TestEnvironment]> |
result:: Set new.
testCases do:
[:each |
each environment parentEnvironmentsDo:
[:eachParent <TestEnvironment> |
eachParent isRoot ifFalse: [result add: eachParent]]].
^result
)
coreEnvironmentsFor: testCase <TestCase> ^ <List[TestEnvironment]> = (
| result <List[TestEnvironment]> |
result:: List new.
testCase environment parentEnvironmentsDo:
[:each <TestEnvironment> |
each isRoot ifFalse: [result add: each]].
^result
)
) : (
)
public atEnd = (
(* Returns true if all test cases in the test suite have been executed. *)
^testsPerformed = testCount
)
public cleanUp = (
(* This message should be sent to the tester once at some point after finishing running the tests. This will cause the tester to send the #cleanUp message to all instances of shared state classes created to run the tests. Sending this message is not essential to the test framework functionality, but without sending it the cleanup logic of shared state classes will not be called. However, an IDE tool may choose to delay sending this message in case there are tests failures or errors, so that the shared state can be examined by the user. *)
instanceManager cleanUpCoreInstances.
)
public cleanUpResults = (
(* This message causes the #cleanUp message to be sent to all test results, which in turn clean ups their associated test cases, cleaning up and making garbage-collectable any test context instances they may still be holding onto. *)
successes do: [:each | each cleanUp].
errors do: [:each | each cleanUp].
failures do: [:each | each cleanUp]
)
public completedRatio ^<Float> = (
(* Return a number between 0 and 1 indicating the ratio of tests in the suite completed so far. *)
^testCount = 0
ifTrue: [1.0]
ifFalse: [testsPerformed asFloat / testCount]
)
public haveAllTestsSucceeded = (
^errors size = 0 and: [failures size = 0]
)
public instanceFor: environment <TestEnvironment> ^<Object> = (
^instanceManager ensureInstanceFor: environment
)
public runAll = (
prepare.
[[atEnd] whileFalse: [step]]
ensure: [cleanUp]
)
public runToDebugFailure: testCase = (
instanceManager createCoreInstancesFor: testCase.
[testCase runToDebugFailureUsing: self]
ensure: [cleanUp]
)
public runWithNoExceptionHandling: testCase = (
instanceManager createCoreInstancesFor: testCase.
[testCase runUnsafeUsing: self]
ensure: [cleanUp]
)
public testsPerformed ^ <Integer> = (
^testsPerformed_
)
public isEnabled: tc ^ <Boolean> = (
disabled detect: [:dt <testCase> | dt = tc] ifNone: [^true].
^false
)
disableTestCase: tc = (
0 = (disabled indexOf: tc)
ifTrue: [disabled add: tc]
ifFalse: [shouldNotHappen].
)
disableFailure: tf <TestFailure> = (
| tc <TestCase> = tf testCase. |
failures remove: tf ifAbsent: [].
disableTestCase: tc.
)
disableError: te <TestError> = (
| tc <TestCase> = te testCase. |
errors remove: te ifAbsent: [].
disableTestCase: tc.
)
disableSuccess: ts <TestSuccess> = (
| tc <TestCase> = ts testCase. |
successes remove: ts ifAbsent: [].
disableTestCase: tc.
)
computeInactiveTests ^ <Set[TestCase]> = (
^(Set withAll: testCaseList)
removeAll: (errors collect: [:tr <TestResult> | tr testCase]);
removeAll: (failures collect: [:tr <TestResult> | tr testCase]);
removeAll: (successes collect: [:tr <TestResult> | tr testCase]);
yourself
)
public peekSelector ^<Symbol> = (
(* Returns the selector of the upcoming test case. This message should only be sent if the #atEnd message returns false. *)
^(active at: testsPerformed_ + 1) selector
)
public testCount ^ <Integer> = (
^active size
)
public prepare = (
(* This message must be sent to the tester once prior to running any tests. At this stage the tester instantiates shared state classes of the test module, which may potentially cause errors to be signaled. *)
errors:: List new.
failures:: List new.
successes:: List new.
testCaseList:: testSuite testCases.
active_slot:: (Set withAll: testCaseList) removeAll: disabled; asArray.
testsPerformed_:: 0.
instanceManager createCoreInstances.
)
active ^ <Collection[TestCase]> = (
active_slot isNil ifTrue: [
active_slot:: (Set withAll: testCaseList) removeAll: disabled; asArray
].
^active_slot
)
public step ^<TestResult> = (
(* Execute one test case, add the result to the appropriate collection and return it. This message should only be sent if the #atEnd message returns false. *)
| case result |
case:: active at: testsPerformed_ + 1.
result:: case runUsing: self.
inactive remove: case ifAbsent: [].
testsPerformed_:: testsPerformed_ + 1.
result isError ifTrue: [errors add: result].
result isFailure ifTrue: [failures add: result].
result isSuccess ifTrue: [successes add: result].
^result
)
public stepAsync ^<TestResult> = (
(* Execute one test case, add the result to the appropriate collection and return it. This message should only be sent if the #atEnd message returns false. *)
| case |
case:: active at: testsPerformed_ + 1.
^Promise when: (case runAsyncUsing: self) fulfilled:
[:result |
inactive remove: case ifAbsent: [].
testsPerformed_:: testsPerformed_ + 1.
result isError ifTrue: [errors add: result].
result isFailure ifTrue: [failures add: result].
result isSuccess ifTrue: [successes add: result].
result]
)
public enable: tc <TestCase> = (
tc isKindOfTestCase ifTrue: [
(* only add tc to inactive if it's not already there *)
(inactive includes: tc) ifFalse: [
inactive add: tc.
disabled remove: tc ifAbsent: [Error signal: 'inconsistency in TestingOutcomeSubject>>enable:'].
^self
].
].
)
public run: testCase = (
| result <TestResult> |
instanceManager createCoreInstancesFor: testCase.
[
removeTestCase: testCase from: errors.
removeTestCase: testCase from: failures.
removeTestCase: testCase from: successes.
inactive remove: testCase ifAbsent: [].
result:: testCase runUsing: self.
result isError ifTrue: [errors add: result].
result isFailure ifTrue: [failures add: result].
result isSuccess ifTrue: [successes add: result].
] ensure: [cleanUp]
)
removeTestCase: tc <TestCase> from: resultList <List[TestResult]> = (
| tr <testResult> = resultList detect: [:r <TestResult> | r testCase selector = tc selector] ifNone: []. |
resultList remove: tr ifAbsent: [].
)
public disable: tc <TestCase | TestResult> = (
tc isKindOfTestFailure ifTrue: [^disableFailure: tc].
tc isKindOfTestError ifTrue: [^disableError: tc].
tc isKindOfTestCase ifTrue: [
(* only add tc to disabled if it's not already there *)
0 = (disabled indexOf: tc) ifTrue: [
disabled add: tc.
removeTestCase: tc from: errors.
removeTestCase: tc from: failures.
removeTestCase: tc from: successes.
inactive remove: tc ifAbsent: [Error signal: 'inconsistency in TestingOutcomeSubject>>disable:'].
^self
].
].
(* tc is a success; least likely to be disabled *)
disableSuccess: tc
)
) : (
testCatalogs: catalogs <Collection[TestCatalog]> = (
| suite ::= TestSuite testCases: List new. |
catalogs do: [:each | suite:: suite ++ each allTests].
^self testSuite: suite
)
public testModules: modules <Collection[TestModule]> = (
^testCatalogs: (modules collect: [:each | TestCatalog forModule: each])
)
)
class TopLevelTestEnvironment module: moduleInstance = (
(* A test environment representing a test module instance. Unlike regular TestEnvironments, it has no parents, but otherwise supports much of the same protocol. *)
|
public moduleInstance = moduleInstance.
nestedEnvironments = List new.
|) (
public addNestedEnvironment: environment = (
nestedEnvironments add: environment
)
public hasTestCases ^<Boolean> = (
(* A top-level test module instance cannot function as a test context because it cannot be created and discarded for each test run. *)
^false
)
public isRoot = (
^true
)
public parentEnvironmentsDo: aBlock = (
(* No-op since this is the top level. *)
)
public withAllNestedEnvironmentsDo: aBlock = (
(* Evaluate aBlock with the receiver and all elements of the transitive closure of its nested environments (preorder). *)
aBlock value: self.
nestedEnvironments do: [:each | each withAllNestedEnvironmentsDo: aBlock]
)
public withAllParentEnvironmentsDo: aBlock = (
(* Evaluate a one-argument block with the receiver and all environment in its parent chain, which is to say with the receiver only. *)
aBlock value: self
)
) : (
)
) : (
)