Got UnitTest case written for t/Global.nqp.
[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 class Exception::UnitTestFailure is Exception::Wrapper {
5         method severity() { Exception::Severity.ERROR; }
6 }
7
8 module UnitTest::Testcase;
9
10 INIT {
11         has(    '$.name',
12                 '$!verify',
13         );
14         
15         export( 'assert_match',
16                 'assert_that',
17                 'fail',
18                 'fail_if',
19                 'fail_unless',
20                 'verify_that'
21         );
22 }
23
24 method assert_match($target, $matcher) {
25         unless $matcher.matches($target) {
26                 my $explain := $matcher.describe_self("Expected: ")
27                         ~ $matcher.describe_failure($target, "\n     but: ");           
28                 self._fail($explain);
29         }
30 }
31
32 sub assert_that($target, $matcher) {
33         get_self().assert_match($target, $matcher);
34 }
35
36 my method default_loader() {
37         UnitTest::Loader.new;
38 }
39
40 my method default_result() {
41         my $result := UnitTest::Result.new;
42         $result.add_listener(UnitTest::Listener::TAP.new);
43         return $result;
44 }
45
46 my method _fail($why) {
47         Exception::UnitTestFailure.new(:message($why)).throw;
48 }
49
50 sub fail($why) {
51         get_self()._fail($why);
52 }
53
54 sub fail_if($condition, $why) {
55         if ($condition) {
56                 get_self()._fail($why);
57         }
58 }
59
60 sub fail_unless($condition, $why) {
61         unless ($condition) {
62                 get_self()._fail($why);
63         }
64 }
65
66 sub get_self() {
67         my $self := pir::find_dynamic_lex__PS('self');
68         
69         if pir::isnull($self) {
70                 pir::die("Fatal: No 'self' lexical in any caller scope");
71         }
72         
73         return $self;
74 }
75
76 our method num_tests() {
77         return 1;
78 }
79
80 # NOTE: Don't call this directly!! Call .suite.run instead.
81 method run($result?) {
82         unless $result.defined {
83                 $result := self.default_result;
84         }
85         
86         $result.start_test(self);
87         my $exception;
88         
89         try {
90                 self.set_up();
91                 self.run_test();
92         
93                 CATCH {
94                         $exception := $!;
95                         $!.handled(1);
96                 }
97         };
98         
99         try {
100                 self.tear_down();
101
102                 CATCH {
103                         $!.handled(1);
104                         
105                         unless $exception.defined {
106                                 $exception := $!;
107                         }
108                 }
109         };
110
111         if $exception.defined {
112                 if $exception.type == Exception::UnitTestFailure.type {
113                         $result.add_failure(self, $exception);
114                 }
115                 else {
116                         $result.add_error(self, $exception);
117                 }
118         }
119         else {
120                 $result.end_test(self);
121         }
122         
123         $result;
124 }
125
126 method run_test() {
127         Parrot::call_method(self, self.name);
128 }
129
130 our method set_up() { }
131
132 our method suite() {
133         self.default_loader.load_tests_from_testcase(self);
134 }
135
136 our method tear_down() { }
137
138 sub verify_that(*@text) {
139         get_self().verify(@text.join);
140 }