renumber exceptions since Parrot lost one
[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 class UnitTest::Testcase 
9         is UnitTest::Standalone;
10
11 has $!todo;
12 has $!verify;
13
14 INIT {
15         auto_accessors( :private );
16         
17         export(<
18                 fail
19                 fail_if
20                 fail_unless
21                 TEST_MAIN
22                 verify_that
23         >);
24         
25         export( UnitTest::Testcase::todo_test, :as('todo'));
26         Kakapo::initload_done();
27 }
28
29 my method default_loader() {
30         UnitTest::Loader.new;
31 }
32
33 my method default_result() {
34         my $result := UnitTest::Result.new;
35         $result.add_listener: UnitTest::Listener::TAP.new;
36         return $result;
37 }
38
39 our sub fail($why) {
40         Exception::UnitTestFailure.new(:message($why)).throw;
41 }
42
43 # DEPRECATED
44 our sub fail_if($condition, $why) {
45         fail($why) if $condition;
46 }
47
48 # DEPRECATED
49 our sub fail_unless($condition, $why) {
50         fail($why) unless $condition;
51 }
52
53 our method num_tests() {
54         1;
55 }
56
57 # NOTE: Don't call this directly!! Call .suite.run instead.
58 our method run($result = self.default_result) {
59
60         $result.start_test(self);
61         my $exception;
62
63         try {
64                 self.set_up();
65                 self.run_test();
66
67                 CATCH {
68                         $exception := $!;
69                         $!.handled(1);
70                 }
71         };
72
73         try {
74                 self.tear_down();
75
76                 CATCH {
77                         $!.handled(1);
78
79                         unless $exception.defined {
80                                 $exception := $!;
81                         }
82                 }
83         };
84
85         if $exception.defined {
86                 if $exception.type == Exception::UnitTestFailure.type {
87                         $result.add_failure(self, $exception);
88                 }
89                 else {
90                         $result.add_error(self, $exception);
91                 }
92         }
93         else {
94                 $result.end_test(self);
95         }
96
97         $result;
98 }
99
100 our method run_test() {
101         Parrot::call_method(self, self.name);
102 }
103
104 our method set_up() { }
105
106 our method suite() {
107         my $suite := self.default_loader.load_tests_from_testcase(self);
108         $suite.name: "Test suite for " ~ pir::typeof__SP(self.WHAT);
109         $suite;
110 }
111
112 our method tear_down() { }
113
114 our sub TEST_MAIN(:$namespace = Parrot::caller_namespace()) {
115         my $parent_nsp := $namespace.get_parent;
116         my $namespace_name := ~ $namespace;
117         my $proto_obj := $parent_nsp.get_sym: $namespace_name;
118
119         # FIXME: This blind-calls obj.MAIN, which does not allow for a sub (not method)
120         # named MAIN in the namespace. Not sure if there are any other interactions with
121         # hidden methods change.
122         if ! is_null( $proto_obj ) && Parrot::isa( $proto_obj, 'P6protoobject' ) {
123                 $proto_obj.MAIN();
124         }
125         elsif $namespace.contains: 'MAIN' {
126                 if ! is_null( $proto_obj ) {
127                         $namespace<MAIN>($proto_obj);
128                 }
129                 else {
130                         $namespace<MAIN>();
131                 }
132         }
133         else {
134                 my $ns_name := $namespace.string_name;
135                 pir::die( "Could not locate proto-object for namespace $ns_name. Could not find 'MAIN()' in namespace. Nothing to do." );
136         }
137 }
138
139 sub todo_test( *@text ) {
140         Parrot::get_self().todo: @text.join;
141 }
142
143 sub verify_that(*@text) {
144         Parrot::get_self().verify: @text.join;
145 }