Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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