This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Math::BigInt 1.48.
[perl5.git] / t / test.pl
CommitLineData
69026470
JH
1#
2# t/test.pl - most of Test::More functionality without the fuss
3#
4
5my $test = 1;
6my $planned;
7
7d932aad
MS
8$TODO = 0;
9
69026470
JH
10sub plan {
11 my $n;
12 if (@_ == 1) {
13 $n = shift;
14 } else {
15 my %plan = @_;
16 $n = $plan{tests};
17 }
ad20d923 18 print STDOUT "1..$n\n";
69026470
JH
19 $planned = $n;
20}
21
22END {
23 my $ran = $test - 1;
24 if (defined $planned && $planned != $ran) {
ad20d923 25 print STDOUT "# Looks like you planned $planned tests but ran $ran.\n";
69026470
JH
26 }
27}
28
29sub skip_all {
30 if (@_) {
ad20d923 31 print STDOUT "1..0 - @_\n";
69026470 32 } else {
ad20d923 33 print STDOUT "1..0\n";
69026470
JH
34 }
35 exit(0);
36}
37
38sub _ok {
7d932aad 39 my ($pass, $where, $name, @mess) = @_;
69026470
JH
40 # Do not try to microoptimize by factoring out the "not ".
41 # VMS will avenge.
7d932aad
MS
42 my $out;
43 if ($name) {
44 $out = $pass ? "ok $test - $name" : "not ok $test - $name";
69026470 45 } else {
7d932aad 46 $out = $pass ? "ok $test" : "not ok $test";
69026470 47 }
7d932aad
MS
48
49 $out .= " # TODO $TODO" if $TODO;
ad20d923 50 print STDOUT "$out\n";
7d932aad 51
69026470 52 unless ($pass) {
ad20d923 53 print STDOUT "# Failed $where\n";
69026470 54 }
7d932aad
MS
55
56 # Ensure that the message is properly escaped.
ad20d923
MS
57 print STDOUT map { /^#/ ? "$_\n" : "# $_\n" }
58 map { split /\n/ } @mess if @mess;
7d932aad 59
69026470 60 $test++;
1577bb16
MS
61
62 return $pass;
69026470
JH
63}
64
65sub _where {
66 my @caller = caller(1);
67 return "at $caller[1] line $caller[2]";
68}
69
70sub ok {
7d932aad
MS
71 my ($pass, $name, @mess) = @_;
72 _ok($pass, _where(), $name, @mess);
69026470
JH
73}
74
b3c72391
JH
75sub _q {
76 my $x = shift;
77 return 'undef' unless defined $x;
78 my $q = $x;
79 $q =~ s/'/\\'/;
80 return "'$q'";
81}
82
69026470 83sub is {
7d932aad 84 my ($got, $expected, $name, @mess) = @_;
69026470
JH
85 my $pass = $got eq $expected;
86 unless ($pass) {
b3c72391
JH
87 unshift(@mess, "# got "._q($got)."\n",
88 "# expected "._q($expected)."\n");
69026470 89 }
7d932aad 90 _ok($pass, _where(), $name, @mess);
69026470
JH
91}
92
3e90d5a3
MS
93sub isnt {
94 my ($got, $isnt, $name, @mess) = @_;
95 my $pass = $got ne $isnt;
96 unless( $pass ) {
b3c72391 97 unshift(@mess, "# it should not be "._q($got)."\n",
3e90d5a3
MS
98 "# but it is.\n");
99 }
100 _ok($pass, _where(), $name, @mess);
101}
102
69026470
JH
103# Note: this isn't quite as fancy as Test::More::like().
104sub like {
7d932aad 105 my ($got, $expected, $name, @mess) = @_;
69026470
JH
106 my $pass;
107 if (ref $expected eq 'Regexp') {
108 $pass = $got =~ $expected;
109 unless ($pass) {
7d932aad 110 unshift(@mess, "# got '$got'\n");
69026470
JH
111 }
112 } else {
113 $pass = $got =~ /$expected/;
114 unless ($pass) {
7d932aad
MS
115 unshift(@mess, "# got '$got'\n",
116 "# expected /$expected/\n");
69026470
JH
117 }
118 }
7d932aad 119 _ok($pass, _where(), $name, @mess);
69026470
JH
120}
121
122sub pass {
123 _ok(1, '', @_);
124}
125
126sub fail {
127 _ok(0, _where(), @_);
128}
129
ad20d923
MS
130sub curr_test {
131 return $test;
132}
133
3e90d5a3
MS
134sub next_test {
135 $test++
136}
137
69026470
JH
138# Note: can't pass multipart messages since we try to
139# be compatible with Test::More::skip().
140sub skip {
7d932aad 141 my $why = shift;
982b7cb7 142 my $n = @_ ? shift : 1;
69026470 143 for (1..$n) {
ad20d923 144 print STDOUT "ok $test # skip: $why\n";
e6c299c8 145 $test++;
69026470
JH
146 }
147 local $^W = 0;
148 last SKIP;
149}
150
151sub eq_array {
152 my ($ra, $rb) = @_;
153 return 0 unless $#$ra == $#$rb;
154 for my $i (0..$#$ra) {
155 return 0 unless $ra->[$i] eq $rb->[$i];
156 }
157 return 1;
158}
159
160sub require_ok {
161 my ($require) = @_;
162 eval <<REQUIRE_OK;
163require $require;
164REQUIRE_OK
1577bb16 165 _ok(!$@, _where(), "require $require");
69026470
JH
166}
167
168sub use_ok {
169 my ($use) = @_;
170 eval <<USE_OK;
171use $use;
172USE_OK
1577bb16 173 _ok(!$@, _where(), "use $use");
69026470
JH
174}
175
137352a2
RGS
176# runperl - Runs a separate perl interpreter.
177# Arguments :
178# switches => [ command-line switches ]
179# nolib => 1 # don't use -I../lib (included by default)
180# prog => one-liner (avoid quotes)
181# progfile => perl script
182# stdin => string to feed the stdin
183# stderr => redirect stderr to stdout
184# args => [ command-line arguments to the perl program ]
cb9c5e20 185# verbose => print the command line
137352a2
RGS
186
187my $is_mswin = $^O eq 'MSWin32';
188my $is_netware = $^O eq 'NetWare';
189my $is_macos = $^O eq 'MacOS';
190my $is_vms = $^O eq 'VMS';
191
cb9c5e20
JH
192sub _quote_args {
193 my ($runperl, $args) = @_;
194
195 foreach (@$args) {
196 # In VMS protect with doublequotes because otherwise
197 # DCL will lowercase -- unless already doublequoted.
198 $_ = q(").$_.q(") if $is_vms && !/^\"/;
199 $$runperl .= ' ' . $_;
200 }
201}
202
137352a2
RGS
203sub runperl {
204 my %args = @_;
205 my $runperl = $^X;
f93a5f07 206 if ($args{switches}) {
cb9c5e20 207 _quote_args(\$runperl, $args{switches});
137352a2 208 }
f93a5f07
JH
209 unless ($args{nolib}) {
210 if ($is_macos) {
cb9c5e20 211 $runperl .= ' -I::lib';
f93a5f07 212 # Use UNIX style error messages instead of MPW style.
cb9c5e20 213 $runperl .= ' -MMac::err=unix' if $args{stderr};
137352a2
RGS
214 }
215 else {
cb9c5e20 216 $runperl .= ' "-I../lib"'; # doublequotes because of VMS
137352a2
RGS
217 }
218 }
219 if (defined $args{prog}) {
220 if ($is_mswin || $is_netware || $is_vms) {
221 $runperl .= qq( -e ") . $args{prog} . qq(");
222 }
223 else {
224 $runperl .= qq( -e ') . $args{prog} . qq(');
225 }
226 } elsif (defined $args{progfile}) {
227 $runperl .= qq( "$args{progfile}");
228 }
229 if (defined $args{stdin}) {
5ae09a77
MS
230 # so we don't try to put literal newlines and crs onto the
231 # command line.
232 $args{stdin} =~ s/\n/\\n/g;
233 $args{stdin} =~ s/\r/\\r/g;
234
137352a2 235 if ($is_mswin || $is_netware || $is_vms) {
f93a5f07 236 $runperl = qq{$^X -e "print qq(} .
137352a2
RGS
237 $args{stdin} . q{)" | } . $runperl;
238 }
239 else {
f93a5f07 240 $runperl = qq{$^X -e 'print qq(} .
137352a2
RGS
241 $args{stdin} . q{)' | } . $runperl;
242 }
243 }
244 if (defined $args{args}) {
cb9c5e20
JH
245 _quote_args(\$runperl, $args{args});
246 }
247 $runperl .= ' 2>&1' if $args{stderr} && !$is_macos;
248 $runperl .= " \xB3 Dev:Null" if !$args{stderr} && $is_macos;
249 if ($args{verbose}) {
250 my $runperldisplay = $runperl;
251 $runperldisplay =~ s/\n/\n\#/g;
ad20d923 252 print STDOUT "# $runperldisplay\n";
137352a2 253 }
137352a2
RGS
254 my $result = `$runperl`;
255 $result =~ s/\n\n/\n/ if $is_vms; # XXX pipes sometimes double these
256 return $result;
257}
258
8799135f
MS
259
260sub BAILOUT {
ad20d923 261 print STDOUT "Bail out! @_\n";
8799135f
MS
262 exit;
263}
264
265
69026470 2661;