summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJarkko Hietaniemi <jhi@iki.fi>2001-09-25 14:27:01 +0000
committerJarkko Hietaniemi <jhi@iki.fi>2001-09-25 14:27:01 +0000
commitc16e11c73f354b5eecb40b1d2b938a107d9bd6b6 (patch)
treec194809a1212142d6e379732826ee7e74db2bded
parent05a019cab57ce2450836d87969b4c17324307493 (diff)
downloadperl-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--MANIFEST3
-rw-r--r--t/io/binmode.t6
-rw-r--r--t/op/chdir.t6
-rw-r--r--t/op/crypt.t22
-rw-r--r--t/op/inccode.t8
-rwxr-xr-xt/op/rand.t6
-rw-r--r--t/op/srand.t9
-rwxr-xr-xt/op/ver.t6
-rw-r--r--t/run/exit.t5
-rw-r--r--t/test.pl146
10 files changed, 187 insertions, 30 deletions
diff --git a/MANIFEST b/MANIFEST
index 1b8c0361c9..d10e42dac3 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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;