summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rwxr-xr-x[-rw-r--r--]t/TEST10
-rwxr-xr-xt/bar110
-rwxr-xr-x[-rw-r--r--]t/base/cond.t2
-rwxr-xr-x[-rw-r--r--]t/base/if.t2
-rwxr-xr-x[-rw-r--r--]t/base/lex.t27
-rwxr-xr-x[-rw-r--r--]t/base/pat.t2
-rwxr-xr-x[-rw-r--r--]t/base/term.t2
l---------t/c1
-rwxr-xr-x[-rw-r--r--]t/cmd/elsif.t2
-rwxr-xr-x[-rw-r--r--]t/cmd/for.t2
-rwxr-xr-x[-rw-r--r--]t/cmd/mod.t4
-rwxr-xr-x[-rw-r--r--]t/cmd/subval.t2
-rwxr-xr-x[-rw-r--r--]t/cmd/switch.t4
-rwxr-xr-x[-rw-r--r--]t/cmd/while.t2
-rwxr-xr-x[-rw-r--r--]t/comp/cmdopt.t4
-rwxr-xr-x[-rw-r--r--]t/comp/cpp.t4
-rwxr-xr-x[-rw-r--r--]t/comp/decl.t2
-rwxr-xr-x[-rw-r--r--]t/comp/multiline.t2
-rwxr-xr-x[-rw-r--r--]t/comp/package.t0
-rwxr-xr-x[-rw-r--r--]t/comp/script.t2
-rwxr-xr-x[-rw-r--r--]t/comp/term.t2
-rwxr-xr-xt/foo8
-rw-r--r--t/foo_tests1
-rwxr-xr-x[-rw-r--r--]t/io/argv.t2
-rwxr-xr-x[-rw-r--r--]t/io/dup.t2
-rwxr-xr-x[-rw-r--r--]t/io/fs.t2
-rw-r--r--t/io/fs.t.orig85
-rw-r--r--t/io/fs.t.rej15
-rwxr-xr-x[-rw-r--r--]t/io/inplace.t2
-rwxr-xr-x[-rw-r--r--]t/io/pipe.t2
-rwxr-xr-x[-rw-r--r--]t/io/print.t2
-rwxr-xr-x[-rw-r--r--]t/io/tell.t2
-rwxr-xr-x[-rw-r--r--]t/lib/big.t0
-rw-r--r--t/make.out1
-rw-r--r--t/makefile7
-rwxr-xr-x[-rw-r--r--]t/op/append.t2
-rwxr-xr-x[-rw-r--r--]t/op/array.t2
-rwxr-xr-x[-rw-r--r--]t/op/auto.t2
-rwxr-xr-x[-rw-r--r--]t/op/chop.t2
-rwxr-xr-x[-rw-r--r--]t/op/cond.t2
-rwxr-xr-x[-rw-r--r--]t/op/dbm.t16
-rwxr-xr-x[-rw-r--r--]t/op/delete.t2
-rwxr-xr-x[-rw-r--r--]t/op/do.t2
-rwxr-xr-x[-rw-r--r--]t/op/each.t2
-rwxr-xr-x[-rw-r--r--]t/op/eval.t4
-rwxr-xr-x[-rw-r--r--]t/op/exec.t2
-rwxr-xr-x[-rw-r--r--]t/op/exp.t2
-rwxr-xr-x[-rw-r--r--]t/op/flip.t2
-rwxr-xr-x[-rw-r--r--]t/op/fork.t2
-rwxr-xr-x[-rw-r--r--]t/op/glob.t2
-rwxr-xr-x[-rw-r--r--]t/op/goto.t26
-rwxr-xr-x[-rw-r--r--]t/op/groups.t2
-rwxr-xr-x[-rw-r--r--]t/op/index.t2
-rwxr-xr-x[-rw-r--r--]t/op/int.t2
-rwxr-xr-x[-rw-r--r--]t/op/join.t2
-rwxr-xr-x[-rw-r--r--]t/op/list.t2
-rwxr-xr-x[-rw-r--r--]t/op/local.t2
-rwxr-xr-x[-rw-r--r--]t/op/magic.t24
-rwxr-xr-x[-rw-r--r--]t/op/mkdir.t2
-rwxr-xr-x[-rw-r--r--]t/op/oct.t2
-rwxr-xr-x[-rw-r--r--]t/op/ord.t2
-rwxr-xr-x[-rw-r--r--]t/op/pack.t26
-rwxr-xr-x[-rw-r--r--]t/op/pat.t2
-rwxr-xr-x[-rw-r--r--]t/op/push.t11
-rwxr-xr-x[-rw-r--r--]t/op/range.t2
-rwxr-xr-x[-rw-r--r--]t/op/read.t2
-rwxr-xr-x[-rw-r--r--]t/op/readdir.t0
-rwxr-xr-xt/op/ref.t179
-rwxr-xr-x[-rw-r--r--]t/op/regexp.t2
-rwxr-xr-x[-rw-r--r--]t/op/repeat.t2
-rwxr-xr-x[-rw-r--r--]t/op/s.t27
-rwxr-xr-x[-rw-r--r--]t/op/sleep.t2
-rwxr-xr-x[-rw-r--r--]t/op/sort.t2
-rwxr-xr-x[-rw-r--r--]t/op/split.t4
-rwxr-xr-x[-rw-r--r--]t/op/sprintf.t2
-rwxr-xr-x[-rw-r--r--]t/op/stat.t7
-rwxr-xr-x[-rw-r--r--]t/op/study.t2
-rwxr-xr-x[-rw-r--r--]t/op/substr.t2
-rwxr-xr-x[-rw-r--r--]t/op/time.t2
-rwxr-xr-x[-rw-r--r--]t/op/undef.t2
-rwxr-xr-x[-rw-r--r--]t/op/unshift.t2
-rwxr-xr-x[-rw-r--r--]t/op/vec.t2
-rwxr-xr-x[-rw-r--r--]t/op/write.t2
l---------t/perl1
-rw-r--r--t/perl5a1.tarbin0 -> 8192 bytes
-rw-r--r--t/tmp/bullet13
-rwxr-xr-xt/x3
87 files changed, 532 insertions, 202 deletions
diff --git a/t/TEST b/t/TEST
index abfa65af31..c4ada484c3 100644..100755
--- a/t/TEST
+++ b/t/TEST
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
+# $RCSfile: TEST,v $$Revision: 4.1 $$Date: 92/08/07 18:27:00 $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
@@ -27,6 +27,8 @@ while (<CONFIG>) {
}
}
$bad = 0;
+$good = 0;
+$total = @ARGV;
while ($test = shift) {
if ($test =~ /^$/) {
next;
@@ -73,6 +75,7 @@ while ($test = shift) {
$next = $next - 1;
if ($ok && $next == $max) {
print "ok\n";
+ $good = $good + 1;
} else {
$next += 1;
print "FAILED on test $next\n";
@@ -91,10 +94,11 @@ if ($bad == 0) {
die "FAILED--no tests were run for some reason.\n";
}
} else {
+ $pct = sprintf("%.2f", $good / $total * 100);
if ($bad == 1) {
- die "Failed 1 test.\n";
+ warn "Failed 1 test, $pct% okay.\n";
} else {
- die "Failed $bad tests.\n";
+ die "Failed $bad/$total tests, $pct% okay.\n";
}
}
($user,$sys,$cuser,$csys) = times;
diff --git a/t/bar b/t/bar
new file mode 100755
index 0000000000..0170138188
--- /dev/null
+++ b/t/bar
@@ -0,0 +1,110 @@
+#!./perl -Dxst
+require "../lib/bigint.pl";
+
+$test = 0;
+$| = 1;
+print "1..246\n";
+while (<DATA>) {
+ chop;
+ if (/^&/) {
+ $f = $_;
+ } else {
+ ++$test;
+ @args = split(/:/,$_,99);
+ $ans = pop(@args);
+ $try = "$f('" . join("','", @args) . "');";
+ if (($ans1 = eval($try)) eq $ans) {
+ print "ok $test\n";
+ } else {
+ print "not ok $test\n";
+ print "# '$try' expected: '$ans' got: '$ans1'\n";
+ }
+ }
+}
+__END__
+&bdiv
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+1
+-1:-1:+1
++1:-1:-1
+-1:+1:-1
++1:+2:+0
++2:+1:+2
++1000000000:+9:+111111111
++2000000000:+9:+222222222
++3000000000:+9:+333333333
++4000000000:+9:+444444444
++5000000000:+9:+555555555
++6000000000:+9:+666666666
++7000000000:+9:+777777777
++8000000000:+9:+888888888
++9000000000:+9:+1000000000
++35500000:+113:+314159
++71000000:+226:+314159
++106500000:+339:+314159
++1000000000:+3:+333333333
++10:+5:+2
++100:+4:+25
++1000:+8:+125
++10000:+16:+625
++999999999999:+9:+111111111111
++999999999999:+99:+10101010101
++999999999999:+999:+1001001001
++999999999999:+9999:+100010001
++999999999999999:+99999:+10000100001
+&bmod
+abc:abc:NaN
+abc:+1:abc:NaN
++1:abc:NaN
++0:+0:NaN
++0:+1:+0
++1:+0:NaN
++0:-1:+0
+-1:+0:NaN
++1:+1:+0
+-1:-1:+0
++1:-1:+0
+-1:+1:+0
++1:+2:+1
++2:+1:+0
++1000000000:+9:+1
++2000000000:+9:+2
++3000000000:+9:+3
++4000000000:+9:+4
++5000000000:+9:+5
++6000000000:+9:+6
++7000000000:+9:+7
++8000000000:+9:+8
++9000000000:+9:+0
++35500000:+113:+33
++71000000:+226:+66
++106500000:+339:+99
++1000000000:+3:+1
++10:+5:+0
++100:+4:+0
++1000:+8:+0
++10000:+16:+0
++999999999999:+9:+0
++999999999999:+99:+0
++999999999999:+999:+0
++999999999999:+9999:+0
++999999999999999:+99999:+0
+&bgcd
+abc:abc:NaN
+abc:+0:NaN
++0:abc:NaN
++0:+0:+0
++0:+1:+1
++1:+0:+1
++1:+1:+1
++2:+3:+1
++3:+2:+1
++100:+625:+25
++4096:+81:+1
diff --git a/t/base/cond.t b/t/base/cond.t
index 592580120f..9a57348474 100644..100755
--- a/t/base/cond.t
+++ b/t/base/cond.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cond.t,v 4.0 91/03/20 01:48:54 lwall Locked $
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:02 $
# make sure conditional operators work
diff --git a/t/base/if.t b/t/base/if.t
index 6965ef5141..12db7652e4 100644..100755
--- a/t/base/if.t
+++ b/t/base/if.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: if.t,v 4.0 91/03/20 01:49:03 lwall Locked $
+# $RCSfile: if.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:03 $
print "1..2\n";
diff --git a/t/base/lex.t b/t/base/lex.t
index 0c94b875a3..1828ac62e8 100644..100755
--- a/t/base/lex.t
+++ b/t/base/lex.t
@@ -1,14 +1,13 @@
#!./perl
-# $Header: lex.t,v 4.0 91/03/20 01:49:08 lwall Locked $
+# $RCSfile: lex.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:04 $
-print "1..18\n";
+print "1..24\n";
-$ # this is the register <space>
-= 'x';
+$x = 'x';
-print "#1 :$ : eq :x:\n";
-if ($ eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
+print "#1 :$x: eq :x:\n";
+if ($x eq 'x') {print "ok 1\n";} else {print "not ok 1\n";}
$x = $#; # this is the register $#
@@ -29,7 +28,7 @@ eval 'while (0) {
';
eval '$foo{1} / 1;';
-if (!$@) {print "ok 6\n";} else {print "not ok 6\n";}
+if (!$@) {print "ok 6\n";} else {print "not ok 6 $@\n";}
eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
@@ -76,3 +75,17 @@ print <<; # Yow!
ok 18
# previous line intentionally left blank.
+
+$foo = FOO;
+$bar = BAR;
+$foo{$bar} = BAZ;
+$ary[0] = ABC;
+
+print "$foo{$bar}" eq "BAZ" ? "ok 19\n" : "not ok 19\n";
+
+print "${foo}{$bar}" eq "FOO{BAR}" ? "ok 20\n" : "not ok 20\n";
+print "${foo{$bar}}" eq "BAZ" ? "ok 21\n" : "not ok 21\n";
+
+print "FOO:" =~ /$foo[:]/ ? "ok 22\n" : "not ok 22\n";
+print "ABC" =~ /^$ary[$A]$/ ? "ok 23\n" : "not ok 23\n";
+print "FOOZ" =~ /^$foo[$A-Z]$/ ? "ok 24\n" : "not ok 24\n";
diff --git a/t/base/pat.t b/t/base/pat.t
index 8ad88dd331..c689f4552d 100644..100755
--- a/t/base/pat.t
+++ b/t/base/pat.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: pat.t,v 4.0 91/03/20 01:49:12 lwall Locked $
+# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:05 $
print "1..2\n";
diff --git a/t/base/term.t b/t/base/term.t
index c322242710..0f9a46f6c9 100644..100755
--- a/t/base/term.t
+++ b/t/base/term.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: term.t,v 4.0 91/03/20 01:49:17 lwall Locked $
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:07 $
print "1..6\n";
diff --git a/t/c b/t/c
new file mode 120000
index 0000000000..3b12464976
--- /dev/null
+++ b/t/c
@@ -0,0 +1 @@
+TEST \ No newline at end of file
diff --git a/t/cmd/elsif.t b/t/cmd/elsif.t
index 975acef4f7..e42fa61137 100644..100755
--- a/t/cmd/elsif.t
+++ b/t/cmd/elsif.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: elsif.t,v 4.0 91/03/20 01:49:21 lwall Locked $
+# $RCSfile: elsif.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:08 $
sub foo {
if ($_[0] == 1) {
diff --git a/t/cmd/for.t b/t/cmd/for.t
index 16745b5b28..e45f05040b 100644..100755
--- a/t/cmd/for.t
+++ b/t/cmd/for.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: for.t,v 4.0 91/03/20 01:49:26 lwall Locked $
+# $RCSfile: for.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:09 $
print "1..7\n";
diff --git a/t/cmd/mod.t b/t/cmd/mod.t
index 787aade307..e1327edf6c 100644..100755
--- a/t/cmd/mod.t
+++ b/t/cmd/mod.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: mod.t,v 4.0 91/03/20 01:49:33 lwall Locked $
+# $RCSfile: mod.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:11 $
print "1..7\n";
@@ -20,7 +20,7 @@ do {$x[$x] = $x;} while ($x++) < 10;
if (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
print "ok 5\n";
} else {
- print "not ok 5\n";
+ print "not ok 5 @x\n";
}
$x = 15;
diff --git a/t/cmd/subval.t b/t/cmd/subval.t
index 505025f7f4..90345f2c65 100644..100755
--- a/t/cmd/subval.t
+++ b/t/cmd/subval.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: subval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:42:31 $
+# $RCSfile: subval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:13 $
sub foo1 {
'true1';
diff --git a/t/cmd/switch.t b/t/cmd/switch.t
index 2af2c9e971..faa5de470f 100644..100755
--- a/t/cmd/switch.t
+++ b/t/cmd/switch.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: switch.t,v 4.0 91/03/20 01:49:44 lwall Locked $
+# $RCSfile: switch.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:14 $
print "1..18\n";
@@ -40,7 +40,7 @@ sub foo2 {
return $_;
}
-print do foo2(0) == 20 ? "ok 7\n" : "not ok 1\n";
+print do foo2(0) == 20 ? "ok 7\n" : "not ok 7\n";
print do foo2(1) == 1 ? "ok 8\n" : "not ok 8\n";
print do foo2(2) == 2 ? "ok 9\n" : "not ok 9\n";
print do foo2(3) == 3 ? "ok 10\n" : "not ok 10\n";
diff --git a/t/cmd/while.t b/t/cmd/while.t
index 9876095c1c..f42174eeca 100644..100755
--- a/t/cmd/while.t
+++ b/t/cmd/while.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: while.t,v 4.0 91/03/20 01:49:51 lwall Locked $
+# $RCSfile: while.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:15 $
print "1..10\n";
diff --git a/t/comp/cmdopt.t b/t/comp/cmdopt.t
index e6e2abff75..1ee3581464 100644..100755
--- a/t/comp/cmdopt.t
+++ b/t/comp/cmdopt.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cmdopt.t,v 4.0 91/03/20 01:49:58 lwall Locked $
+# $RCSfile: cmdopt.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:17 $
print "1..40\n";
@@ -73,7 +73,7 @@ if ($a =~ /a/ && $x) { print "ok 33\n";} else { print "not ok 33\n";}
if ($a !~ /a/ && $x) { print "not ok 34\n";} else { print "ok 34\n";}
$x = '';
if ($a =~ /a/ && $x) { print "not ok 35\n";} else { print "ok 35\n";}
- if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
+if ($a !~ /a/ && $x) { print "not ok 36\n";} else { print "ok 36\n";}
$x = 1;
if ($a =~ /a/ || $x) { print "ok 37\n";} else { print "not ok 37\n";}
diff --git a/t/comp/cpp.t b/t/comp/cpp.t
index dca25d358b..942f77f3a1 100644..100755
--- a/t/comp/cpp.t
+++ b/t/comp/cpp.t
@@ -1,13 +1,13 @@
#!./perl -P
-# $RCSfile: cpp.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:42:08 $
+# $RCSfile: cpp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:18 $
open(CONFIG,"../config.sh") || die;
while (<CONFIG>) {
if (/^cppstdin/) {
if (/^cppstdin='(.*cppstdin)'/ && ! -e $1) {
print "1..0\n";
- exit; # Can't test till after install, alas.
+ exit; # Cannot test till after install, alas.
}
last;
}
diff --git a/t/comp/decl.t b/t/comp/decl.t
index af8bf05ba8..32b8509df7 100644..100755
--- a/t/comp/decl.t
+++ b/t/comp/decl.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: decl.t,v 4.0 91/03/20 01:50:09 lwall Locked $
+# $RCSfile: decl.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:19 $
# check to see if subroutine declarations work everwhere
diff --git a/t/comp/multiline.t b/t/comp/multiline.t
index 55650813f4..1d238f95b3 100644..100755
--- a/t/comp/multiline.t
+++ b/t/comp/multiline.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: multiline.t,v 4.0 91/03/20 01:50:15 lwall Locked $
+# $RCSfile: multiline.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:20 $
print "1..5\n";
diff --git a/t/comp/package.t b/t/comp/package.t
index 5237011a62..5237011a62 100644..100755
--- a/t/comp/package.t
+++ b/t/comp/package.t
diff --git a/t/comp/script.t b/t/comp/script.t
index 8e882933ce..7dd78cdd95 100644..100755
--- a/t/comp/script.t
+++ b/t/comp/script.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: script.t,v 4.0 91/03/20 01:50:26 lwall Locked $
+# $RCSfile: script.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:23 $
print "1..3\n";
diff --git a/t/comp/term.t b/t/comp/term.t
index 1012f949ba..b248e9b161 100644..100755
--- a/t/comp/term.t
+++ b/t/comp/term.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: term.t,v 4.0 91/03/20 01:50:36 lwall Locked $
+# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $
# tests that aren't important enough for base.term
diff --git a/t/foo b/t/foo
new file mode 100755
index 0000000000..9070e7874c
--- /dev/null
+++ b/t/foo
@@ -0,0 +1,8 @@
+#!./perl
+
+$_ = 'aaabbbccc';
+if (/(a+b+c+)/ && $1 eq 'aaabbbccc') {
+ print "ok 14\n";
+} else {
+ print "not ok 14\n";
+}
diff --git a/t/foo_tests b/t/foo_tests
new file mode 100644
index 0000000000..ee8f80050a
--- /dev/null
+++ b/t/foo_tests
@@ -0,0 +1 @@
+'((a))'i ABC y $&-$1-$2 A-A-A
diff --git a/t/io/argv.t b/t/io/argv.t
index 6f55896fdf..cee43fc46e 100644..100755
--- a/t/io/argv.t
+++ b/t/io/argv.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: argv.t,v 4.0 91/03/20 01:50:46 lwall Locked $
+# $RCSfile: argv.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:25 $
print "1..5\n";
diff --git a/t/io/dup.t b/t/io/dup.t
index e5ea7d410d..901642d8f6 100644..100755
--- a/t/io/dup.t
+++ b/t/io/dup.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: dup.t,v 4.0 91/03/20 01:50:49 lwall Locked $
+# $RCSfile: dup.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:27 $
print "1..6\n";
diff --git a/t/io/fs.t b/t/io/fs.t
index d298b29509..9eaf1da5f2 100644..100755
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: fs.t,v 4.0 91/03/20 01:50:55 lwall Locked $
+# $RCSfile: fs.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:28 $
print "1..22\n";
diff --git a/t/io/fs.t.orig b/t/io/fs.t.orig
deleted file mode 100644
index 705523cffe..0000000000
--- a/t/io/fs.t.orig
+++ /dev/null
@@ -1,85 +0,0 @@
-#!./perl
-
-# $Header: fs.t,v 4.0 91/03/20 01:50:55 lwall Locked $
-
-print "1..22\n";
-
-$wd = `pwd`;
-chop($wd);
-
-`rm -f tmp 2>/dev/null; mkdir tmp 2>/dev/null`;
-chdir './tmp';
-`/bin/rm -rf a b c x`;
-
-umask(022);
-
-if (umask(0) == 022) {print "ok 1\n";} else {print "not ok 1\n";}
-open(fh,'>x') || die "Can't create x";
-close(fh);
-open(fh,'>a') || die "Can't create a";
-close(fh);
-
-if (link('a','b')) {print "ok 2\n";} else {print "not ok 2\n";}
-
-if (link('b','c')) {print "ok 3\n";} else {print "not ok 3\n";}
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('c');
-
-if ($nlink == 3) {print "ok 4\n";} else {print "not ok 4\n";}
-if (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";}
-
-if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";}
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0777) {print "ok 7\n";} else {print "not ok 7\n";}
-
-if ((chmod 0700,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";}
-
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('c');
-if (($mode & 0777) == 0700) {print "ok 9\n";} else {print "not ok 9\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('x');
-if (($mode & 0777) == 0700) {print "ok 10\n";} else {print "not ok 10\n";}
-
-if ((unlink 'b','x') == 2) {print "ok 11\n";} else {print "not ok 11\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('b');
-if ($ino == 0) {print "ok 12\n";} else {print "not ok 12\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('x');
-if ($ino == 0) {print "ok 13\n";} else {print "not ok 13\n";}
-
-if (rename('a','b')) {print "ok 14\n";} else {print "not ok 14\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('a');
-if ($ino == 0) {print "ok 15\n";} else {print "not ok 15\n";}
-$foo = (utime 500000000,500000001,'b');
-if ($foo == 1) {print "ok 16\n";} else {print "not ok 16 $foo\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('b');
-if ($ino) {print "ok 17\n";} else {print "not ok 17\n";}
-if (($atime == 500000000 && $mtime == 500000001) || $wd =~ m#/afs/#)
- {print "ok 18\n";}
-else
- {print "not ok 18 $atime $mtime\n";}
-
-if ((unlink 'b') == 1) {print "ok 19\n";} else {print "not ok 19\n";}
-($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('b');
-if ($ino == 0) {print "ok 20\n";} else {print "not ok 20\n";}
-unlink 'c';
-
-chdir $wd || die "Can't cd back to $wd";
-
-unlink 'c';
-if (`ls -l perl 2>/dev/null` =~ /^l.*->/) { # we have symbolic links
- if (symlink("TEST","c")) {print "ok 21\n";} else {print "not ok 21\n";}
- $foo = `grep perl c`;
- if ($foo) {print "ok 22\n";} else {print "not ok 22\n";}
-}
-else {
- print "ok 21\nok 22\n";
-}
diff --git a/t/io/fs.t.rej b/t/io/fs.t.rej
deleted file mode 100644
index e519af0ed8..0000000000
--- a/t/io/fs.t.rej
+++ /dev/null
@@ -1,15 +0,0 @@
-***************
-*** 1,6 ****
- #!./perl
-
-! # $Header: fs.t,v 4.0 1991/03/20 01:50:55 lwall Locked $
-
- print "1..22\n";
-
---- 1,6 ----
- #!./perl
-
-! # $RCSfile: fs.t,v $$Revision: 4.0.1.1 $$Date: 1993/02/05 19:44:34 $
-
- print "1..22\n";
-
diff --git a/t/io/inplace.t b/t/io/inplace.t
index b8a5649056..477add1942 100644..100755
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -2,7 +2,7 @@
$^I = '.bak';
-# $Header: inplace.t,v 4.0 91/03/20 01:50:59 lwall Locked $
+# $RCSfile: inplace.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:29 $
print "1..2\n";
diff --git a/t/io/pipe.t b/t/io/pipe.t
index d41f5faaec..0133c39e49 100644..100755
--- a/t/io/pipe.t
+++ b/t/io/pipe.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: pipe.t,v 4.0 91/03/20 01:51:02 lwall Locked $
+# $RCSfile: pipe.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:31 $
$| = 1;
print "1..8\n";
diff --git a/t/io/print.t b/t/io/print.t
index 30294f51fa..180b1e88d7 100644..100755
--- a/t/io/print.t
+++ b/t/io/print.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: print.t,v 4.0 91/03/20 01:51:08 lwall Locked $
+# $RCSfile: print.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:32 $
print "1..16\n";
diff --git a/t/io/tell.t b/t/io/tell.t
index cb1fc4c3be..af012b08cf 100644..100755
--- a/t/io/tell.t
+++ b/t/io/tell.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: tell.t,v 4.0 91/03/20 01:51:14 lwall Locked $
+# $RCSfile: tell.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:33 $
print "1..13\n";
diff --git a/t/lib/big.t b/t/lib/big.t
index 23cd00beb5..23cd00beb5 100644..100755
--- a/t/lib/big.t
+++ b/t/lib/big.t
diff --git a/t/make.out b/t/make.out
new file mode 100644
index 0000000000..bc43d67974
--- /dev/null
+++ b/t/make.out
@@ -0,0 +1 @@
+forceme 'cd ..; make'
diff --git a/t/makefile b/t/makefile
new file mode 100644
index 0000000000..5ef5395865
--- /dev/null
+++ b/t/makefile
@@ -0,0 +1,7 @@
+all:
+ forceme 'cd ..; $(MAKE)'
+
+perl: fooperl
+
+fooperl:
+ forceme 'cd ..; $(MAKE) perl'
diff --git a/t/op/append.t b/t/op/append.t
index 9140c16b83..d11514615a 100644..100755
--- a/t/op/append.t
+++ b/t/op/append.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: append.t,v 4.0 91/03/20 01:51:23 lwall Locked $
+# $RCSfile: append.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:36 $
print "1..3\n";
diff --git a/t/op/array.t b/t/op/array.t
index 18fe288356..089fb5528e 100644..100755
--- a/t/op/array.t
+++ b/t/op/array.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: array.t,v 4.0 91/03/20 01:51:31 lwall Locked $
+# $RCSfile: array.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:37 $
print "1..36\n";
diff --git a/t/op/auto.t b/t/op/auto.t
index e1122a5774..93a42f8472 100644..100755
--- a/t/op/auto.t
+++ b/t/op/auto.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: auto.t,v 4.0 91/03/20 01:51:35 lwall Locked $
+# $RCSfile: auto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:39 $
print "1..34\n";
diff --git a/t/op/chop.t b/t/op/chop.t
index ba6d6262b3..d20b546465 100644..100755
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: chop.t,v 4.0 91/03/20 01:51:42 lwall Locked $
+# $RCSfile: chop.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:40 $
print "1..4\n";
diff --git a/t/op/cond.t b/t/op/cond.t
index 31baf9d05f..427efb4887 100644..100755
--- a/t/op/cond.t
+++ b/t/op/cond.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cond.t,v 4.0 91/03/20 01:51:47 lwall Locked $
+# $RCSfile: cond.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:41 $
print "1..4\n";
diff --git a/t/op/dbm.t b/t/op/dbm.t
index 647d3efb71..f09ca4febf 100644..100755
--- a/t/op/dbm.t
+++ b/t/op/dbm.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: dbm.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:43:02 $
+# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $
if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h'
&& !-r '/usr/include/rpcsvc/dbm.h') {
@@ -11,10 +11,18 @@ if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h'
print "1..12\n";
unlink <Op.dbmx.*>;
+unlink Op.dbmx; # in case we're running gdbm
+
umask(0);
print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
+
+$Dfile = "Op.dbmx.pag";
+if (! -e $Dfile) {
+ $Dfile = "Op.dbmx";
+ print "# Probably a gdbm database\n";
+}
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('Op.dbmx.pag');
+ $blksize,$blocks) = stat($Dfile);
print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
while (($key,$value) = each(h)) {
$i++;
@@ -93,7 +101,7 @@ for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; }
print ($ok ? "ok 8\n" : "not ok 8\n");
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
- $blksize,$blocks) = stat('Op.dbmx.pag');
+ $blksize,$blocks) = stat($Dfile);
print ($size > 0 ? "ok 9\n" : "not ok 9\n");
@h{0..200} = 200..400;
@@ -103,4 +111,4 @@ print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n";
print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n");
print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n");
-unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
+unlink 'Op.dbmx.dir', $Dfile;
diff --git a/t/op/delete.t b/t/op/delete.t
index b5920dd397..86ed9b47ba 100644..100755
--- a/t/op/delete.t
+++ b/t/op/delete.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: delete.t,v 4.0 91/03/20 01:51:56 lwall Locked $
+# $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $
print "1..6\n";
diff --git a/t/op/do.t b/t/op/do.t
index f75ca3010e..db4623720e 100644..100755
--- a/t/op/do.t
+++ b/t/op/do.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: do.t,v 4.0 91/03/20 01:52:08 lwall Locked $
+# $RCSfile: do.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:45 $
sub foo1
{
diff --git a/t/op/each.t b/t/op/each.t
index d759fda549..7a58fc8dcc 100644..100755
--- a/t/op/each.t
+++ b/t/op/each.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: each.t,v 4.0 91/03/20 01:52:14 lwall Locked $
+# $RCSfile: each.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:47 $
print "1..3\n";
diff --git a/t/op/eval.t b/t/op/eval.t
index 7bca608137..6d0a67b533 100644..100755
--- a/t/op/eval.t
+++ b/t/op/eval.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: eval.t,v $$Revision: 4.0.1.1 $$Date: 91/11/05 18:43:19 $
+# $RCSfile: eval.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:48 $
print "1..16\n";
@@ -15,7 +15,7 @@ eval "\$foo\n = # this is a comment\n'ok 4\n';";
print $foo;
print eval '
-$foo ='; # this tests for a call through yyerror()
+$foo =;'; # this tests for a call through yyerror()
if ($@ =~ /line 2/) {print "ok 5\n";} else {print "not ok 5\n";}
print eval '$foo = /'; # this tests for a call through fatal()
diff --git a/t/op/exec.t b/t/op/exec.t
index f3012fd2f9..1103a1a464 100644..100755
--- a/t/op/exec.t
+++ b/t/op/exec.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: exec.t,v 4.0 91/03/20 01:52:25 lwall Locked $
+# $RCSfile: exec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:49 $
$| = 1; # flush stdout
print "1..8\n";
diff --git a/t/op/exp.t b/t/op/exp.t
index 776d2634da..5efc9ba950 100644..100755
--- a/t/op/exp.t
+++ b/t/op/exp.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: exp.t,v 4.0 91/03/20 01:52:31 lwall Locked $
+# $RCSfile: exp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:50 $
print "1..6\n";
diff --git a/t/op/flip.t b/t/op/flip.t
index 35f100cdef..72425da3a2 100644..100755
--- a/t/op/flip.t
+++ b/t/op/flip.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: flip.t,v 4.0 91/03/20 01:52:36 lwall Locked $
+# $RCSfile: flip.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:52 $
print "1..8\n";
diff --git a/t/op/fork.t b/t/op/fork.t
index 55696fd98f..598310b63f 100644..100755
--- a/t/op/fork.t
+++ b/t/op/fork.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: fork.t,v 4.0 91/03/20 01:52:43 lwall Locked $
+# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $
$| = 1;
print "1..2\n";
diff --git a/t/op/glob.t b/t/op/glob.t
index 1250a72542..b4038442bd 100644..100755
--- a/t/op/glob.t
+++ b/t/op/glob.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: glob.t,v 4.0 91/03/20 01:52:49 lwall Locked $
+# $RCSfile: glob.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:55 $
print "1..4\n";
diff --git a/t/op/goto.t b/t/op/goto.t
index 29bf797a58..0b89921b94 100644..100755
--- a/t/op/goto.t
+++ b/t/op/goto.t
@@ -1,10 +1,10 @@
#!./perl
-# $RCSfile: goto.t,v $$Revision: 4.0.1.1 $$Date: 92/06/08 15:43:25 $
+# $RCSfile: goto.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:56 $
-print "1..3\n";
+print "1..5\n";
-while (0) {
+while ($?) {
$foo = 1;
label1:
$foo = 2;
@@ -31,3 +31,23 @@ if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";}
$x = `./perl -e 'goto foo;' 2>&1`;
if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";}
+
+sub foo {
+ goto bar;
+ print "not ok 4\n";
+ return;
+bar:
+ print "ok 4\n";
+}
+
+&foo;
+
+sub bar {
+ $x = 'exitcode';
+ eval "goto $x"; # Do not take this as exemplary code!!!
+}
+
+&bar;
+exit;
+exitcode:
+print "ok 5\n";
diff --git a/t/op/groups.t b/t/op/groups.t
index e1520cc3d6..4445953966 100644..100755
--- a/t/op/groups.t
+++ b/t/op/groups.t
@@ -26,7 +26,7 @@ for (split(' ', $()) {
$gr1 = join(' ', sort @gr);
-$gr2 = join(' ', grep(!$basegroup{$_}, sort split(' ',`/usr/ucb/groups`)));
+$gr2 = join(' ', grep(!$basegroup{$_}++, sort split(' ',`/usr/ucb/groups`)));
if ($gr1 eq $gr2) {
print "ok 1\n";
diff --git a/t/op/index.t b/t/op/index.t
index 7cc4fca5ca..0b08f0879d 100644..100755
--- a/t/op/index.t
+++ b/t/op/index.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: index.t,v 4.0 91/03/20 01:53:05 lwall Locked $
+# $RCSfile: index.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:59 $
print "1..20\n";
diff --git a/t/op/int.t b/t/op/int.t
index ff351aa0a3..eb060acd72 100644..100755
--- a/t/op/int.t
+++ b/t/op/int.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: int.t,v 4.0 91/03/20 01:53:08 lwall Locked $
+# $RCSfile: int.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:00 $
print "1..4\n";
diff --git a/t/op/join.t b/t/op/join.t
index b219af380d..eec4611e62 100644..100755
--- a/t/op/join.t
+++ b/t/op/join.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: join.t,v 4.0 91/03/20 01:53:17 lwall Locked $
+# $RCSfile: join.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:01 $
print "1..3\n";
diff --git a/t/op/list.t b/t/op/list.t
index 56fe09ca0a..a4230b681b 100644..100755
--- a/t/op/list.t
+++ b/t/op/list.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: list.t,v 4.0 91/03/20 01:53:24 lwall Locked $
+# $RCSfile: list.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:02 $
print "1..27\n";
diff --git a/t/op/local.t b/t/op/local.t
index 1f7608934f..5f007fd4f6 100644..100755
--- a/t/op/local.t
+++ b/t/op/local.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: local.t,v 4.0 91/03/20 01:53:29 lwall Locked $
+# $RCSfile: local.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:04 $
print "1..20\n";
diff --git a/t/op/magic.t b/t/op/magic.t
index f027d60d42..83420d2aab 100644..100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: magic.t,v 4.0 91/03/20 01:53:35 lwall Locked $
+# $RCSfile: magic.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:05 $
$| = 1; # command buffering
@@ -17,14 +17,24 @@ if ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";}
# the next tests are embedded inside system simply because sh spits out
# a newline onto stderr when a child process kills itself with SIGINT.
-system './perl',
-'-e', '$| = 1; # command buffering',
+system './perl', '-e', <<'END';
-'-e', '$SIG{"INT"} = "ok3"; kill 2,$$;',
-'-e', '$SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";',
-'-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";',
+ $| = 1; # command buffering
-'-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }';
+ $SIG{"INT"} = "ok3"; kill "INT",$$;
+ $SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";
+ $SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";
+
+ sub ok3 {
+ if (($x = pop(@_)) eq "INT") {
+ print "ok 3\n";
+ }
+ else {
+ print "not ok 3 $a\n";
+ }
+ }
+
+END
@val1 = @ENV{keys(%ENV)}; # can we slice ENV?
@val2 = values(%ENV);
diff --git a/t/op/mkdir.t b/t/op/mkdir.t
index 9186aa54e3..7db5ec91e4 100644..100755
--- a/t/op/mkdir.t
+++ b/t/op/mkdir.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: mkdir.t,v 4.0 91/03/20 01:53:39 lwall Locked $
+# $RCSfile: mkdir.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:06 $
print "1..7\n";
diff --git a/t/op/oct.t b/t/op/oct.t
index 1a9a92ec58..8ed0c9843a 100644..100755
--- a/t/op/oct.t
+++ b/t/op/oct.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: oct.t,v 4.0 91/03/20 01:53:43 lwall Locked $
+# $RCSfile: oct.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:08 $
print "1..3\n";
diff --git a/t/op/ord.t b/t/op/ord.t
index d95824f731..67b8e24686 100644..100755
--- a/t/op/ord.t
+++ b/t/op/ord.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: ord.t,v 4.0 91/03/20 01:53:50 lwall Locked $
+# $RCSfile: ord.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:09 $
print "1..2\n";
diff --git a/t/op/pack.t b/t/op/pack.t
index aa498c5846..859d48f70d 100644..100755
--- a/t/op/pack.t
+++ b/t/op/pack.t
@@ -1,8 +1,8 @@
#!./perl
-# $Header: pack.t,v 4.0 91/03/20 01:53:57 lwall Locked $
+# $RCSfile: pack.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:11 $
-print "1..3\n";
+print "1..8\n";
$format = "c2x5CCxsdila6";
# Need the expression in here to force ary[5] to be numeric. This avoids
@@ -18,3 +18,25 @@ $out2=join(':',@ary2);
print ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n");
print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n");
+
+# How about counting bits?
+
+print +($x = unpack("%32B*", "\001\002\004\010\020\040\100\200\377")) == 16
+ ? "ok 4\n" : "not ok 4 $x\n";
+
+print +($x = unpack("%32b69", "\001\002\004\010\020\040\100\200\017")) == 12
+ ? "ok 5\n" : "not ok 5 $x\n";
+
+print +($x = unpack("%32B69", "\001\002\004\010\020\040\100\200\017")) == 9
+ ? "ok 6\n" : "not ok 6 $x\n";
+
+print +($x = unpack("%32B*", "Now is the time for all good blurfl")) == 129
+ ? "ok 7\n" : "not ok 7 $x\n";
+
+open(BIN, "./perl") || die "Can't open ../perl: $!\n";
+sysread BIN, $foo, 8192;
+close BIN;
+
+$sum = unpack("%32b*", $foo);
+$longway = unpack("b*", $foo);
+print $sum == $longway =~ tr/1/1/ ? "ok 8\n" : "not ok 8\n";
diff --git a/t/op/pat.t b/t/op/pat.t
index 8c3adc975d..a669526177 100644..100755
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: pat.t,v $$Revision: 4.0.1.2 $$Date: 91/06/10 01:29:34 $
+# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $
print "1..51\n";
diff --git a/t/op/push.t b/t/op/push.t
index 721b63f2f7..68fab66af7 100644..100755
--- a/t/op/push.t
+++ b/t/op/push.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: push.t,v 4.0 91/03/20 01:54:07 lwall Locked $
+# $RCSfile: push.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:13 $
@tests = split(/\n/, <<EOF);
0 3, 0 1 2, 3 4 5 6 7
@@ -28,11 +28,16 @@ if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";
$test = 3;
foreach $line (@tests) {
($list,$get,$leave) = split(/,\t*/,$line);
- @list = split(' ',$list);
+ ($pos, $len, @list) = split(' ',$list);
@get = split(' ',$get);
@leave = split(' ',$leave);
@x = (0,1,2,3,4,5,6,7);
- @got = splice(@x,@list);
+ if (defined $len) {
+ @got = splice(@x, $pos, $len, @list);
+ }
+ else {
+ @got = splice(@x, $pos);
+ }
if (join(':',@got) eq join(':',@get) &&
join(':',@x) eq join(':',@leave)) {
print "ok ",$test++,"\n";
diff --git a/t/op/range.t b/t/op/range.t
index 9ab7892636..746da46800 100644..100755
--- a/t/op/range.t
+++ b/t/op/range.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: range.t,v 4.0 91/03/20 01:54:11 lwall Locked $
+# $RCSfile: range.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:14 $
print "1..8\n";
diff --git a/t/op/read.t b/t/op/read.t
index 019324ce33..8c571c035b 100644..100755
--- a/t/op/read.t
+++ b/t/op/read.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: read.t,v 4.0 91/03/20 01:54:16 lwall Locked $
+# $RCSfile: read.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:17 $
print "1..4\n";
diff --git a/t/op/readdir.t b/t/op/readdir.t
index 18006991cd..18006991cd 100644..100755
--- a/t/op/readdir.t
+++ b/t/op/readdir.t
diff --git a/t/op/ref.t b/t/op/ref.t
new file mode 100755
index 0000000000..cace1e14bd
--- /dev/null
+++ b/t/op/ref.t
@@ -0,0 +1,179 @@
+#!./perl
+
+print "1..37\n";
+
+# Test glob operations.
+
+$bar = "ok 1\n";
+$foo = "ok 2\n";
+{
+ local(*foo) = *bar;
+ print $foo;
+}
+print $foo;
+
+$baz = "ok 3\n";
+$foo = "ok 4\n";
+{
+ local(*foo) = 'baz';
+ print $foo;
+}
+print $foo;
+
+$foo = "ok 6\n";
+{
+ local(*foo);
+ print $foo;
+ $foo = "ok 5\n";
+ print $foo;
+}
+print $foo;
+
+# Test fake references.
+
+$baz = "ok 7\n";
+$bar = 'baz';
+$foo = 'bar';
+print $$$foo;
+
+# Test real references.
+
+$FOO = \$BAR;
+$BAR = \$BAZ;
+$BAZ = "ok 8\n";
+print $$$FOO;
+
+# Test references to real arrays.
+
+@ary = (9,10,11,12);
+$ref[0] = \@a;
+$ref[1] = \@b;
+$ref[2] = \@c;
+$ref[3] = \@d;
+for $i (3,1,2,0) {
+ push(@{$ref[$i]}, "ok $ary[$i]\n");
+}
+print @a;
+print ${$ref[1]}[0];
+print @{$ref[2]}[0];
+print @{'d'};
+
+# Test references to references.
+
+$refref = \\$x;
+$x = "ok 13\n";
+print $$$refref;
+
+# Test nested anonymous lists.
+
+$ref = [[],2,[3,4,5,]];
+print scalar @$ref == 3 ? "ok 14\n" : "not ok 14\n";
+print $$ref[1] == 2 ? "ok 15\n" : "not ok 15\n";
+print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n";
+print scalar @{$$ref[0]} == 0 ? "ok 17\n" : "not ok 17\n";
+
+print $ref->[1] == 2 ? "ok 18\n" : "not ok 18\n";
+print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 18\n";
+
+# Test references to hashes of references.
+
+$refref = \%whatever;
+$refref->{"key"} = $ref;
+print $refref->{"key"}->[2]->[0] == 3 ? "ok 20\n" : "not ok 20\n";
+
+# Test to see if anonymous subarrays sprint into existence.
+
+$spring[5]->[0] = 123;
+$spring[5]->[1] = 456;
+push(@{$spring[5]}, 789);
+print join(':',@{$spring[5]}) eq "123:456:789" ? "ok 21\n" : "not ok 21\n";
+
+# Test to see if anonymous subhashes sprint into existence.
+
+@{$spring2{"foo"}} = (1,2,3);
+$spring2{"foo"}->[3] = 4;
+print join(':',@{$spring2{"foo"}}) eq "1:2:3:4" ? "ok 22\n" : "not ok 22\n";
+
+# Test references to subroutines.
+
+sub mysub { print "ok 23\n" }
+$subref = \&mysub;
+&$subref;
+
+$subrefref = \\&mysub2;
+&$$subrefref("ok 24\n");
+sub mysub2 { print shift }
+
+# Test the ref operator.
+
+print ref $subref eq CODE ? "ok 25\n" : "not ok 25\n";
+print ref $ref eq ARRAY ? "ok 26\n" : "not ok 26\n";
+print ref $refref eq HASH ? "ok 27\n" : "not ok 27\n";
+
+# Test anonymous hash syntax.
+
+$anonhash = {};
+print ref $anonhash eq HASH ? "ok 28\n" : "not ok 28\n";
+$anonhash2 = {FOO => BAR, ABC => XYZ,};
+print join('', sort values %$anonhash2) eq BARXYZ ? "ok 29\n" : "not ok 29\n";
+
+# Test bless operator.
+
+package MYHASH;
+
+$object = bless $main'anonhash2;
+print ref $object eq MYHASH ? "ok 30\n" : "not ok 30\n";
+print $object->{ABC} eq XYZ ? "ok 31\n" : "not ok 31\n";
+
+$object2 = bless {};
+print ref $object2 eq MYHASH ? "ok 32\n" : "not ok 32\n";
+
+# Test ordinary call on object method.
+
+&mymethod($object,33);
+
+sub mymethod {
+ local($THIS, @ARGS) = @_;
+ die "Not a MYHASH" unless ref $THIS eq MYHASH;
+ print $THIS->{FOO} eq BAR ? "ok $ARGS[0]\n" : "not ok $ARGS[0]\n";
+}
+
+# Test automatic destructor call.
+
+$string = "not ok 34\n";
+$object = "foo";
+$string = "ok 34\n";
+$main'anonhash2 = "foo";
+$string = "not ok 34\n";
+
+sub DESTROY {
+ print $string;
+
+ # Test that the object has already been "cursed".
+ print ref shift eq HASH ? "ok 35\n" : "not ok 35\n";
+}
+
+# Now test inheritance of methods.
+
+package OBJ;
+
+@ISA = (BASEOBJ);
+
+$main'object = bless {FOO => foo, BAR => bar};
+
+package main;
+
+# Test arrow-style method invocation.
+
+print $object->doit("BAR") eq bar ? "ok 36\n" : "not ok 36\n";
+
+# Test indirect-object-style method invocation.
+
+$foo = doit $object "FOO";
+print $foo eq foo ? "ok 37\n" : "not ok 37\n";
+
+sub BASEOBJ'doit {
+ local $ref = shift;
+ die "Not an OBJ" unless ref $ref eq OBJ;
+ $ref->{shift};
+}
diff --git a/t/op/regexp.t b/t/op/regexp.t
index e488a82a61..af8a66610d 100644..100755
--- a/t/op/regexp.t
+++ b/t/op/regexp.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: regexp.t,v $$Revision: 4.0.1.1 $$Date: 91/06/10 01:30:29 $
+# $RCSfile: regexp.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:20 $
open(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests')
|| die "Can't open re_tests";
diff --git a/t/op/repeat.t b/t/op/repeat.t
index a494b99f96..54fa590836 100644..100755
--- a/t/op/repeat.t
+++ b/t/op/repeat.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: repeat.t,v 4.0 91/03/20 01:54:26 lwall Locked $
+# $RCSfile: repeat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:21 $
print "1..19\n";
diff --git a/t/op/s.t b/t/op/s.t
index 323d374809..0f554b6ee6 100644..100755
--- a/t/op/s.t
+++ b/t/op/s.t
@@ -1,8 +1,8 @@
#!./perl
-# $Header: s.t,v 4.0 91/03/20 01:54:30 lwall Locked $
+# $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $
-print "1..51\n";
+print "1..56\n";
$x = 'foo';
$_ = "x";
@@ -21,7 +21,7 @@ print "#3\t:$_: eq :\$x foo:\n";
if ($_ eq '$x foo') {print "ok 3\n";} else {print "not ok 3\n";}
$b = 'cd';
-($a = 'abcdef') =~ s'(b${b}e)'\n$1';
+($a = 'abcdef') =~ s<(b${b}e)>'\n$1';
print "#4\t:$1: eq :bcde:\n";
print "#4\t:$a: eq :a\\n\$1f:\n";
if ($1 eq 'bcde' && $a eq 'a\n$1f') {print "ok 4\n";} else {print "not ok 4\n";}
@@ -177,3 +177,24 @@ $_ = "Now is the %#*! time for all good men...";
print (($x=(y/a-zA-Z //cd)) == 7 ? "ok 50\n" : "not ok 50\n");
print y/ / /s == 8 ? "ok 51\n" : "not ok 51\n";
+$_ = 'abcdefghijklmnopqrstuvwxyz0123456789';
+tr/a-z/A-Z/;
+
+print $_ eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789' ? "ok 52\n" : "not ok 52\n";
+
+# same as tr/A-Z/a-z/;
+y[\101-\132][\141-\172];
+
+print $_ eq 'abcdefghijklmnopqrstuvwxyz0123456789' ? "ok 53\n" : "not ok 53\n";
+
+$_ = '+,-';
+tr/+--/a-c/;
+print $_ eq 'abc' ? "ok 54\n" : "not ok 54\n";
+
+$_ = '+,-';
+tr/+\--/a\/c/;
+print $_ eq 'a,/' ? "ok 55\n" : "not ok 55\n";
+
+$_ = '+,-';
+tr/-+,/ab\-/;
+print $_ eq 'b-a' ? "ok 56\n" : "not ok 56\n";
diff --git a/t/op/sleep.t b/t/op/sleep.t
index c26d397d2f..07cdb826d1 100644..100755
--- a/t/op/sleep.t
+++ b/t/op/sleep.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: sleep.t,v 4.0 91/03/20 01:54:34 lwall Locked $
+# $RCSfile: sleep.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:23 $
print "1..1\n";
diff --git a/t/op/sort.t b/t/op/sort.t
index 658a5bd1bc..bf7a31759c 100644..100755
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: sort.t,v $$Revision: 4.0.1.2 $$Date: 91/11/11 16:43:47 $
+# $RCSfile: sort.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:24 $
print "1..10\n";
diff --git a/t/op/split.t b/t/op/split.t
index 34327cbd42..d87998e098 100644..100755
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: split.t,v 4.0 91/03/20 01:54:42 lwall Locked $
+# $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $
print "1..12\n";
@@ -48,7 +48,7 @@ print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n";
# Does assignment to a list imply split to one more field than that?
$foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`;
-print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n";
+print $foo =~ /DEBUGGING/ || $foo =~ /SV = IV\(3\)/ ? "ok 11\n" : "not ok 11\n";
# Can we say how many fields to split to when assigning to a list?
($a,$b) = split(' ','1 2 3 4 5 6', 2);
diff --git a/t/op/sprintf.t b/t/op/sprintf.t
index 6155612aeb..8e1ef6958f 100644..100755
--- a/t/op/sprintf.t
+++ b/t/op/sprintf.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: sprintf.t,v 4.0 91/03/20 01:54:46 lwall Locked $
+# $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $
print "1..1\n";
diff --git a/t/op/stat.t b/t/op/stat.t
index 78b97dc191..b361da2df9 100644..100755
--- a/t/op/stat.t
+++ b/t/op/stat.t
@@ -1,6 +1,6 @@
#!./perl
-# $RCSfile: stat.t,v $$Revision: 4.0.1.3 $$Date: 91/11/11 16:44:49 $
+# $RCSfile: stat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:28 $
print "1..56\n";
@@ -122,7 +122,10 @@ while (defined($_ = <*>)) {
chdir $cwd || die "Can't cd back to $cwd";
# I suppose this is going to fail somewhere...
-if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
+if ($uid > 0 && $uid < $cnt)
+ {print "ok 35\n";}
+else
+ {print "not ok 35 ($uid $cnt)\n";}
unless (open(tty,"/dev/tty")) {
print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
diff --git a/t/op/study.t b/t/op/study.t
index 01e33fa613..ea3b366f0b 100644..100755
--- a/t/op/study.t
+++ b/t/op/study.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: study.t,v 4.0 91/03/20 01:54:59 lwall Locked $
+# $RCSfile: study.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:30 $
print "1..24\n";
diff --git a/t/op/substr.t b/t/op/substr.t
index 12ad531c49..25336365b9 100644..100755
--- a/t/op/substr.t
+++ b/t/op/substr.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: substr.t,v 4.0 91/03/20 01:55:05 lwall Locked $
+# $RCSfile: substr.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:31 $
print "1..22\n";
diff --git a/t/op/time.t b/t/op/time.t
index 28635219fe..347592dab4 100644..100755
--- a/t/op/time.t
+++ b/t/op/time.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: time.t,v 4.0 91/03/20 01:55:09 lwall Locked $
+# $RCSfile: time.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:32 $
print "1..5\n";
diff --git a/t/op/undef.t b/t/op/undef.t
index fc73cf85d5..8ab2ec421f 100644..100755
--- a/t/op/undef.t
+++ b/t/op/undef.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: undef.t,v 4.0 91/03/20 01:55:16 lwall Locked $
+# $RCSfile: undef.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:34 $
print "1..21\n";
diff --git a/t/op/unshift.t b/t/op/unshift.t
index fec68e183b..68d37756bd 100644..100755
--- a/t/op/unshift.t
+++ b/t/op/unshift.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: unshift.t,v 4.0 91/03/20 01:55:21 lwall Locked $
+# $RCSfile: unshift.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:35 $
print "1..2\n";
diff --git a/t/op/vec.t b/t/op/vec.t
index e8fe018ba8..97b6d60989 100644..100755
--- a/t/op/vec.t
+++ b/t/op/vec.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: vec.t,v 4.0 91/03/20 01:55:28 lwall Locked $
+# $RCSfile: vec.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:36 $
print "1..13\n";
diff --git a/t/op/write.t b/t/op/write.t
index e51a09088c..35aba42eaa 100644..100755
--- a/t/op/write.t
+++ b/t/op/write.t
@@ -1,6 +1,6 @@
#!./perl
-# $Header: write.t,v 4.0 91/03/20 01:55:34 lwall Locked $
+# $RCSfile: write.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:38 $
print "1..3\n";
diff --git a/t/perl b/t/perl
new file mode 120000
index 0000000000..f2271dea4a
--- /dev/null
+++ b/t/perl
@@ -0,0 +1 @@
+../perl \ No newline at end of file
diff --git a/t/perl5a1.tar b/t/perl5a1.tar
new file mode 100644
index 0000000000..0c0b43ce1b
--- /dev/null
+++ b/t/perl5a1.tar
Binary files differ
diff --git a/t/tmp/bullet b/t/tmp/bullet
new file mode 100644
index 0000000000..048f271a1f
--- /dev/null
+++ b/t/tmp/bullet
@@ -0,0 +1,13 @@
+
+ Upgrades to obed
+
+ * design high-level API and use it
+ * minimize oidtypes usage and boot time
+ * use more metadata (read-only attributes, etc.)
+ * use compiled types
+ * collection generators and filters
+ * type-directed entry
+ * event interlocking
+ * cloning app window
+ * add accelerators
+ * study scaling and psychology (does it feel fast?)
diff --git a/t/x b/t/x
new file mode 100755
index 0000000000..da86751a73
--- /dev/null
+++ b/t/x
@@ -0,0 +1,3 @@
+#!./perl -Dx
+
+$foo !~ /foo/;