Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 137 lines (117 sloc) 3.449 kb
39924ff @sorear Remove lexical package fudge
authored
1 my module Test;
74d317f @sorear Implement source position display on test failure
authored
2
3 constant $?TRANSPARENT = 1;
4
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
5 class Builder {
6 has $.current-test;
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
7 has $!set-plan;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
8
9 method new() {
10 $*TEST-BUILDER;
74d317f @sorear Implement source position display on test failure
authored
11 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
12
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
13 method blame() {
14 my $frame = caller;
15 while $frame.hints('$?TRANSPARENT') {
16 $frame = $frame.caller;
17 }
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
18 $frame.file ~ " line " ~ $frame.line;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
19 }
20
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
21 method !output($text) {
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
22 say $text;
23 }
24
25 method reset() {
26 $.current-test = 1;
27 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
28
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
29 method note($m) {
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
30 self!output("# " ~ $m);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
31 0;
32 }
33
34 method ok($bool, $tag) {
35 my $not = $bool ?? "" !! "not ";
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
36 my $desc;
37 if $tag {
38 $desc = " - " ~ $tag.split("\n").join("\n#");
39 } else {
40 $desc = '';
41 }
42 self!output($not ~ "ok " ~ $.current-test++ ~ $desc);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
43 if !$bool { self.note(self.blame); }
44 }
45
811d5d9 @sorear Add a few more test functions, test files
authored
46 # TODO: Generalize this.
47 method todo($tag, $reason) {
48 self!output("not ok {$.current-test++} - $tag # TODO $reason");
49 }
50 method skip($reason) {
51 self!output("ok {$.current-test++} # skip $reason");
52 }
53
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
54 method expected-tests($num) {
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
55 self!output("1.." ~ $num);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
56 }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
57
58 # XXX multi!
59 method plan($x) {
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
60 $!set-plan = 1;
b034cd5 @sorear fix broken fudged multi in Test.pm6
authored
61 if $x ~~ Num {
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
62 self.expected-tests($x);
63 } else {
64 die "Invalid argument to plan";
65 }
66 }
67
025e408 @pmurias [Test.pm6] remove &done-testing and &done_testing
pmurias authored
68 method done {
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
69 if !($!set-plan) {
70 self!output("1.." ~ ($.current-test - 1));
71 }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
72 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
73 }
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
74
75 $GLOBAL::TEST-BUILDER = Builder.CREATE;
76 $GLOBAL::TEST-BUILDER.reset;
77
811d5d9 @sorear Add a few more test functions, test files
authored
78 sub ok(\$bool, $tag?) is export { $*TEST-BUILDER.ok(?$bool, $tag) }
79 sub nok(\$bool, $tag?) is export { $*TEST-BUILDER.ok(!$bool, $tag) }
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
80 sub pass($tag?) is export { $*TEST-BUILDER.ok(1, $tag) }
81 sub flunk($tag?) is export { $*TEST-BUILDER.ok(0, $tag) }
811d5d9 @sorear Add a few more test functions, test files
authored
82 sub isa_ok($obj, $type, $tag?) is export { $*TEST-BUILDER.ok($obj.^isa($type), $tag) }
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
83 sub is($got, $expected, $tag?) is export {
f828727 @pmurias [Test.pm6] is prints out the incorrect value on failure
pmurias authored
84
85 # avoid comparing twice
86 my $equal = $got eq $expected;
87
88 $*TEST-BUILDER.ok($equal, $tag);
89 if !$equal {
90 $*TEST-BUILDER.note(' Failed test');
91 $*TEST-BUILDER.note(' got: '~$got);
92 $*TEST-BUILDER.note(' expected: '~$expected);
93 }
94 }
811d5d9 @sorear Add a few more test functions, test files
authored
95 sub isnt($got, $expected, $tag?) is export { $*TEST-BUILDER.ok($got ne $expected, $tag) }
96 sub lives_ok($code,$why?) is export {
97 my $lived = False;
98 try { $code.(); $lived = True; }
99 $*TEST-BUILDER.ok($lived, $why);
100 }
101 sub dies_ok($code,$why?) is export {
102 my $lived = False;
103 try { $code.(); $lived = True; }
104 $*TEST-BUILDER.ok(!$lived, $why);
105 }
980923f @sorear Implement eval_dies_ok, eval_lives_ok
authored
106 sub eval_dies_ok($code, $why?) is export {
107 my $lived = False;
108 try { eval $code; $lived = True; }
109 $*TEST-BUILDER.ok(!$lived, $why);
110 }
111 sub eval_lives_ok($code, $why?) is export {
112 my $lived = False;
113 try { eval $code; $lived = True; }
114 $*TEST-BUILDER.ok($lived, $why);
115 }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
116 sub plan($num) is export { $*TEST-BUILDER.plan($num) }
9f058da @sorear [v6] Add a few unit tests for CgOp
authored
117 sub done() is export { $*TEST-BUILDER.done }
0711b24 @sorear Track &skip API change
authored
118 sub skip($reason,$number) is export {
811d5d9 @sorear Add a few more test functions, test files
authored
119 $*TEST-BUILDER.skip($reason) for ^$number;
75090a8 @pmurias added skip to Test
pmurias authored
120 }
a8f84cb @sorear Implement <before> and family
authored
121
122 # TODO standardize me
123 sub rxtest($rgx, $rgxname, @y, @n) is export {
124 for @y {
125 my $k = $_ ~~ Pair ?? $_.key !! $_;
126 my $v = $_ ~~ Pair ?? $_.value !! $_;
127 ok $k ~~ $rgx, "$rgxname ~~ $v";
128 }
129 for @n {
130 my $k = $_ ~~ Pair ?? $_.key !! $_;
131 my $v = $_ ~~ Pair ?? $_.value !! $_;
132 ok !($k ~~ $rgx), "$rgxname !~~ $v";
133 }
134 }
135
136
Something went wrong with that request. Please try again.