This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-s on #! line
[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++;
1577bb16
MS
49
50 return $pass;
69026470
JH
51}
52
53sub _where {
54 my @caller = caller(1);
55 return "at $caller[1] line $caller[2]";
56}
57
58sub ok {
59 my ($pass, @mess) = @_;
60 _ok($pass, _where(), @mess);
61}
62
69026470
JH
63sub is {
64 my ($got, $expected, @mess) = @_;
65 my $pass = $got eq $expected;
66 unless ($pass) {
67 unshift(@mess, "\n",
68 "# got '$got'\n",
69 "# expected '$expected'\n");
70 }
1577bb16 71 _ok($pass, _where(), @mess);
69026470
JH
72}
73
3e90d5a3
MS
74sub isnt {
75 my ($got, $isnt, $name, @mess) = @_;
76 my $pass = $got ne $isnt;
77 unless( $pass ) {
78 unshift(@mess, "# It should not be " .
79 ( defined $got ? $got : "undef" ) . "\n",
80 "# but it is.\n");
81 }
82 _ok($pass, _where(), $name, @mess);
83}
84
69026470
JH
85# Note: this isn't quite as fancy as Test::More::like().
86sub like {
87 my ($got, $expected, @mess) = @_;
88 my $pass;
89 if (ref $expected eq 'Regexp') {
90 $pass = $got =~ $expected;
91 unless ($pass) {
92 unshift(@mess, "\n",
93 "# got '$got'\n");
94 }
95 } else {
96 $pass = $got =~ /$expected/;
97 unless ($pass) {
98 unshift(@mess, "\n",
99 "# got '$got'\n",
100 "# expected /$expected/\n");
101 }
102 }
1577bb16 103 _ok($pass, _where(), @mess);
69026470
JH
104}
105
106sub pass {
107 _ok(1, '', @_);
108}
109
110sub fail {
111 _ok(0, _where(), @_);
112}
113
3e90d5a3
MS
114sub next_test {
115 $test++
116}
117
69026470
JH
118# Note: can't pass multipart messages since we try to
119# be compatible with Test::More::skip().
120sub skip {
982b7cb7
JH
121 my $mess = shift;
122 my $n = @_ ? shift : 1;
69026470
JH
123 for (1..$n) {
124 ok(1, "# skip:", $mess);
125 }
126 local $^W = 0;
127 last SKIP;
128}
129
130sub eq_array {
131 my ($ra, $rb) = @_;
132 return 0 unless $#$ra == $#$rb;
133 for my $i (0..$#$ra) {
134 return 0 unless $ra->[$i] eq $rb->[$i];
135 }
136 return 1;
137}
138
139sub require_ok {
140 my ($require) = @_;
141 eval <<REQUIRE_OK;
142require $require;
143REQUIRE_OK
1577bb16 144 _ok(!$@, _where(), "require $require");
69026470
JH
145}
146
147sub use_ok {
148 my ($use) = @_;
149 eval <<USE_OK;
150use $use;
151USE_OK
1577bb16 152 _ok(!$@, _where(), "use $use");
69026470
JH
153}
154
1551;