More Array functions! Plus got rid of ::empty.
[kakapo:kakapo.git] / src / UnitTest / Loader.nqp
1 # Copyright (C) 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::Loader;
5 INIT {
6         use(    'P6metaclass' );
7         
8         has(    '%!seen_methods' );
9 }
10
11 method configure_suite($class, @tests, :$suite) {
12         unless $suite.defined {
13                 $suite := self.default_suite;
14         }
15
16         my $proto := pir::getprop__PSP('metaclass', $class).WHAT();
17
18         for @tests {
19                 $suite.add_test($proto.new(:name(~$_)));
20         }
21         
22         $suite;
23 }
24
25 method default_suite() {
26         return UnitTest::Suite.new();
27 }
28
29 method get_test_methods($class) {
30         my @mro := $class.inspect('all_parents');
31         my @test_methods := Array::new();
32         
33         for @mro {
34                 my %methods := $_.inspect('methods');
35                 
36                 for %methods {
37                         my $name := ~ $_;
38                         
39                         if self.is_test_method($name) 
40                                 && ! self.seen_methods.contains($name) {
41                                 self.seen_methods{$name} := 1;
42                                 @test_methods.push($name);
43                         }
44                 }
45         }
46
47         return @test_methods;
48 }
49
50 # Returns true for "test_foo" and "testFoo" names
51 method is_test_method($name) {
52         if $name.length > 4
53                 && $name.substr(0, 4) eq 'test' {
54                 
55                 if $name[4] eq '_' {
56                         return 1;
57                 }
58
59                 if String::is_cclass('UPPERCASE', $name, :offset(4)) {
60                         return 1;
61                 }
62                 
63                 if String::is_cclass('NUMERIC', $name, :offset(4)) {
64                         return 1;
65                 }
66         }
67
68         return 0;
69 }
70
71 method load_tests_from_testcase($testcase, :$sort, :$suite) {
72         my $class := P6metaclass.get_parrotclass($testcase);    
73         my @tests := self.get_test_methods($class);
74         
75         self.configure_suite($class, @tests, :suite($suite));
76 }