some more progress. All the initialization routines run and I can get some of the...
[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 is UnitTest::Standalone;
9
10 has $!todo;
11 has $!verify;
12
13 my method default_loader() {
14         UnitTest::Loader.new;
15 }
16
17 my method default_result() {
18         my $result := UnitTest::Result.new;
19         $result.add_listener(UnitTest::Listener::TAP.new);
20         return $result;
21 }
22
23 our sub fail($why) {
24         Exception::UnitTestFailure.new(:message($why)).throw;
25 }
26
27 # DEPRECATED
28 sub fail_if($condition, $why) {
29         fail($why) if $condition;
30 }
31
32 # DEPRECATED
33 sub fail_unless($condition, $why) {
34         fail($why) unless $condition;
35 }
36
37 our method num_tests() {
38         return 1;
39 }
40
41 # NOTE: Don't call this directly!! Call .suite.run instead.
42 method run($result?) {
43         unless $result.defined {
44                 $result := self.default_result;
45         }
46
47         $result.start_test(self);
48         my $exception;
49
50         try {
51                 self.set_up();
52                 self.run_test();
53
54                 CATCH {
55                         $exception := $!;
56                         $!.handled(1);
57                 }
58         };
59
60         try {
61                 self.tear_down();
62
63                 CATCH {
64                         $!.handled(1);
65
66                         unless $exception.defined {
67                                 $exception := $!;
68                         }
69                 }
70         };
71
72         if $exception.defined {
73                 if $exception.type == Exception::UnitTestFailure.type {
74                         $result.add_failure(self, $exception);
75                 }
76                 else {
77                         $result.add_error(self, $exception);
78                 }
79         }
80         else {
81                 $result.end_test(self);
82         }
83
84         $result;
85 }
86
87 method run_test() {
88         Parrot::call_method(self, self.name);
89 }
90
91 our method set_up() { }
92
93 our method suite() {
94         my $suite := self.default_loader.load_tests_from_testcase(self);
95         $suite.name: "Test suite for " ~ pir::typeof__SP(self.WHAT);
96         $suite;
97 }
98
99 our method tear_down() { }
100
101 our sub TEST_MAIN(:$namespace = Parrot::caller_namespace()) {
102         my $parent_nsp := $namespace.get_parent;
103         my $namespace_name := ~ $namespace;
104         my $proto_obj := $parent_nsp.get_sym: $namespace_name;
105
106         if ! Parrot::is_null( $proto_obj ) && Parrot::isa( $proto_obj, 'P6protoobject' ) {
107                 $proto_obj.MAIN();
108         }
109         elsif $namespace.contains: 'MAIN' {
110                 if ! is_null( $proto_obj ) {
111                         $namespace<MAIN>($proto_obj);
112                 }
113                 else {
114                         $namespace<MAIN>();
115                 }
116         }
117         else {
118                 my $ns_name := $namespace.string_name;
119                 pir::die( "Could not locate proto-object for namespace $ns_name. Could not find 'MAIN()' in namespace. Nothing to do." );
120         }
121 }
122
123 sub todo_test( *@text ) {
124         Parrot::get_self().todo: @text.join;
125 }
126
127 sub verify_that(*@text) {
128         Parrot::get_self().verify: @text.join;
129 }