This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
_expect and other little tweaks
[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
74# Note: this isn't quite as fancy as Test::More::like().
75sub like {
76 my ($got, $expected, @mess) = @_;
77 my $pass;
78 if (ref $expected eq 'Regexp') {
79 $pass = $got =~ $expected;
80 unless ($pass) {
81 unshift(@mess, "\n",
82 "# got '$got'\n");
83 }
84 } else {
85 $pass = $got =~ /$expected/;
86 unless ($pass) {
87 unshift(@mess, "\n",
88 "# got '$got'\n",
89 "# expected /$expected/\n");
90 }
91 }
1577bb16 92 _ok($pass, _where(), @mess);
69026470
JH
93}
94
95sub pass {
96 _ok(1, '', @_);
97}
98
99sub fail {
100 _ok(0, _where(), @_);
101}
102
103# Note: can't pass multipart messages since we try to
104# be compatible with Test::More::skip().
105sub skip {
982b7cb7
JH
106 my $mess = shift;
107 my $n = @_ ? shift : 1;
69026470
JH
108 for (1..$n) {
109 ok(1, "# skip:", $mess);
110 }
111 local $^W = 0;
112 last SKIP;
113}
114
115sub eq_array {
116 my ($ra, $rb) = @_;
117 return 0 unless $#$ra == $#$rb;
118 for my $i (0..$#$ra) {
119 return 0 unless $ra->[$i] eq $rb->[$i];
120 }
121 return 1;
122}
123
124sub require_ok {
125 my ($require) = @_;
126 eval <<REQUIRE_OK;
127require $require;
128REQUIRE_OK
1577bb16 129 _ok(!$@, _where(), "require $require");
69026470
JH
130}
131
132sub use_ok {
133 my ($use) = @_;
134 eval <<USE_OK;
135use $use;
136USE_OK
1577bb16 137 _ok(!$@, _where(), "use $use");
69026470
JH
138}
139
1401;