Catching up after the holidays.
[kakapo:kakapo.git] / src / UnitTest / Testcase.nqp
1 # Copyright (C) 2009-2010, Austin Hastings. See accompanying LICENSE file, or 
2 # http://www.opensource.org/licenses/artistic-license-2.0.php for license.
3
4 module UnitTest::Testcase;
5
6 INIT {
7         use(    'P6metaclass' );
8         
9         has(    '$.name',
10                 '$!verify',
11         );
12         
13         export( 'assert_that', 'fail', 'verify_that' );
14 }
15
16 my method assert($target, $matcher) {
17         unless $matcher.matches($target) {
18                 my $explain := $matcher.describe_self("Expected: ")
19                         ~ $matcher.describe_failure($target, "\n     but: ");
20                 
21                 Exception::UnitTestFailure.new(
22                         :message($explain),
23                 ).throw;
24         }
25 }
26
27 sub assert_that($target, $matcher) {
28         my $self := Q:PIR {
29                 $P0 = find_dynamic_lex 'self'
30                 unless null $P0 goto got_self
31         
32                 die "Fatal: No 'self' lexical in any caller scope."
33                 
34         got_self:
35                 %r = $P0
36         };
37         
38         $self.assert($target, $matcher);
39 }
40
41 my method default_loader() {
42         return UnitTest::Loader.new();
43 }
44
45 my method default_result() {
46         my $result := UnitTest::Result.new;
47         $result.add_listener(UnitTest::Listener::TAP.new);
48         return $result;
49 }
50
51 my method _fail($why) {
52         Exception::UnitTestFailure.new(:message($why)).throw;
53 }
54
55 sub fail($why) {
56         my $self := Q:PIR {
57                 $P0 = find_dynamic_lex 'self'
58                 unless null $P0 goto got_self
59         
60                 die "Fatal: No 'self' lexical in any caller scope."
61                 
62         got_self:
63                 %r = $P0
64         };
65         
66         $self._fail($why);
67 }
68         
69 our method num_tests() {
70         return 1;
71 }
72
73 method run($result?) {
74         unless $result.defined {
75                 $result := self.default_result;
76         }
77         
78         $result.start_test(self);
79         my $exception;
80         
81         try {
82                 self.set_up();
83                 self.run_test();
84                 
85                 CATCH {
86                         $exception := $!;
87                         $!.handled(1);
88                         
89                         if $!.type == Exception::UnitTestFailure.type {
90                                 $result.add_failure(self, $!);
91                         }
92                         else {
93                                 $result.add_error(self, $!);
94                         }
95                 }
96         };
97         
98         try {
99                 self.tear_down();
100                 
101                 CATCH {
102                         $!.handled(1);
103                         
104                         unless $exception.defined {
105                                 $exception := $!;
106                                 
107                                 if $!.type == Exception::UnitTestFailure.type {
108                                         $result.add_failure(self, $!);
109                                 }
110                                 else {
111                                         $result.add_error(self, $!);
112                                 }
113                         }
114                 }
115         };
116         
117         unless $exception.defined {
118                 # say("Caught: $exception");
119                 # say($exception.backtrace_string);
120                 
121                 $result.end_test(self);
122         }
123         
124         return $result;
125 }
126
127 method run_test() {
128         Parrot::call_method(self, self.name);
129 }
130
131 our method set_up() { }
132
133 our method suite() {
134         return self.default_loader.load_tests_from_testcase(self);
135 }
136
137 our method tear_down() { }
138
139 sub verify_that(*@text) {
140         my $self := Q:PIR {
141                 $P0 = find_dynamic_lex 'self'
142                 unless null $P0 goto got_self
143         
144                 die "Fatal: No 'self' lexical in any caller scope."
145                 
146         got_self:
147                 %r = $P0
148         };
149         
150         $self.verify(@text.join);
151 }