This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Replace the use Test::More in t/{op,io,run} with t/test.pl.
[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
8sub plan {
9 my $n;
10 if (@_ == 1) {
11 $n = shift;
12 } else {
13 my %plan = @_;
14 $n = $plan{tests};
15 }
16 print "1..$n\n";
17 $planned = $n;
18}
19
20END {
21 my $ran = $test - 1;
22 if (defined $planned && $planned != $ran) {
23 print "# Looks like you planned $planned tests but ran $ran.\n";
24 }
25}
26
27sub skip_all {
28 if (@_) {
29 print "1..0 - @_\n";
30 } else {
31 print "1..0\n";
32 }
33 exit(0);
34}
35
36sub _ok {
37 my ($pass, $where, @mess) = @_;
38 # Do not try to microoptimize by factoring out the "not ".
39 # VMS will avenge.
40 if (@mess) {
41 print $pass ? "ok $test - @mess\n" : "not ok $test - @mess\n";
42 } else {
43 print $pass ? "ok $test\n" : "not ok $test\n";
44 }
45 unless ($pass) {
46 print "# Failed $where\n";
47 }
48 $test++;
49}
50
51sub _where {
52 my @caller = caller(1);
53 return "at $caller[1] line $caller[2]";
54}
55
56sub ok {
57 my ($pass, @mess) = @_;
58 _ok($pass, _where(), @mess);
59}
60
61sub _expect {
62 my ($got, $pass, @mess) = @_;
63 if ($pass) {
64 ok(1, @mess);
65 } else {
66 ok(0, @mess);
67 }
68}
69
70sub is {
71 my ($got, $expected, @mess) = @_;
72 my $pass = $got eq $expected;
73 unless ($pass) {
74 unshift(@mess, "\n",
75 "# got '$got'\n",
76 "# expected '$expected'\n");
77 }
78 _expect($pass, _where(), @mess);
79}
80
81# Note: this isn't quite as fancy as Test::More::like().
82sub like {
83 my ($got, $expected, @mess) = @_;
84 my $pass;
85 if (ref $expected eq 'Regexp') {
86 $pass = $got =~ $expected;
87 unless ($pass) {
88 unshift(@mess, "\n",
89 "# got '$got'\n");
90 }
91 } else {
92 $pass = $got =~ /$expected/;
93 unless ($pass) {
94 unshift(@mess, "\n",
95 "# got '$got'\n",
96 "# expected /$expected/\n");
97 }
98 }
99 _expect($pass, _where(), @mess);
100}
101
102sub pass {
103 _ok(1, '', @_);
104}
105
106sub fail {
107 _ok(0, _where(), @_);
108}
109
110# Note: can't pass multipart messages since we try to
111# be compatible with Test::More::skip().
112sub skip {
113 my ($mess, $n) = @_;
114 for (1..$n) {
115 ok(1, "# skip:", $mess);
116 }
117 local $^W = 0;
118 last SKIP;
119}
120
121sub eq_array {
122 my ($ra, $rb) = @_;
123 return 0 unless $#$ra == $#$rb;
124 for my $i (0..$#$ra) {
125 return 0 unless $ra->[$i] eq $rb->[$i];
126 }
127 return 1;
128}
129
130sub require_ok {
131 my ($require) = @_;
132 eval <<REQUIRE_OK;
133require $require;
134REQUIRE_OK
135 ok(!$@, "require $require");
136}
137
138sub use_ok {
139 my ($use) = @_;
140 eval <<USE_OK;
141use $use;
142USE_OK
143 ok(!$@, "use $use");
144}
145
1461;