diff options
author | Jarkko Hietaniemi <jhi@iki.fi> | 2001-09-25 14:27:01 +0000 |
---|---|---|
committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-09-25 14:27:01 +0000 |
commit | c16e11c73f354b5eecb40b1d2b938a107d9bd6b6 (patch) | |
tree | c194809a1212142d6e379732826ee7e74db2bded | |
parent | 05a019cab57ce2450836d87969b4c17324307493 (diff) | |
download | perl-c16e11c73f354b5eecb40b1d2b938a107d9bd6b6.tar.gz |
Replace the use Test::More in t/{op,io,run} with t/test.pl.
Note: io/binmode is failing, have to figure out why.
p4raw-id: //depot/perl@12198
-rw-r--r-- | MANIFEST | 3 | ||||
-rw-r--r-- | t/io/binmode.t | 6 | ||||
-rw-r--r-- | t/op/chdir.t | 6 | ||||
-rw-r--r-- | t/op/crypt.t | 22 | ||||
-rw-r--r-- | t/op/inccode.t | 8 | ||||
-rwxr-xr-x | t/op/rand.t | 6 | ||||
-rw-r--r-- | t/op/srand.t | 9 | ||||
-rwxr-xr-x | t/op/ver.t | 6 | ||||
-rw-r--r-- | t/run/exit.t | 5 | ||||
-rw-r--r-- | t/test.pl | 146 |
10 files changed, 187 insertions, 30 deletions
@@ -2204,11 +2204,12 @@ t/run/exit.t Test perl's exit status. t/run/kill_perl.t Tests that kill perl. t/run/runenv.t Test if perl honors its environment variables. t/TEST The regression tester +t/test.pl Simple testing library t/TestInit.pm Preamble library for core tests taint.c Tainting code thrdvar.h Per-thread variables thread.h Threading header -Todo.micro The Wishlist for microperl +Todo.micro The Wishlist for microperl toke.c The tokener uconfig.h Configuration header for microperl uconfig.sh Configuration script for microperl diff --git a/t/io/binmode.t b/t/io/binmode.t index 34a462d9f9..4991d5e92f 100644 --- a/t/io/binmode.t +++ b/t/io/binmode.t @@ -2,12 +2,14 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); } -use Test::More tests => 8; use Config; +require "test.pl"; +plan(tests => 8); + ok( binmode(STDERR), 'STDERR made binary' ); if ($Config{useperlio}) { ok( binmode(STDERR, ":unix"), ' with unix discipline' ); diff --git a/t/op/chdir.t b/t/op/chdir.t index af13e80518..b44cd6f665 100644 --- a/t/op/chdir.t +++ b/t/op/chdir.t @@ -2,9 +2,11 @@ BEGIN { # We're not going to chdir() into 't' because we don't know if # chdir() works! Instead, we'll hedge our bets and put both # possibilities into @INC. - @INC = ('lib', '../lib'); + @INC = qw(t . lib ../lib); } +require "test.pl"; +plan(tests => 25); # Might be a little early in the testing process to start using these, # but I can't think of a way to write this test without them. @@ -16,8 +18,6 @@ sub abs_path { rel2abs(curdir); } -use Test::More tests => 25; - my $cwd = abs_path; # Let's get to a known position diff --git a/t/op/crypt.t b/t/op/crypt.t index 8326a09626..8beb41d498 100644 --- a/t/op/crypt.t +++ b/t/op/crypt.t @@ -1,20 +1,20 @@ -#!./perl -Tw +#!./perl -w BEGIN { chdir 't' if -d 't'; - @INC = ('../lib'); + @INC = qw(. ../lib); } -use Config; - BEGIN { - require Test::More; + use Config; + + require "test.pl"; if( !$Config{d_crypt} ) { - Test::More->import('skip_all'); + skip_all("crypt unimplemented"); } else { - Test::More->import(tests => 2); + plan(tests => 2); } } @@ -28,10 +28,6 @@ BEGIN { # bets, given alternative encryption/hashing schemes like MD5, # C2 (or higher) security schemes, and non-UNIX platforms. -SKIP: { - skip "crypt unimplemented", 2, unless $Config{d_crypt}; - - ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); +ok(substr(crypt("ab", "cd"), 2) ne substr(crypt("ab", "ce"), 2), "salt makes a difference"); - ok(crypt("HI", "HO") eq crypt(join("",map{chr($_+256)}unpack"C*","HI"), "HO"), "low eight bits of Unicode"); -} +ok(crypt("HI", "HO") eq crypt(join("",map{chr($_+256)}unpack"C*","HI"), "HO"), "low eight bits of Unicode"); diff --git a/t/op/inccode.t b/t/op/inccode.t index 71beb3e9e9..3ccea1a0a4 100644 --- a/t/op/inccode.t +++ b/t/op/inccode.t @@ -1,14 +1,16 @@ -#!./perl -wT +#!./perl -w # Tests for the coderef-in-@INC feature BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); } use File::Spec; -use Test::More tests => 39; + +require "test.pl"; +plan(tests => 39); my @tempfiles = (); diff --git a/t/op/rand.t b/t/op/rand.t index 44bf0ff2e4..060d46a714 100755 --- a/t/op/rand.t +++ b/t/op/rand.t @@ -17,12 +17,14 @@ BEGIN { chdir "t" if -d "t"; - @INC = '../lib'; + @INC = qw(. ../lib); } use strict; use Config; -use Test::More tests => 8; + +require "test.pl"; +plan(tests => 8); my $reps = 10000; # How many times to try rand each time. diff --git a/t/op/srand.t b/t/op/srand.t index bbd0e54845..e809673020 100644 --- a/t/op/srand.t +++ b/t/op/srand.t @@ -1,9 +1,16 @@ #!./perl -w +BEGIN { + chdir "t" if -d "t"; + @INC = qw(. ../lib); +} + # Test srand. use strict; -use Test::More tests => 4; + +require "test.pl"; +plan(tests => 4); # Generate a load of random numbers. # int() avoids possible floating point error. diff --git a/t/op/ver.t b/t/op/ver.t index f64cf47579..31bd09c0fd 100755 --- a/t/op/ver.t +++ b/t/op/ver.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }; } @@ -11,8 +11,8 @@ $DOWARN = 1; # enable run-time warnings now use Config; $tests = $Config{'uvsize'} == 8 ? 47 : 44; -require Test::More; -Test::More->import( tests => $tests ); +require "test.pl"; +plan( tests => $tests ); eval { use v5.5.640; }; is( $@, '', "use v5.5.640; $@"); diff --git a/t/run/exit.t b/t/run/exit.t index 2b8ba89d01..5305bd2ae2 100644 --- a/t/run/exit.t +++ b/t/run/exit.t @@ -5,7 +5,7 @@ BEGIN { chdir 't' if -d 't'; - @INC = '../lib'; + @INC = qw(. ../lib); } # VMS and Windows need -e "...", most everything else works better with ' @@ -22,7 +22,8 @@ BEGIN { $numtests = ($^O eq 'VMS') ? 7 : 3; } -use Test::More tests => $numtests; +require "test.pl"; +plan(tests => $numtests); my $exit, $exit_arg; diff --git a/t/test.pl b/t/test.pl new file mode 100644 index 0000000000..c7c9908424 --- /dev/null +++ b/t/test.pl @@ -0,0 +1,146 @@ +# +# t/test.pl - most of Test::More functionality without the fuss +# + +my $test = 1; +my $planned; + +sub plan { + my $n; + if (@_ == 1) { + $n = shift; + } else { + my %plan = @_; + $n = $plan{tests}; + } + print "1..$n\n"; + $planned = $n; +} + +END { + my $ran = $test - 1; + if (defined $planned && $planned != $ran) { + print "# Looks like you planned $planned tests but ran $ran.\n"; + } +} + +sub skip_all { + if (@_) { + print "1..0 - @_\n"; + } else { + print "1..0\n"; + } + exit(0); +} + +sub _ok { + my ($pass, $where, @mess) = @_; + # Do not try to microoptimize by factoring out the "not ". + # VMS will avenge. + if (@mess) { + print $pass ? "ok $test - @mess\n" : "not ok $test - @mess\n"; + } else { + print $pass ? "ok $test\n" : "not ok $test\n"; + } + unless ($pass) { + print "# Failed $where\n"; + } + $test++; +} + +sub _where { + my @caller = caller(1); + return "at $caller[1] line $caller[2]"; +} + +sub ok { + my ($pass, @mess) = @_; + _ok($pass, _where(), @mess); +} + +sub _expect { + my ($got, $pass, @mess) = @_; + if ($pass) { + ok(1, @mess); + } else { + ok(0, @mess); + } +} + +sub is { + my ($got, $expected, @mess) = @_; + my $pass = $got eq $expected; + unless ($pass) { + unshift(@mess, "\n", + "# got '$got'\n", + "# expected '$expected'\n"); + } + _expect($pass, _where(), @mess); +} + +# Note: this isn't quite as fancy as Test::More::like(). +sub like { + my ($got, $expected, @mess) = @_; + my $pass; + if (ref $expected eq 'Regexp') { + $pass = $got =~ $expected; + unless ($pass) { + unshift(@mess, "\n", + "# got '$got'\n"); + } + } else { + $pass = $got =~ /$expected/; + unless ($pass) { + unshift(@mess, "\n", + "# got '$got'\n", + "# expected /$expected/\n"); + } + } + _expect($pass, _where(), @mess); +} + +sub pass { + _ok(1, '', @_); +} + +sub fail { + _ok(0, _where(), @_); +} + +# Note: can't pass multipart messages since we try to +# be compatible with Test::More::skip(). +sub skip { + my ($mess, $n) = @_; + for (1..$n) { + ok(1, "# skip:", $mess); + } + local $^W = 0; + last SKIP; +} + +sub eq_array { + my ($ra, $rb) = @_; + return 0 unless $#$ra == $#$rb; + for my $i (0..$#$ra) { + return 0 unless $ra->[$i] eq $rb->[$i]; + } + return 1; +} + +sub require_ok { + my ($require) = @_; + eval <<REQUIRE_OK; +require $require; +REQUIRE_OK + ok(!$@, "require $require"); +} + +sub use_ok { + my ($use) = @_; + eval <<USE_OK; +use $use; +USE_OK + ok(!$@, "use $use"); +} + +1; |