Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 185 lines (164 sloc) 5.373 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 {
0392d28 @colomon Remove redundant initialization.
colomon authored
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;
b496530 @colomon Initialize Builder variables to prevent undef errors.
colomon authored
8 has $!todo-up-to = 0;
031dc9f @sorear Implement todo()
authored
9 has $!todo-reason;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
10
11 method new() {
12 $*TEST-BUILDER;
74d317f @sorear Implement source position display on test failure
authored
13 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
14
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
15 method blame() {
16 my $frame = caller;
17 while $frame.hints('$?TRANSPARENT') {
18 $frame = $frame.caller;
19 }
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
20 $frame.file ~ " line " ~ $frame.line;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
21 }
22
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
23 method !output($text) {
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
24 say $text;
25 }
26
27 method reset() {
031dc9f @sorear Implement todo()
authored
28 $!current-test = 1;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
29 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
30
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
31 method note($m) {
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
32 self!output("# " ~ $m);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
33 0;
34 }
35
36 method ok($bool, $tag) {
37 my $not = $bool ?? "" !! "not ";
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
38 my $desc;
39 if $tag {
ac814f7 @coke escape "#" in TAP test descriptions
coke authored
40 $desc = " - " ~ $tag.subst('#', '\#').split("\n").join("\n#");
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
41 } else {
42 $desc = '';
43 }
031dc9f @sorear Implement todo()
authored
44 if $!todo-up-to >= $!current-test {
45 $desc ~= " # TODO $!todo-reason";
46 }
47 self!output($not ~ "ok " ~ $!current-test++ ~ $desc);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
48 if !$bool { self.note(self.blame); }
8bbbb50 @sorear ok() should return the success value for the test
authored
49 $bool;
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
50 }
51
031dc9f @sorear Implement todo()
authored
52 method todo($reason, $count) {
53 $!todo-reason = $reason;
54 $!todo-up-to = $!current-test + $count - 1; # todo(1) should stop after cur
811d5d9 @sorear Add a few more test functions, test files
authored
55 }
031dc9f @sorear Implement todo()
authored
56
811d5d9 @sorear Add a few more test functions, test files
authored
57 method skip($reason) {
031dc9f @sorear Implement todo()
authored
58 self!output("ok {$!current-test++} # SKIP $reason");
811d5d9 @sorear Add a few more test functions, test files
authored
59 }
60
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
61 method expected-tests($num) {
02a9152 @sorear Use !method and listop ~ in Test.pm6
authored
62 self!output("1.." ~ $num);
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
63 }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
64
65 method plan($x) {
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
66 $!set-plan = 1;
9788237 @sorear Secondary fixes revealed by (regression testing)++
authored
67 if $x ~~ Cool {
68 self.expected-tests(+$x);
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
69 } else {
70 die "Invalid argument to plan";
71 }
72 }
73
025e408 @pmurias [Test.pm6] remove &done-testing and &done_testing
pmurias authored
74 method done {
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
75 if !($!set-plan) {
031dc9f @sorear Implement todo()
authored
76 self!output("1.." ~ ($!current-test - 1));
636186e @pmurias [Test.pm6] having both a plan and done_testing only produces one test…
pmurias authored
77 }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
78 }
64fc764 @sorear Factor out ok and plan into Test.pm6
authored
79 }
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
80
4494faa @sorear Fix handling of eval "use Foo" when Foo has INIT blocks
authored
81 INIT {
82 $GLOBAL::TEST-BUILDER = Builder.bless(*);
83 $GLOBAL::TEST-BUILDER.reset;
84 }
f506534 @sorear Refactor Test.pm6 to use an inner Builder
authored
85
68c9f28 @masak [lib/Test.pm6] removed sigils from \ parameters
masak authored
86 sub cmp_ok(\a, $fn, \b, $tag?) is export { ok($fn(a, b), $tag); }
87 sub ok(\bool, $tag?) is export { $*TEST-BUILDER.ok(?bool, $tag) }
88 sub nok(\bool, $tag?) is export { $*TEST-BUILDER.ok(!bool, $tag) }
4024e22 @sorear Add a bunch of binding tests to spectest.data
authored
89 sub skip_rest($tag?) is export { } #OK
d22c6cb @sorear Tweaks to Test to handle junctions better, fake &WHAT and &HOW
authored
90 sub pass($tag?) is export { $*TEST-BUILDER.ok(1, $tag); True }
b2c363d @pmurias add flunk and pass to Test.pm6 and make the $tag in is and ok optional
pmurias authored
91 sub flunk($tag?) is export { $*TEST-BUILDER.ok(0, $tag) }
d22c6cb @sorear Tweaks to Test to handle junctions better, fake &WHAT and &HOW
authored
92 sub isa_ok(Mu $obj, Mu $type, $tag?) is export { $*TEST-BUILDER.ok($obj.^isa($type), $tag) }
93cb7df @sorear Initial prototype (Perl6) implementation of hyperops
authored
93 sub is_deeply($a,$b,$c) is export { is $a.perl, $b.perl, $c }
68c9f28 @masak [lib/Test.pm6] removed sigils from \ parameters
masak authored
94 sub is(\got, \expected, $tag?) is export {
f828727 @pmurias [Test.pm6] is prints out the incorrect value on failure
pmurias authored
95
96 # avoid comparing twice
68c9f28 @masak [lib/Test.pm6] removed sigils from \ parameters
masak authored
97 my $sgot = ~(got // '');
98 my $sexpexted = ~(expected // '');
d18c193 @colomon Avoid warnings in "is".
colomon authored
99 my $equal = $sgot eq $sexpexted;
f828727 @pmurias [Test.pm6] is prints out the incorrect value on failure
pmurias authored
100
101 $*TEST-BUILDER.ok($equal, $tag);
102 if !$equal {
103 $*TEST-BUILDER.note(' Failed test');
d18c193 @colomon Avoid warnings in "is".
colomon authored
104 $*TEST-BUILDER.note(" got: $sgot");
105 $*TEST-BUILDER.note(" expected: $sexpexted");
f828727 @pmurias [Test.pm6] is prints out the incorrect value on failure
pmurias authored
106 }
107 }
d22c6cb @sorear Tweaks to Test to handle junctions better, fake &WHAT and &HOW
authored
108 sub isnt(Mu $got, Mu $expected, $tag?) is export { $*TEST-BUILDER.ok($got ne $expected, $tag) }
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
109 # Runs $code, trapping various failure modes and returning applicable.
6ef6b2c @sorear Diag the exception in lives_ok et al (moritz)
authored
110 sub no-control($code, :$diag) {
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
111 my ($died, $warned);
65df472 @sorear Reimplement lives_ok and friends using CATCH/CONTROL. Fix exposed bugs.
authored
112 {
6ef6b2c @sorear Diag the exception in lives_ok et al (moritz)
authored
113 CATCH {
114 $*TEST-BUILDER.note("Exception: $_") if $diag;
115 default { $died = True }
116 }
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
117 CONTROL {
118 if .[0] == 11 {
119 $warned = True;
120 return; # NIECZA - causes &warn to return
121 }
122 when .[0] != 11 { $died = True } # exits block
123 }
65df472 @sorear Reimplement lives_ok and friends using CATCH/CONTROL. Fix exposed bugs.
authored
124 $code.();
125 }
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
126 $died ?? "die" !! $warned ?? "warn" !! "";
65df472 @sorear Reimplement lives_ok and friends using CATCH/CONTROL. Fix exposed bugs.
authored
127 }
811d5d9 @sorear Add a few more test functions, test files
authored
128 sub lives_ok($code,$why?) is export {
6ef6b2c @sorear Diag the exception in lives_ok et al (moritz)
authored
129 $*TEST-BUILDER.ok(no-control($code, :diag) ne "die", $why);
811d5d9 @sorear Add a few more test functions, test files
authored
130 }
131 sub dies_ok($code,$why?) is export {
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
132 $*TEST-BUILDER.ok(no-control($code) eq "die", $why);
133 }
134 sub succeeds_ok($code,$why?,:$ignore = ()) is export {
6ef6b2c @sorear Diag the exception in lives_ok et al (moritz)
authored
135 $*TEST-BUILDER.ok(?(no-control($code, :diag) eq any("", @$ignore)), $why);
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
136 }
137 sub fails_ok($code,$why?,:$expect = <die warn fail>) is export {
138 $*TEST-BUILDER.ok(?(no-control($code) eq any(@$expect)), $why);
139 }
140 sub eval_lives_ok($code,$why?) is export {
6ef6b2c @sorear Diag the exception in lives_ok et al (moritz)
authored
141 $*TEST-BUILDER.ok(no-control({ eval $code }, :diag) ne "die", $why);
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
142 }
143 sub eval_dies_ok($code,$why?) is export {
144 $*TEST-BUILDER.ok(no-control({ eval $code }) eq "die", $why);
e9691cc @sorear xx and Whatever/Array, fudging eval_*_ok to choke on control exceptions
authored
145 }
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
146 sub eval_succeeds_ok($code,$why?,:$ignore = ()) is export {
147 $*TEST-BUILDER.ok(?(no-control({ eval $code }) eq any("", @$ignore)), $why);
980923f @sorear Implement eval_dies_ok, eval_lives_ok
authored
148 }
252c6a5 @sorear Implement {,eval_}{succeed,fail}s_ok per flussence++
authored
149 sub eval_fails_ok($code,$why?,:$expect = <die warn fail>) is export {
150 $*TEST-BUILDER.ok(?(no-control({ eval $code }) eq any(@$expect)), $why);
980923f @sorear Implement eval_dies_ok, eval_lives_ok
authored
151 }
4024e22 @sorear Add a bunch of binding tests to spectest.data
authored
152 sub diag($str) is export { $*TEST-BUILDER.note($str) }
49b11af @sorear Add $*ARGFILES, -n and -p option handling
authored
153 sub is_approx(Mu $got, Mu $expected, $desc = '') is export {
0efe17a @colomon Base tolerance in is_approx on the size of the expected result.
colomon authored
154 my $tol = $expected.abs < 1e-6 ?? 1e-5 !! $expected.abs * 1e-6;
155 my $test = ($got - $expected).abs <= $tol;
49b11af @sorear Add $*ARGFILES, -n and -p option handling
authored
156 $*TEST-BUILDER.ok(?$test, $desc);
157 unless $test {
158 $*TEST-BUILDER.note("got: $got");
159 $*TEST-BUILDER.note("expected: $expected");
160 }
161 ?$test;
162 }
8fdba33 @coke Allow bare todos.
coke authored
163 sub todo($reason="", $count = 1) is export { $*TEST-BUILDER.todo($reason, $count) }
616bc42 @sorear Add plan * and done_testing to Test.pm6
authored
164 sub plan($num) is export { $*TEST-BUILDER.plan($num) }
9f058da @sorear [v6] Add a few unit tests for CgOp
authored
165 sub done() is export { $*TEST-BUILDER.done }
0711b24 @sorear Track &skip API change
authored
166 sub skip($reason,$number) is export {
811d5d9 @sorear Add a few more test functions, test files
authored
167 $*TEST-BUILDER.skip($reason) for ^$number;
75090a8 @pmurias added skip to Test
pmurias authored
168 }
a8f84cb @sorear Implement <before> and family
authored
169
170 # TODO standardize me
171 sub rxtest($rgx, $rgxname, @y, @n) is export {
172 for @y {
173 my $k = $_ ~~ Pair ?? $_.key !! $_;
174 my $v = $_ ~~ Pair ?? $_.value !! $_;
175 ok $k ~~ $rgx, "$rgxname ~~ $v";
176 }
177 for @n {
178 my $k = $_ ~~ Pair ?? $_.key !! $_;
179 my $v = $_ ~~ Pair ?? $_.value !! $_;
180 ok !($k ~~ $rgx), "$rgxname !~~ $v";
181 }
182 }
183
184
Something went wrong with that request. Please try again.