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
1 #
2 # t/test.pl - most of Test::More functionality without the fuss
3 #
4
5 my $test = 1;
6 my $planned;
7
8 sub 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
20 END {
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
27 sub skip_all {
28     if (@_) {
29         print "1..0 - @_\n";
30     } else {
31         print "1..0\n";
32     }
33     exit(0);
34 }
35
36 sub _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
51 sub _where {
52     my @caller = caller(1);
53     return "at $caller[1] line $caller[2]";
54 }
55
56 sub ok {
57     my ($pass, @mess) = @_;
58     _ok($pass, _where(), @mess);
59 }
60
61 sub _expect {
62     my ($got, $pass, @mess) = @_;
63     if ($pass) {
64         ok(1, @mess);
65     } else {
66         ok(0, @mess);
67     }
68
69
70 sub 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().
82 sub 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
102 sub pass {
103     _ok(1, '', @_);
104 }
105
106 sub 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().
112 sub skip {
113     my ($mess, $n) = @_;
114     for (1..$n) {
115         ok(1, "# skip:", $mess);
116     }
117     local $^W = 0;
118     last SKIP;
119 }
120
121 sub 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
130 sub require_ok {
131     my ($require) = @_;
132     eval <<REQUIRE_OK;
133 require $require;
134 REQUIRE_OK
135     ok(!$@, "require $require");
136 }
137
138 sub use_ok {
139     my ($use) = @_;
140     eval <<USE_OK;
141 use $use;
142 USE_OK
143     ok(!$@, "use $use");
144 }
145
146 1;