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 = shift;
 114     my $n    = @_ ? shift : 1;
 115     for (1..$n) {
 116         ok(1, "# skip:", $mess);
 117     }
 118     local $^W = 0;
 119     last SKIP;
 120 }
 121
 122 sub eq_array {
 123     my ($ra, $rb) = @_;
 124     return 0 unless $#$ra == $#$rb;
 125     for my $i (0..$#$ra) {
 126         return 0 unless $ra->[$i] eq $rb->[$i];
 127     }
 128     return 1;
 129 }
 130
 131 sub require_ok {
 132     my ($require) = @_;
 133     eval <<REQUIRE_OK;
 134 require $require;
 135 REQUIRE_OK
 136     ok(!$@, "require $require");
 137 }
 138
 139 sub use_ok {
 140     my ($use) = @_;
 141     eval <<USE_OK;
 142 use $use;
 143 USE_OK
 144     ok(!$@, "use $use");
 145 }
 146
 147 1;