summaryrefslogtreecommitdiff
path: root/t
diff options
context:
space:
mode:
authorLarry Wall <larry@wall.org>1989-10-18 00:00:00 +0000
committerLarry Wall <larry@wall.org>1989-10-18 00:00:00 +0000
commita687059cbaf2c6fdccb5e0fae2aee80ec15625a8 (patch)
tree674c8533b7bd942204f23782934c72f8624dd308 /t
parent13281fa4f8547e0eb31d1986b865d9b7ec7d0dcc (diff)
downloadperl-a687059cbaf2c6fdccb5e0fae2aee80ec15625a8.tar.gz
perl 3.0: (no announcement message available)perl-3.000
A few of the new features: (18 Oct) * Perl can now handle binary data correctly and has functions to pack and unpack binary structures into arrays or lists. You can now do arbitrary ioctl functions. * You can now pass things to subroutines by reference. * Debugger enhancements. * An array or associative array may now appear in a local() list. * Array values may now be interpolated into strings. * Subroutine names are now distinguished by prefixing with &. You can call subroutines without using do, and without passing any argument list at all. * You can use the new -u switch to cause perl to dump core so that you can run undump and produce a binary executable image. Alternately you can use the "dump" operator after initializing any variables and such. * You can now chop lists. * Perl now uses /bin/csh to do filename globbing, if available. This means that filenames with spaces or other strangenesses work right. * New functions: mkdir and rmdir, getppid, getpgrp and setpgrp, getpriority and setpriority, chroot, ioctl and fcntl, flock, readlink, lstat, rindex, pack and unpack, read, warn, dbmopen and dbmclose, dump, reverse, defined, undef.
Diffstat (limited to 't')
-rw-r--r--t/TEST9
-rw-r--r--t/base.cond2
-rw-r--r--t/base.if2
-rw-r--r--t/base.lex45
-rw-r--r--t/base.pat2
-rw-r--r--t/base.term2
-rw-r--r--t/cmd.elsif10
-rw-r--r--t/cmd.for4
-rw-r--r--t/cmd.mod9
-rw-r--r--t/cmd.subval37
-rw-r--r--t/cmd.switch75
-rw-r--r--t/cmd.while4
-rw-r--r--t/comp.cmdopt2
-rw-r--r--t/comp.cpp2
-rw-r--r--t/comp.decl2
-rw-r--r--t/comp.multiline2
-rw-r--r--t/comp.package33
-rw-r--r--t/comp.script2
-rw-r--r--t/comp.term11
-rw-r--r--t/io.argv2
-rw-r--r--t/io.dup28
-rw-r--r--t/io.fs7
-rw-r--r--t/io.inplace2
-rw-r--r--t/io.pipe4
-rw-r--r--t/io.print8
-rw-r--r--t/io.tell2
-rw-r--r--t/op.append2
-rw-r--r--t/op.array100
-rw-r--r--t/op.auto2
-rw-r--r--t/op.chop15
-rw-r--r--t/op.cond2
-rw-r--r--t/op.dbm95
-rw-r--r--t/op.delete8
-rw-r--r--t/op.do2
-rw-r--r--t/op.each12
-rw-r--r--t/op.eval4
-rw-r--r--t/op.exec2
-rw-r--r--t/op.exp2
-rw-r--r--t/op.flip2
-rw-r--r--t/op.fork2
-rw-r--r--t/op.glob22
-rw-r--r--t/op.goto2
-rw-r--r--t/op.index26
-rw-r--r--t/op.int2
-rw-r--r--t/op.join2
-rw-r--r--t/op.list36
-rw-r--r--t/op.local45
-rw-r--r--t/op.magic9
-rw-r--r--t/op.mkdir15
-rw-r--r--t/op.oct2
-rw-r--r--t/op.ord2
-rw-r--r--t/op.pack18
-rw-r--r--t/op.pat29
-rw-r--r--t/op.push6
-rw-r--r--t/op.range30
-rw-r--r--t/op.read19
-rw-r--r--t/op.regexp2
-rw-r--r--t/op.repeat2
-rw-r--r--t/op.sleep2
-rw-r--r--t/op.sort19
-rw-r--r--t/op.split28
-rw-r--r--t/op.sprintf6
-rw-r--r--t/op.stat7
-rw-r--r--t/op.study2
-rw-r--r--t/op.subst122
-rw-r--r--t/op.substr42
-rw-r--r--t/op.time2
-rw-r--r--t/op.undef56
-rw-r--r--t/op.unshift2
-rw-r--r--t/op.vec24
-rw-r--r--t/op.write87
-rw-r--r--t/re_tests12
72 files changed, 1119 insertions, 119 deletions
diff --git a/t/TEST b/t/TEST
index 9ee217501f..e9ed3e9d4b 100644
--- a/t/TEST
+++ b/t/TEST
@@ -1,10 +1,12 @@
#!./perl
-# $Header: TEST,v 2.0 88/06/05 00:11:47 root Exp $
+# $Header: TEST,v 3.0 89/10/18 15:24:06 lwall Locked $
# This is written in a peculiar style, since we're trying to avoid
# most of the constructs we'll be testing for.
+$| = 1;
+
if ($ARGV[0] eq '-v') {
$verbose = 1;
shift;
@@ -28,7 +30,10 @@ while ($test = shift) {
if ($test =~ /\.orig$/) {
next;
}
- print "$test...";
+ if ($test =~ /~$/) {
+ next;
+ }
+ print "$test" . '.' x (16 - length($test));
if ($sharpbang) {
open(results,"./$test|") || (print "can't run.\n");
} else {
diff --git a/t/base.cond b/t/base.cond
index 201b39896e..c23f593bb2 100644
--- a/t/base.cond
+++ b/t/base.cond
@@ -1,6 +1,6 @@
#!./perl
-# $Header: base.cond,v 2.0 88/06/05 00:11:52 root Exp $
+# $Header: base.cond,v 3.0 89/10/18 15:24:11 lwall Locked $
# make sure conditional operators work
diff --git a/t/base.if b/t/base.if
index 250d55ba1f..234ddc981d 100644
--- a/t/base.if
+++ b/t/base.if
@@ -1,6 +1,6 @@
#!./perl
-# $Header: base.if,v 2.0 88/06/05 00:12:02 root Exp $
+# $Header: base.if,v 3.0 89/10/18 15:24:17 lwall Locked $
print "1..2\n";
diff --git a/t/base.lex b/t/base.lex
index e778c72caf..16f0dd90a3 100644
--- a/t/base.lex
+++ b/t/base.lex
@@ -1,8 +1,8 @@
#!./perl
-# $Header: base.lex,v 2.0 88/06/05 00:12:06 root Exp $
+# $Header: base.lex,v 3.0 89/10/18 15:24:24 lwall Locked $
-print "1..7\n";
+print "1..18\n";
$ # this is the register <space>
= 'x';
@@ -35,3 +35,44 @@ eval '$foo = 123+123.4+123e4+123.4E5+123.4e+5+.12;';
$foo = int($foo * 100 + .5);
if ($foo eq 2591024652) {print "ok 7\n";} else {print "not ok 7\n";}
+
+print <<'EOF';
+ok 8
+EOF
+
+$foo = 'ok 9';
+print <<EOF;
+$foo
+EOF
+
+eval <<\EOE, print $@;
+print <<'EOF';
+ok 10
+EOF
+
+$foo = 'ok 11';
+print <<EOF;
+$foo
+EOF
+EOE
+
+print <<`EOS` . <<\EOF;
+echo ok 12
+EOS
+ok 13
+EOF
+
+print qq/ok 14\n/;
+print qq(ok 15\n);
+
+print qq
+ok 16\n
+;
+
+print q<ok 17
+>;
+
+print <<; # Yow!
+ok 18
+
+# previous line intentionally left blank.
diff --git a/t/base.pat b/t/base.pat
index 54591dd7fa..a026a86ce6 100644
--- a/t/base.pat
+++ b/t/base.pat
@@ -1,6 +1,6 @@
#!./perl
-# $Header: base.pat,v 2.0 88/06/05 00:12:08 root Exp $
+# $Header: base.pat,v 3.0 89/10/18 15:24:30 lwall Locked $
print "1..2\n";
diff --git a/t/base.term b/t/base.term
index eba2f6dcf6..945dedda5c 100644
--- a/t/base.term
+++ b/t/base.term
@@ -1,6 +1,6 @@
#!./perl
-# $Header: base.term,v 2.0 88/06/05 00:12:13 root Exp $
+# $Header: base.term,v 3.0 89/10/18 15:24:34 lwall Locked $
print "1..6\n";
diff --git a/t/cmd.elsif b/t/cmd.elsif
index 3ec8b7f8fd..8079bee524 100644
--- a/t/cmd.elsif
+++ b/t/cmd.elsif
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cmd.elsif,v 2.0 88/06/05 00:12:16 root Exp $
+# $Header: cmd.elsif,v 3.0 89/10/18 15:24:38 lwall Locked $
sub foo {
if ($_[0] == 1) {
@@ -19,7 +19,7 @@ sub foo {
print "1..4\n";
-if (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1\n";}
-if (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2\n";}
-if (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3\n";}
-if (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4\n";}
+if (($x = do foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
+if (($x = do foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";}
+if (($x = do foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";}
+if (($x = do foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";}
diff --git a/t/cmd.for b/t/cmd.for
index 6342c89586..89bf9d33e5 100644
--- a/t/cmd.for
+++ b/t/cmd.for
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cmd.for,v 2.0 88/06/05 00:12:19 root Exp $
+# $Header: cmd.for,v 3.0 89/10/18 15:24:43 lwall Locked $
print "1..7\n";
@@ -42,7 +42,7 @@ print $ary[1];
for (split(' ','a b c d e')) {
$foo .= $_;
}
-if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5\n";}
+if ($foo eq '3210abcde') {print "ok 5\n";} else {print "not ok 5 $foo\n";}
foreach $foo (("ok 6\n","ok 7\n")) {
print $foo;
diff --git a/t/cmd.mod b/t/cmd.mod
index 48787efb86..f6b8a6e738 100644
--- a/t/cmd.mod
+++ b/t/cmd.mod
@@ -1,8 +1,8 @@
#!./perl
-# $Header: cmd.mod,v 2.0 88/06/05 00:12:23 root Exp $
+# $Header: cmd.mod,v 3.0 89/10/18 15:24:48 lwall Locked $
-print "1..6\n";
+print "1..7\n";
print "ok 1\n" if 1;
print "not ok 1\n" unless 1;
@@ -26,3 +26,8 @@ if (join(' ',@x) eq '0 1 2 3 4 5 6 7 8 9 10') {
$x = 15;
$x = 10 while $x < 10;
if ($x == 15) {print "ok 6\n";} else {print "not ok 6\n";}
+
+open(foo,'TEST') || open(foo,'t/TEST');
+$x = 0;
+$x++ while <foo>;
+print $x > 50 && $x < 1000 ? "ok 7\n" : "not ok 7\n";
diff --git a/t/cmd.subval b/t/cmd.subval
index 490276ae05..e2dc47bbed 100644
--- a/t/cmd.subval
+++ b/t/cmd.subval
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cmd.subval,v 2.0 88/06/05 00:12:26 root Exp $
+# $Header: cmd.subval,v 3.0 89/10/18 15:24:52 lwall Locked $
sub foo1 {
'true1';
@@ -9,7 +9,8 @@ sub foo1 {
sub foo2 {
'true1';
- if ($_[0]) { 'true2'; } else { 'true3'; }
+ if ($_[0]) { return 'true2'; } else { return 'true3'; }
+ 'true0';
}
sub foo3 {
@@ -32,22 +33,22 @@ sub foo6 {
'true2' unless $_[0];
}
-print "1..22\n";
+print "1..26\n";
-if (do foo1(0) eq '') {print "ok 1\n";} else {print "not ok 1\n";}
+if (do foo1(0) eq '0') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
if (do foo1(1) eq 'true2') {print "ok 2\n";} else {print "not ok 2\n";}
if (do foo2(0) eq 'true3') {print "ok 3\n";} else {print "not ok 3\n";}
if (do foo2(1) eq 'true2') {print "ok 4\n";} else {print "not ok 4\n";}
if (do foo3(0) eq 'true2') {print "ok 5\n";} else {print "not ok 5\n";}
-if (do foo3(1) eq '') {print "ok 6\n";} else {print "not ok 6\n";}
+if (do foo3(1) eq '1') {print "ok 6\n";} else {print "not ok 6\n";}
if (do foo4(0) eq 'true2') {print "ok 7\n";} else {print "not ok 7\n";}
if (do foo4(1) eq 'true3') {print "ok 8\n";} else {print "not ok 8\n";}
-if (do foo5(0) eq '') {print "ok 9\n";} else {print "not ok 9\n";}
+if (do foo5(0) eq '0') {print "ok 9\n";} else {print "not ok 9\n";}
if (do foo5(1) eq 'true2') {print "ok 10\n";} else {print "not ok 10\n";}
if (do foo6(0) eq 'true2') {print "ok 11\n";} else {print "not ok 11\n";}
-if (do foo6(1) eq '') {print "ok 12\n";} else {print "not ok 12\n";}
+if (do foo6(1) eq '1') {print "ok 12\n";} else {print "not ok 12 $x\n";}
# Now test to see that recursion works using a Fibonacci number generator
@@ -76,3 +77,25 @@ for ($i = 1; $i <= 10; $i++) {
print "not ok $foo\n";
}
}
+
+sub ary1 {
+ (1,2,3);
+}
+
+print &ary1 eq 3 ? "ok 23\n" : "not ok 23\n";
+
+print join(':',&ary1) eq '1:2:3' ? "ok 24\n" : "not ok 24\n";
+
+sub ary2 {
+ do {
+ return (1,2,3);
+ (3,2,1);
+ };
+ 0;
+}
+
+print &ary2 eq 3 ? "ok 25\n" : "not ok 25\n";
+
+$x = join(':',&ary2);
+print $x eq '1:2:3' ? "ok 26\n" : "not ok 26 $x\n";
+
diff --git a/t/cmd.switch b/t/cmd.switch
new file mode 100644
index 0000000000..315039d36e
--- /dev/null
+++ b/t/cmd.switch
@@ -0,0 +1,75 @@
+#!./perl
+
+# $Header: cmd.switch,v 3.0 89/10/18 15:25:00 lwall Locked $
+
+print "1..18\n";
+
+sub foo1 {
+ $_ = shift(@_);
+ $a = 0;
+ until ($a++) {
+ next if $_ eq 1;
+ next if $_ eq 2;
+ next if $_ eq 3;
+ next if $_ eq 4;
+ return 20;
+ }
+ continue {
+ return $_;
+ }
+}
+
+print do foo1(0) == 20 ? "ok 1\n" : "not ok 1\n";
+print do foo1(1) == 1 ? "ok 2\n" : "not ok 2\n";
+print do foo1(2) == 2 ? "ok 3\n" : "not ok 3\n";
+print do foo1(3) == 3 ? "ok 4\n" : "not ok 4\n";
+print do foo1(4) == 4 ? "ok 5\n" : "not ok 5\n";
+print do foo1(5) == 20 ? "ok 6\n" : "not ok 6\n";
+
+sub foo2 {
+ $_ = shift(@_);
+ {
+ last if $_ == 1;
+ last if $_ == 2;
+ last if $_ == 3;
+ last if $_ == 4;
+ }
+ continue {
+ return 20;
+ }
+ return $_;
+}
+
+print do foo2(0) == 20 ? "ok 7\n" : "not ok 1\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";
+print do foo2(4) == 4 ? "ok 11\n" : "not ok 11\n";
+print do foo2(5) == 20 ? "ok 12\n" : "not ok 12\n";
+
+sub foo3 {
+ $_ = shift(@_);
+ if (/^1/) {
+ return 1;
+ }
+ elsif (/^2/) {
+ return 2;
+ }
+ elsif (/^3/) {
+ return 3;
+ }
+ elsif (/^4/) {
+ return 4;
+ }
+ else {
+ return 20;
+ }
+ return 40;
+}
+
+print do foo3(0) == 20 ? "ok 13\n" : "not ok 13\n";
+print do foo3(1) == 1 ? "ok 14\n" : "not ok 14\n";
+print do foo3(2) == 2 ? "ok 15\n" : "not ok 15\n";
+print do foo3(3) == 3 ? "ok 16\n" : "not ok 16\n";
+print do foo3(4) == 4 ? "ok 17\n" : "not ok 17\n";
+print do foo3(5) == 20 ? "ok 18\n" : "not ok 18\n";
diff --git a/t/cmd.while b/t/cmd.while
index a48318897f..53fdb1014a 100644
--- a/t/cmd.while
+++ b/t/cmd.while
@@ -1,6 +1,6 @@
#!./perl
-# $Header: cmd.while,v 2.0 88/06/05 00:12:31 root Exp $
+# $Header: cmd.while,v 3.0 89/10/18 15:25:07 lwall Locked $
print "1..10\n";
@@ -18,7 +18,7 @@ open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp.";
while (<fh>) {
last if /vt100/;
}
-if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1\n";}
+if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";}
# test "next" command
diff --git a/t/comp.cmdopt b/t/comp.cmdopt
index 48b235c387..3ae5a6629f 100644
--- a/t/comp.cmdopt
+++ b/t/comp.cmdopt
@@ -1,6 +1,6 @@
#!./perl
-# $Header: comp.cmdopt,v 2.0 88/06/05 00:12:34 root Exp $
+# $Header: comp.cmdopt,v 3.0 89/10/18 15:25:13 lwall Locked $
print "1..40\n";
diff --git a/t/comp.cpp b/t/comp.cpp
index d9e21fe2c1..592700d385 100644
--- a/t/comp.cpp
+++ b/t/comp.cpp
@@ -1,6 +1,6 @@
#!./perl -P
-# $Header: comp.cpp,v 2.0 88/06/05 00:12:37 root Exp $
+# $Header: comp.cpp,v 3.0 89/10/18 15:25:19 lwall Locked $
print "1..3\n";
diff --git a/t/comp.decl b/t/comp.decl
index c49f8032dd..ef59e798cc 100644
--- a/t/comp.decl
+++ b/t/comp.decl
@@ -1,6 +1,6 @@
#!./perl
-# $Header: comp.decl,v 2.0 88/06/05 00:12:40 root Exp $
+# $Header: comp.decl,v 3.0 89/10/18 15:25:25 lwall Locked $
# check to see if subroutine declarations work everwhere
diff --git a/t/comp.multiline b/t/comp.multiline
index a669d4088a..10cf462f84 100644
--- a/t/comp.multiline
+++ b/t/comp.multiline
@@ -1,6 +1,6 @@
#!./perl
-# $Header: comp.multiline,v 2.0 88/06/05 00:12:44 root Exp $
+# $Header: comp.multiline,v 3.0 89/10/18 15:25:39 lwall Locked $
print "1..5\n";
diff --git a/t/comp.package b/t/comp.package
new file mode 100644
index 0000000000..5237011a62
--- /dev/null
+++ b/t/comp.package
@@ -0,0 +1,33 @@
+#!./perl
+
+print "1..7\n";
+
+$blurfl = 123;
+$foo = 3;
+
+package XYZ;
+
+$bar = 4;
+
+{
+ package ABC;
+ $blurfl = 5;
+ $main'a = $'b;
+}
+
+$ABC'dyick = 6;
+
+$xyz = 2;
+
+$main = join(':', sort(keys _main));
+$XYZ = join(':', sort(keys _XYZ));
+$ABC = join(':', sort(keys _ABC));
+
+print $XYZ eq 'ABC:XYZ:bar:main:xyz' ? "ok 1\n" : "not ok 1 '$XYZ'\n";
+print $ABC eq 'blurfl:dyick' ? "ok 2\n" : "not ok 2\n";
+print $main'blurfl == 123 ? "ok 3\n" : "not ok 3\n";
+package ABC;
+print $blurfl == 5 ? "ok 4\n" : "not ok 4\n";
+eval 'print $blurfl == 5 ? "ok 5\n" : "not ok 5\n";';
+eval 'package main; print $blurfl == 123 ? "ok 6\n" : "not ok 6\n";';
+print $blurfl == 5 ? "ok 7\n" : "not ok 7\n";
diff --git a/t/comp.script b/t/comp.script
index 5a537aadba..378a006848 100644
--- a/t/comp.script
+++ b/t/comp.script
@@ -1,6 +1,6 @@
#!./perl
-# $Header: comp.script,v 2.0 88/06/05 00:12:49 root Exp $
+# $Header: comp.script,v 3.0 89/10/18 15:25:55 lwall Locked $
print "1..3\n";
diff --git a/t/comp.term b/t/comp.term
index 497b8042c3..204024cada 100644
--- a/t/comp.term
+++ b/t/comp.term
@@ -1,10 +1,10 @@
#!./perl
-# $Header: comp.term,v 2.0 88/06/05 00:12:52 root Exp $
+# $Header: comp.term,v 3.0 89/10/18 15:26:04 lwall Locked $
# tests that aren't important enough for base.term
-print "1..10\n";
+print "1..14\n";
$x = "\\n";
print "#1\t:$x: eq " . ':\n:' . "\n";
@@ -26,3 +26,10 @@ if (length("\\n$one") == 3) {print "ok 8\n";} else {print "not ok 8\n";}
if (length("\\\n$one") == 3) {print "ok 9\n";} else {print "not ok 9\n";}
if (length("\\${one}") == 2) {print "ok 10\n";} else {print "not ok 10\n";}
+if ("${one}b" eq "ab") { print "ok 11\n";} else {print "not ok 11\n";}
+
+@foo = (1,2,3);
+if ("$foo[1]b" eq "2b") { print "ok 12\n";} else {print "not ok 12\n";}
+if ("@foo[0..1]b" eq "1 2b") { print "ok 13\n";} else {print "not ok 13\n";}
+$" = '::';
+if ("@foo[0..1]b" eq "1::2b") { print "ok 14\n";} else {print "not ok 14\n";}
diff --git a/t/io.argv b/t/io.argv
index 80eeebd5a7..2284e9fcd3 100644
--- a/t/io.argv
+++ b/t/io.argv
@@ -1,6 +1,6 @@
#!./perl
-# $Header: io.argv,v 2.0 88/06/05 00:12:55 root Exp $
+# $Header: io.argv,v 3.0 89/10/18 15:26:10 lwall Locked $
print "1..5\n";
diff --git a/t/io.dup b/t/io.dup
index 6f35892e8a..6a1f4513f6 100644
--- a/t/io.dup
+++ b/t/io.dup
@@ -1,32 +1,32 @@
#!./perl
-# $Header: io.dup,v 2.0 88/06/05 00:12:57 root Exp $
+# $Header: io.dup,v 3.0 89/10/18 15:26:15 lwall Locked $
print "1..6\n";
print "ok 1\n";
-open(dupout,">&stdout");
-open(duperr,">&stderr");
+open(dupout,">&STDOUT");
+open(duperr,">&STDERR");
-open(stdout,">Io.dup") || die "Can't open stdout";
-open(stderr,">&stdout") || die "Can't open stderr";
+open(STDOUT,">Io.dup") || die "Can't open stdout";
+open(STDERR,">&STDOUT") || die "Can't open stderr";
-select(stderr); $| = 1;
-select(stdout); $| = 1;
+select(STDERR); $| = 1;
+select(STDOUT); $| = 1;
-print stdout "ok 2\n";
-print stderr "ok 3\n";
+print STDOUT "ok 2\n";
+print STDERR "ok 3\n";
system 'echo ok 4';
system 'echo ok 5 1>&2';
-close(stdout);
-close(stderr);
+close(STDOUT);
+close(STDERR);
-open(stdout,">&dupout");
-open(stderr,">&duperr");
+open(STDOUT,">&dupout");
+open(STDERR,">&duperr");
system 'cat Io.dup';
unlink 'Io.dup';
-print stdout "ok 6\n";
+print STDOUT "ok 6\n";
diff --git a/t/io.fs b/t/io.fs
index 0b866b6246..51febd62df 100644
--- a/t/io.fs
+++ b/t/io.fs
@@ -1,6 +1,6 @@
#!./perl
-# $Header: io.fs,v 2.0 88/06/05 00:12:59 root Exp $
+# $Header: io.fs,v 3.0 89/10/18 15:26:20 lwall Locked $
print "1..22\n";
@@ -56,12 +56,13 @@ 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 0,1,'b');
+$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 == 0 && $mtime == 1) {print "ok 18\n";} else {print "not ok 18 $atime $mtime\n";}
+if ($atime == 500000000 && $mtime == 500000001)
+ {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,
diff --git a/t/io.inplace b/t/io.inplace
index cacb7d0dc1..c73bd75512 100644
--- a/t/io.inplace
+++ b/t/io.inplace
@@ -1,6 +1,6 @@
#!./perl -i.bak
-# $Header: io.inplace,v 2.0 88/06/05 00:13:02 root Exp $
+# $Header: io.inplace,v 3.0 89/10/18 15:26:25 lwall Locked $
print "1..2\n";
diff --git a/t/io.pipe b/t/io.pipe
index c4cb2f7537..49eaeec959 100644
--- a/t/io.pipe
+++ b/t/io.pipe
@@ -1,6 +1,6 @@
#!./perl
-# $Header: io.pipe,v 2.0 88/06/05 00:13:05 root Exp $
+# $Header: io.pipe,v 3.0 89/10/18 15:26:30 lwall Locked $
$| = 1;
print "1..4\n";
@@ -16,6 +16,6 @@ if (open(PIPE, "-|")) {
}
}
else {
- print stdout "ok 3\n";
+ print STDOUT "ok 3\n";
exec 'echo', 'ok 4';
}
diff --git a/t/io.print b/t/io.print
index 3163b03dfb..7d4a901c0c 100644
--- a/t/io.print
+++ b/t/io.print
@@ -1,14 +1,14 @@
#!./perl
-# $Header: io.print,v 2.0 88/06/05 00:13:11 root Exp $
+# $Header: io.print,v 3.0 89/10/18 15:26:36 lwall Locked $
print "1..16\n";
-$foo = 'stdout';
+$foo = 'STDOUT';
print $foo "ok 1\n";
print "ok 2\n","ok 3\n","ok 4\n";
-print stdout "ok 5\n";
+print STDOUT "ok 5\n";
open(foo,">-");
print foo "ok 6\n";
@@ -20,7 +20,7 @@ printf("ok %d\n",8);
printf @a;
$a[1] = 10;
-printf stdout @a;
+printf STDOUT @a;
$, = ' ';
$\ = "\n";
diff --git a/t/io.tell b/t/io.tell
index e632acadf1..98cf02717b 100644
--- a/t/io.tell
+++ b/t/io.tell
@@ -1,6 +1,6 @@
#!./perl
-# $Header: io.tell,v 2.0 88/06/05 00:13:14 root Exp $
+# $Header: io.tell,v 3.0 89/10/18 15:26:45 lwall Locked $
print "1..13\n";
diff --git a/t/op.append b/t/op.append
index 63ab64917e..c5805745fa 100644
--- a/t/op.append
+++ b/t/op.append
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.append,v 2.0 88/06/05 00:13:16 root Exp $
+# $Header: op.append,v 3.0 89/10/18 15:26:51 lwall Locked $
print "1..3\n";
diff --git a/t/op.array b/t/op.array
new file mode 100644
index 0000000000..ebfb5e8a4b
--- /dev/null
+++ b/t/op.array
@@ -0,0 +1,100 @@
+#!./perl
+
+# $Header: op.array,v 3.0 89/10/18 15:26:55 lwall Locked $
+
+print "1..30\n";
+
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 1\n";} else {print "not ok 1\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 2\n";} else {print "not ok 2\n";}
+if ($#ary == 3) {print "ok 3\n";} else {print "not ok 3\n";}
+if (join('',@ary) eq '1234') {print "ok 4\n";} else {print "not ok 4\n";}
+
+$[ = 1;
+@ary = (1,2,3,4,5);
+if (join('',@ary) eq '12345') {print "ok 5\n";} else {print "not ok 5\n";}
+
+$tmp = $ary[$#ary]; --$#ary;
+if ($tmp == 5) {print "ok 6\n";} else {print "not ok 6\n";}
+if ($#ary == 4) {print "ok 7\n";} else {print "not ok 7\n";}
+if (join('',@ary) eq '1234') {print "ok 8\n";} else {print "not ok 8\n";}
+
+if ($ary[5] eq '') {print "ok 9\n";} else {print "not ok 9\n";}
+
+$#ary += 1; # see if we can recover element 5
+if ($#ary == 5) {print "ok 10\n";} else {print "not ok 10\n";}
+if ($ary[5] == 5) {print "ok 11\n";} else {print "not ok 11\n";}
+
+$[ = 0;
+@foo = ();
+$r = join(',', $#foo, @foo);
+if ($r eq "-1") {print "ok 12\n";} else {print "not ok 12 $r\n";}
+$foo[0] = '0';
+$r = join(',', $#foo, @foo);
+if ($r eq "0,0") {print "ok 13\n";} else {print "not ok 13 $r\n";}
+$foo[2] = '2';
+$r = join(',', $#foo, @foo);
+if ($r eq "2,0,,2") {print "ok 14\n";} else {print "not ok 14 $r\n";}
+@bar = ();
+$bar[0] = '0';
+$bar[1] = '1';
+$r = join(',', $#bar, @bar);
+if ($r eq "1,0,1") {print "ok 15\n";} else {print "not ok 15 $r\n";}
+@bar = ();
+$r = join(',', $#bar, @bar);
+if ($r eq "-1") {print "ok 16\n";} else {print "not ok 16 $r\n";}
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 17\n";} else {print "not ok 17 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 18\n";} else {print "not ok 18 $r\n";}
+reset 'b';
+@bar = ();
+$bar[0] = '0';
+$r = join(',', $#bar, @bar);
+if ($r eq "0,0") {print "ok 19\n";} else {print "not ok 19 $r\n";}
+$bar[2] = '2';
+$r = join(',', $#bar, @bar);
+if ($r eq "2,0,,2") {print "ok 20\n";} else {print "not ok 20 $r\n";}
+
+$foo = 'now is the time';
+if (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/)) {
+ if ($F1 eq 'now' && $F2 eq 'is' && $Etc eq 'the time') {
+ print "ok 21\n";
+ }
+ else {
+ print "not ok 21\n";
+ }
+}
+else {
+ print "not ok 21\n";
+}
+
+$foo = 'lskjdf';
+if ($cnt = (($F1,$F2,$Etc) = ($foo =~ /^(\S+)\s+(\S+)\s*(.*)/))) {
+ print "not ok 22 $cnt $F1:$F2:$Etc\n";
+}
+else {
+ print "ok 22\n";
+}
+
+%foo = ('blurfl','dyick','foo','bar','etc.','etc.');
+%bar = %foo;
+print $bar{'foo'} eq 'bar' ? "ok 23\n" : "not ok 23\n";
+%bar = ();
+print $bar{'foo'} eq '' ? "ok 24\n" : "not ok 24\n";
+(%bar,$a,$b) = (%foo,'how','now');
+print $bar{'foo'} eq 'bar' ? "ok 25\n" : "not ok 25\n";
+print $bar{'how'} eq 'now' ? "ok 26\n" : "not ok 26\n";
+@bar{keys %foo} = values %foo;
+print $bar{'foo'} eq 'bar' ? "ok 27\n" : "not ok 27\n";
+print $bar{'how'} eq 'now' ? "ok 28\n" : "not ok 28\n";
+
+@foo = grep(/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'the time men come' ? "ok 29\n" : "not ok 29\n";
+
+@foo = grep(!/e/,split(' ','now is the time for all good men to come to'));
+print join(' ',@foo) eq 'now is for all good to to' ? "ok 30\n" : "not ok 30\n";
diff --git a/t/op.auto b/t/op.auto
index 064ab067a5..d31dca7e4e 100644
--- a/t/op.auto
+++ b/t/op.auto
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.auto,v 2.0 88/06/05 00:13:19 root Exp $
+# $Header: op.auto,v 3.0 89/10/18 15:27:00 lwall Locked $
print "1..34\n";
diff --git a/t/op.chop b/t/op.chop
index f9ab58aaa2..f293a0ae12 100644
--- a/t/op.chop
+++ b/t/op.chop
@@ -1,14 +1,14 @@
#!./perl
-# $Header: op.chop,v 2.0 88/06/05 00:13:22 root Exp $
+# $Header: op.chop,v 3.0 89/10/18 15:28:19 lwall Locked $
-print "1..2\n";
+print "1..4\n";
# optimized
$_ = 'abc';
$c = do foo();
-if ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1\n";}
+if ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1 $c$_\n";}
# unoptimized
@@ -19,3 +19,12 @@ if ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
sub foo {
chop;
}
+
+@foo = ("hi \n","there\n","!\n");
+@bar = @foo;
+chop(@bar);
+print join('',@bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n";
+
+$foo = "\n";
+chop($foo,@foo);
+print join('',$foo,@foo) eq 'hi there!' ? "ok 4\n" : "not ok 4\n";
diff --git a/t/op.cond b/t/op.cond
index cd709378f9..5cd49fdd64 100644
--- a/t/op.cond
+++ b/t/op.cond
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.cond,v 2.0 88/06/05 00:13:26 root Exp $
+# $Header: op.cond,v 3.0 89/10/18 15:28:26 lwall Locked $
print "1..4\n";
diff --git a/t/op.dbm b/t/op.dbm
new file mode 100644
index 0000000000..dd0a4523ce
--- /dev/null
+++ b/t/op.dbm
@@ -0,0 +1,95 @@
+#!./perl
+
+# $Header: op.dbm,v 3.0 89/10/18 15:28:31 lwall Locked $
+
+if (!-r '/usr/include/dbm.h' && !-r '/usr/include/ndbm.h') {
+ print "1..0\n";
+ exit;
+}
+
+print "1..9\n";
+
+unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
+umask(0);
+print (dbmopen(h,'Op.dbmx',0640) ? "ok 1\n" : "not ok 1\n");
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
+ $blksize,$blocks) = stat('Op.dbmx.pag');
+print (($mode & 0777) == 0640 ? "ok 2\n" : "not ok 2\n");
+while (($key,$value) = each(h)) {
+ $i++;
+}
+print (!$i ? "ok 3\n" : "not ok 3\n");
+
+$h{'goner1'} = 'snork';
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+
+$h{'goner2'} = 'snork';
+delete $h{'goner2'};
+
+dbmclose(h);
+print (dbmopen(h,'Op.dbmx',0640) ? "ok 4\n" : "not ok 4\n");
+
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
+$h{'goner3'} = 'snork';
+
+delete $h{'goner1'};
+delete $h{'goner3'};
+
+@keys = keys(%h);
+@values = values(%h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";}
+
+while (($key,$value) = each(h)) {
+ if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+ $key =~ y/a-z/A-Z/;
+ $i++ if $key eq $value;
+ }
+}
+
+if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";}
+
+@keys = ('blurfl', keys(h), 'dyick');
+if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";}
+
+# check cache overflow and numeric keys and contents
+$ok = 1;
+for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; }
+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');
+print ($size > 0 ? "ok 9\n" : "not ok 9\n");
+
+unlink 'Op.dbmx.dir', 'Op.dbmx.pag';
diff --git a/t/op.delete b/t/op.delete
index 24315a5611..3c5fe320f0 100644
--- a/t/op.delete
+++ b/t/op.delete
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.delete,v 2.0 88/06/05 00:13:30 root Exp $
+# $Header: op.delete,v 3.0 89/10/18 15:28:36 lwall Locked $
print "1..6\n";
@@ -10,15 +10,15 @@ $foo{3} = 'c';
$foo = delete $foo{2};
-if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1\n";}
-if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2\n";}
+if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";}
+if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";}
if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";}
if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";}
$foo = join('',values(foo));
if ($foo eq 'ac' || $foo eq 'ca') {print "ok 5\n";} else {print "not ok 5\n";}
-foreach $key (keys(foo)) {
+foreach $key (keys foo) {
delete $foo{$key};
}
diff --git a/t/op.do b/t/op.do
index 781d30814a..d78ea0525f 100644
--- a/t/op.do
+++ b/t/op.do
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.do,v 2.0 88/06/05 00:13:36 root Exp $
+# $Header: op.do,v 3.0 89/10/18 15:28:43 lwall Locked $
sub foo1
{
diff --git a/t/op.each b/t/op.each
index 5a445ed5d6..edaed11e78 100644
--- a/t/op.each
+++ b/t/op.each
@@ -1,13 +1,13 @@
#!./perl
-# $Header: op.each,v 2.0 88/06/05 00:13:38 root Exp $
+# $Header: op.each,v 3.0 89/10/18 15:28:48 lwall Locked $
print "1..3\n";
$h{'abc'} = 'ABC';
$h{'def'} = 'DEF';
-$h{'jkl'} = 'JKL';
-$h{'xyz'} = 'XYZ';
+$h{'jkl','mno'} = "JKL\034MNO";
+$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5);
$h{'a'} = 'A';
$h{'b'} = 'B';
$h{'c'} = 'C';
@@ -35,8 +35,8 @@ $h{'x'} = 'X';
$h{'y'} = 'Y';
$h{'z'} = 'Z';
-@keys = keys(h);
-@values = values(h);
+@keys = keys %h;
+@values = values %h;
if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -49,5 +49,5 @@ while (($key,$value) = each(h)) {
if ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
-@keys = ('blurfl', keys(h), 'dyick');
+@keys = ('blurfl', keys(%h), 'dyick');
if ($#keys == 31) {print "ok 3\n";} else {print "not ok 3\n";}
diff --git a/t/op.eval b/t/op.eval
index 2456181ff2..5060f66f1c 100644
--- a/t/op.eval
+++ b/t/op.eval
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.eval,v 2.0 88/06/05 00:13:40 root Exp $
+# $Header: op.eval,v 3.0 89/10/18 15:28:53 lwall Locked $
print "1..10\n";
@@ -31,7 +31,7 @@ $ans = eval $fact;
if ($ans == 120) {print "ok 8\n";} else {print "not ok 8\n";}
$foo = 5;
-$fact = 'local($foo); $foo <= 1 ? 1 : $foo-- * (eval $fact);';
+$fact = 'local($foo)=$foo; $foo <= 1 ? 1 : $foo-- * (eval $fact);';
$ans = eval $fact;
if ($ans == 120) {print "ok 9\n";} else {print "not ok 9 $ans\n";}
diff --git a/t/op.exec b/t/op.exec
index 030cdaf105..3066f1d3ec 100644
--- a/t/op.exec
+++ b/t/op.exec
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.exec,v 2.0 88/06/05 00:13:46 root Exp $
+# $Header: op.exec,v 3.0 89/10/18 15:28:57 lwall Locked $
$| = 1; # flush stdout
print "1..8\n";
diff --git a/t/op.exp b/t/op.exp
index 2811aa3f39..7c558f8362 100644
--- a/t/op.exp
+++ b/t/op.exp
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.exp,v 2.0 88/06/05 00:13:48 root Exp $
+# $Header: op.exp,v 3.0 89/10/18 15:29:01 lwall Locked $
print "1..6\n";
diff --git a/t/op.flip b/t/op.flip
index c1e6ce35dd..19fdf86e7e 100644
--- a/t/op.flip
+++ b/t/op.flip
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.flip,v 2.0 88/06/05 00:13:51 root Exp $
+# $Header: op.flip,v 3.0 89/10/18 15:29:07 lwall Locked $
print "1..8\n";
diff --git a/t/op.fork b/t/op.fork
index a1d314c945..41debbc240 100644
--- a/t/op.fork
+++ b/t/op.fork
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.fork,v 2.0 88/06/05 00:13:53 root Exp $
+# $Header: op.fork,v 3.0 89/10/18 15:29:12 lwall Locked $
$| = 1;
print "1..2\n";
diff --git a/t/op.glob b/t/op.glob
new file mode 100644
index 0000000000..c04f7f3271
--- /dev/null
+++ b/t/op.glob
@@ -0,0 +1,22 @@
+#!./perl
+
+# $Header: op.glob,v 3.0 89/10/18 15:29:19 lwall Locked $
+
+print "1..4\n";
+
+@ops = <op.*>;
+$list = join(' ',@ops);
+
+chop($otherway = `echo op.*`);
+
+print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n";
+
+print $/ eq "\n" ? "ok 2\n" : "not ok 2\n";
+
+while (<jskdfjskdfj* op.* jskdjfjkosvk*>) {
+ $not = "not " unless $_ eq shift @ops;
+ $not = "not at all " if $/ eq "\0";
+}
+print "${not}ok 3\n";
+
+print $/ eq "\n" ? "ok 4\n" : "not ok 4\n";
diff --git a/t/op.goto b/t/op.goto
index 7c42b501f1..4325431aec 100644
--- a/t/op.goto
+++ b/t/op.goto
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.goto,v 2.0 88/06/05 00:13:58 root Exp $
+# $Header: op.goto,v 3.0 89/10/18 15:29:24 lwall Locked $
print "1..3\n";
diff --git a/t/op.index b/t/op.index
new file mode 100644
index 0000000000..af227457ef
--- /dev/null
+++ b/t/op.index
@@ -0,0 +1,26 @@
+#!./perl
+
+# $Header: op.index,v 3.0 89/10/18 15:29:29 lwall Locked $
+
+print "1..6\n";
+
+
+$foo = 'Now is the time for all good men to come to the aid of their country.';
+
+$first = substr($foo,0,index($foo,'the'));
+print ($first eq "Now is " ? "ok 1\n" : "not ok 1\n");
+
+$last = substr($foo,rindex($foo,'the'),100);
+print ($last eq "their country." ? "ok 2\n" : "not ok 2\n");
+
+$last = substr($foo,index($foo,'Now'),2);
+print ($last eq "No" ? "ok 3\n" : "not ok 3\n");
+
+$last = substr($foo,rindex($foo,'Now'),2);
+print ($last eq "No" ? "ok 4\n" : "not ok 4\n");
+
+$last = substr($foo,index($foo,'.'),100);
+print ($last eq "." ? "ok 5\n" : "not ok 5\n");
+
+$last = substr($foo,rindex($foo,'.'),100);
+print ($last eq "." ? "ok 6\n" : "not ok 6\n");
diff --git a/t/op.int b/t/op.int
index eca27e36ca..5f021272f0 100644
--- a/t/op.int
+++ b/t/op.int
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.int,v 2.0 88/06/05 00:14:01 root Exp $
+# $Header: op.int,v 3.0 89/10/18 15:29:33 lwall Locked $
print "1..4\n";
diff --git a/t/op.join b/t/op.join
index 7711ac9c63..f3c6ddde1e 100644
--- a/t/op.join
+++ b/t/op.join
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.join,v 2.0 88/06/05 00:14:05 root Exp $
+# $Header: op.join,v 3.0 89/10/18 15:29:38 lwall Locked $
print "1..3\n";
diff --git a/t/op.list b/t/op.list
index 1dee724cde..02eb0f4007 100644
--- a/t/op.list
+++ b/t/op.list
@@ -1,13 +1,13 @@
#!./perl
-# $Header: op.list,v 2.0 88/06/05 00:14:09 root Exp $
+# $Header: op.list,v 3.0 89/10/18 15:29:44 lwall Locked $
-print "1..18\n";
+print "1..27\n";
@foo = (1, 2, 3, 4);
if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";}
-$_ = join(foo,':');
+$_ = join(':',@foo);
if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
($a,$b,$c,$d) = (1,2,3,4);
@@ -17,7 +17,7 @@ if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 3\n";} else {print "not ok 3\n";}
if ("$a;$b;$c" eq '333;222;111') {print "ok 4\n";} else {print "not ok 4\n";}
($a,$b,$c) = ($c,$b,$a);
-if ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5\n";}
+if ("$a;$b;$c" eq '111;222;333') {print "ok 5\n";} else {print "not ok 5 $a;$b;$c\n";}
($a, $b) = ($b, $a);
if ("$a;$b;$c" eq '222;111;333') {print "ok 6\n";} else {print "not ok 6\n";}
@@ -33,8 +33,8 @@ if ($d eq 4) {print "ok 10\n";} else {print "not ok 10\n";}
print "#11 $a;$b;$c;$d eq 1;2;3;4\n";
if ("$a;$b;$c;$d" eq '1;2;3;4') {print "ok 11\n";} else {print "not ok 11\n";}
-@foo = (1);
-if (join(':',@foo) eq '1') {print "ok 12\n";} else {print "not ok 12\n";}
+@foo = @bar = (1);
+if (join(':',@foo,@bar) eq '1:1') {print "ok 12\n";} else {print "not ok 12\n";}
@foo = ();
@foo = 1+2+3;
@@ -57,3 +57,27 @@ if (join('',@a) eq '123') {print "ok 17\n";} else {print "not ok 17\n";}
@a = ($x == $x || (4,5,6));
if (join('',@a) eq '1') {print "ok 18\n";} else {print "not ok 18\n";}
+
+if (join('',1,2,(3,4,5)) eq '12345'){print "ok 19\n";}else{print "not ok 19\n";}
+if (join('',(1,2,3,4,5)) eq '12345'){print "ok 20\n";}else{print "not ok 20\n";}
+if (join('',(1,2,3,4),5) eq '12345'){print "ok 21\n";}else{print "not ok 21\n";}
+if (join('',1,(2,3,4),5) eq '12345'){print "ok 22\n";}else{print "not ok 22\n";}
+if (join('',1,2,(3,4),5) eq '12345'){print "ok 23\n";}else{print "not ok 23\n";}
+if (join('',1,2,3,(4),5) eq '12345'){print "ok 24\n";}else{print "not ok 24\n";}
+
+for ($x = 0; $x < 3; $x++) {
+ ($a, $b, $c) = do {
+ if ($x == 0) {
+ ('ok ', 25, "\n");
+ }
+ elsif ($x == 1) {
+ ('ok ', 26, "\n");
+ }
+ else {
+ ('ok ', 27, "\n");
+ }
+ };
+
+ print $a,$b,$c;
+}
+
diff --git a/t/op.local b/t/op.local
new file mode 100644
index 0000000000..d04a0c9d61
--- /dev/null
+++ b/t/op.local
@@ -0,0 +1,45 @@
+#!./perl
+
+# $Header: op.local,v 3.0 89/10/18 15:29:49 lwall Locked $
+
+print "1..20\n";
+
+sub foo {
+ local($a, $b) = @_;
+ local($c, $d);
+ $c = "ok 3\n";
+ $d = "ok 4\n";
+ { local($a,$c) = ("ok 9\n", "ok 10\n"); ($x, $y) = ($a, $c); }
+ print $a, $b;
+ $c . $d;
+}
+
+$a = "ok 5\n";
+$b = "ok 6\n";
+$c = "ok 7\n";
+$d = "ok 8\n";
+
+print do foo("ok 1\n","ok 2\n");
+
+print $a,$b,$c,$d,$x,$y;
+
+# same thing, only with arrays and associative arrays
+
+sub foo2 {
+ local($a, @b) = @_;
+ local(@c, %d);
+ @c = "ok 13\n";
+ $d{''} = "ok 14\n";
+ { local($a,@c) = ("ok 19\n", "ok 20\n"); ($x, $y) = ($a, @c); }
+ print $a, @b;
+ $c[0] . $d{''};
+}
+
+$a = "ok 15\n";
+@b = "ok 16\n";
+@c = "ok 17\n";
+$d{''} = "ok 18\n";
+
+print do foo2("ok 11\n","ok 12\n");
+
+print $a,@b,@c,%d,$x,$y;
diff --git a/t/op.magic b/t/op.magic
index ab8dbeec3d..9468a35573 100644
--- a/t/op.magic
+++ b/t/op.magic
@@ -1,10 +1,10 @@
#!./perl
-# $Header: op.magic,v 2.0 88/06/05 00:14:11 root Exp $
+# $Header: op.magic,v 3.0 89/10/18 15:29:54 lwall Locked $
$| = 1; # command buffering
-print "1..4\n";
+print "1..5\n";
eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval
if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";}
@@ -24,3 +24,8 @@ system './perl',
'-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";',
'-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }';
+
+@val1 = @ENV{keys(%ENV)}; # can we slice ENV?
+@val2 = values(%ENV);
+
+print join(':',@val1) eq join(':',@val2) ? "ok 5\n" : "not ok 5\n";
diff --git a/t/op.mkdir b/t/op.mkdir
new file mode 100644
index 0000000000..93e2ccdde4
--- /dev/null
+++ b/t/op.mkdir
@@ -0,0 +1,15 @@
+#!./perl
+
+# $Header: op.mkdir,v 3.0 89/10/18 15:30:05 lwall Locked $
+
+print "1..7\n";
+
+`rm -rf blurfl`;
+
+print (mkdir('blurfl',0666) ? "ok 1\n" : "not ok 1\n");
+print (mkdir('blurfl',0666) ? "not ok 2\n" : "ok 2\n");
+print ($! == 17 ? "ok 3\n" : "not ok 3\n");
+print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n");
+print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n");
+print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n");
+print ($! == 2 ? "ok 7\n" : "not ok 7\n");
diff --git a/t/op.oct b/t/op.oct
index e37f488e6b..7f129f6488 100644
--- a/t/op.oct
+++ b/t/op.oct
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.oct,v 2.0 88/06/05 00:14:14 root Exp $
+# $Header: op.oct,v 3.0 89/10/18 15:30:15 lwall Locked $
print "1..3\n";
diff --git a/t/op.ord b/t/op.ord
index 103a1122bd..63f3580654 100644
--- a/t/op.ord
+++ b/t/op.ord
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.ord,v 2.0 88/06/05 00:14:17 root Exp $
+# $Header: op.ord,v 3.0 89/10/18 15:30:29 lwall Locked $
print "1..2\n";
diff --git a/t/op.pack b/t/op.pack
new file mode 100644
index 0000000000..9806261836
--- /dev/null
+++ b/t/op.pack
@@ -0,0 +1,18 @@
+#!./perl
+
+# $Header: op.pack,v 3.0 89/10/18 15:30:39 lwall Locked $
+
+print "1..3\n";
+
+$format = "c2x5CCxsila6";
+@ary = (1,-100,127,128,32767,12345,123456,"abcdef");
+$foo = pack($format,@ary);
+@ary2 = unpack($format,$foo);
+
+print ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n");
+
+$out1=join(':',@ary);
+$out2=join(':',@ary2);
+print ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n");
+
+print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n");
diff --git a/t/op.pat b/t/op.pat
index 750caf2214..d38082f593 100644
--- a/t/op.pat
+++ b/t/op.pat
@@ -1,8 +1,8 @@
#!./perl
-# $Header: op.pat,v 2.0 88/06/05 00:14:20 root Exp $
+# $Header: op.pat,v 3.0 89/10/18 15:30:44 lwall Locked $
-print "1..30\n";
+print "1..43\n";
$x = "abc\ndef\n";
@@ -93,3 +93,28 @@ $foo = '[^ab]*';
'cde' =~ /$foo/;
'xyz' =~ /$null/;
if ($& eq 'xyz') {print "ok 30\n";} else {print "not ok 30\n";}
+
+$_ = 'abcdefghi';
+/def/; # optimized up to cmd
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 31\n";} else {print "not ok 31\n";}
+
+/cde/ + 0; # optimized only to spat
+if ("$`:$&:$'" eq 'ab:cde:fghi') {print "ok 32\n";} else {print "not ok 32\n";}
+
+/[d][e][f]/; # not optimized
+if ("$`:$&:$'" eq 'abc:def:ghi') {print "ok 33\n";} else {print "not ok 33\n";}
+
+$_ = 'now is the {time for all} good men to come to.';
+/ {([^}]*)}/;
+if ($1 eq 'time for all') {print "ok 34\n";} else {print "not ok 34 $1\n";}
+
+$_ = 'xxx {3,4} yyy zzz';
+print /( {3,4})/ ? "ok 35\n" : "not ok 35\n";
+print $1 eq ' ' ? "ok 36\n" : "not ok 36\n";
+print /( {4,})/ ? "not ok 37\n" : "ok 37\n";
+print /( {2,3}.)/ ? "ok 38\n" : "not ok 38\n";
+print $1 eq ' y' ? "ok 39\n" : "not ok 39\n";
+print /(y{2,3}.)/ ? "ok 40\n" : "not ok 40\n";
+print $1 eq 'yyy ' ? "ok 41\n" : "not ok 41\n";
+print /x {3,4}/ ? "not ok 42\n" : "ok 42\n";
+print /^xxx {3,4}/ ? "not ok 43\n" : "ok 43\n";
diff --git a/t/op.push b/t/op.push
index 979b2b54bd..f2c5a7a931 100644
--- a/t/op.push
+++ b/t/op.push
@@ -1,11 +1,11 @@
#!./perl
-# $Header: op.push,v 2.0 88/06/05 00:14:23 root Exp $
+# $Header: op.push,v 3.0 89/10/18 15:30:48 lwall Locked $
print "1..2\n";
@x = (1,2,3);
push(@x,@x);
-if (join(x,':') eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
+if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";}
push(x,4);
-if (join(x,':') eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
+if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";}
diff --git a/t/op.range b/t/op.range
new file mode 100644
index 0000000000..4975c44441
--- /dev/null
+++ b/t/op.range
@@ -0,0 +1,30 @@
+#!./perl
+
+# $Header: op.range,v 3.0 89/10/18 15:30:53 lwall Locked $
+
+print "1..6\n";
+
+print join(':',1..5) eq '1:2:3:4:5' ? "ok 1\n" : "not ok 1\n";
+
+@foo = (1,2,3,4,5,6,7,8,9);
+@foo[2..4] = ('c','d','e');
+
+print join(':',@foo[$foo[0]..5]) eq '2:c:d:e:6' ? "ok 2\n" : "not ok 2\n";
+
+@bar[2..4] = ('c','d','e');
+print join(':',@bar[1..5]) eq ':c:d:e:' ? "ok 3\n" : "not ok 3\n";
+
+($a,@bcd[0..2],$e) = ('a','b','c','d','e');
+print join(':',$a,@bcd[0..2],$e) eq 'a:b:c:d:e' ? "ok 4\n" : "not ok 4\n";
+
+$x = 0;
+for (1..100) {
+ $x += $_;
+}
+print $x == 5050 ? "ok 5\n" : "not ok 5 $x\n";
+
+$x = 0;
+for ((100,2..99,1)) {
+ $x += $_;
+}
+print $x == 5050 ? "ok 6\n" : "not ok 6 $x\n";
diff --git a/t/op.read b/t/op.read
new file mode 100644
index 0000000000..b219917a68
--- /dev/null
+++ b/t/op.read
@@ -0,0 +1,19 @@
+#!./perl
+
+# $Header: op.read,v 3.0 89/10/18 15:30:58 lwall Locked $
+
+print "1..4\n";
+
+
+open(FOO,'op.read') || open(FOO,'t/op.read') || die "Can't open op.read";
+seek(FOO,4,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 4 ? "ok 1\n" : "not ok 1\n");
+print ($buf eq "perl" ? "ok 2\n" : "not ok 2 :$buf:\n");
+
+seek(FOO,20000,0);
+$got = read(FOO,$buf,4);
+
+print ($got == 0 ? "ok 3\n" : "not ok 3\n");
+print ($buf eq "" ? "ok 4\n" : "not ok 4\n");
diff --git a/t/op.regexp b/t/op.regexp
index 7c97227ccc..fc7d8b829c 100644
--- a/t/op.regexp
+++ b/t/op.regexp
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.regexp,v 2.0 88/06/05 00:14:27 root Exp $
+# $Header: op.regexp,v 3.0 89/10/18 15:31:02 lwall Locked $
open(TESTS,'re_tests') || open(TESTS,'t/re_tests') || die "Can't open re_tests";
while (<TESTS>) { }
diff --git a/t/op.repeat b/t/op.repeat
index e293ea873c..aa4a52c805 100644
--- a/t/op.repeat
+++ b/t/op.repeat
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.repeat,v 2.0 88/06/05 00:14:31 root Exp $
+# $Header: op.repeat,v 3.0 89/10/18 15:31:07 lwall Locked $
print "1..11\n";
diff --git a/t/op.sleep b/t/op.sleep
index 410ced709c..28d034ca76 100644
--- a/t/op.sleep
+++ b/t/op.sleep
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.sleep,v 2.0 88/06/05 00:14:35 root Exp $
+# $Header: op.sleep,v 3.0 89/10/18 15:31:15 lwall Locked $
print "1..1\n";
diff --git a/t/op.sort b/t/op.sort
new file mode 100644
index 0000000000..89dafaeabb
--- /dev/null
+++ b/t/op.sort
@@ -0,0 +1,19 @@
+#!./perl
+
+# $Header: op.sort,v 3.0 89/10/18 15:31:19 lwall Locked $
+
+print "1..3\n";
+
+sub reverse { $a lt $b ? 1 : $a gt $b ? -1 : 0; }
+
+@harry = ('dog','cat','x','Cain','Abel');
+@george = ('gone','chased','yz','Punished','Axed');
+
+$x = join('', sort @harry);
+print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n");
+
+$x = join('', sort reverse @harry);
+print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n");
+
+$x = join('', sort @george, 'to', @harry);
+print ($x eq 'AbelAxedCainPunishedcatchaseddoggonetoxyz'?"ok 3\n":"not ok 3\n");
diff --git a/t/op.split b/t/op.split
index 7c58f8f860..2018ac9f62 100644
--- a/t/op.split
+++ b/t/op.split
@@ -1,8 +1,8 @@
#!./perl
-# $Header: op.split,v 2.0 88/06/05 00:14:37 root Exp $
+# $Header: op.split,v 3.0 89/10/18 15:31:24 lwall Locked $
-print "1..7\n";
+print "1..12\n";
$FS = ':';
@@ -16,7 +16,7 @@ if (join(';',$a,$b,$c) eq 'a;b;c') {print "ok 1\n";} else {print "not ok 1\n";}
if (join("$_",@ary) eq 'aa:b:cc') {print "ok 2\n";} else {print "not ok 2\n";}
$_ = "abc\n";
-@ary = split(//);
+@xyz = (@ary = split(//));
if (join(".",@ary) eq "a.b.c.\n") {print "ok 3\n";} else {print "not ok 3\n";}
$_ = "a:b:c::::";
@@ -33,3 +33,25 @@ if ($_ eq "f:o:o:b:a:r:b:i:e:\t:d:o:l:l")
$_ = join(':', 'foo', split(/ /,'a b c'), 'bar');
if ($_ eq "foo:a:b::c:bar") {print "ok 7\n";} else {print "not ok 7 $_\n";}
+# Can we say how many fields to split to?
+$_ = join(':', split(' ','1 2 3 4 5 6', 3));
+print $_ eq '1:2:3 4 5 6' ? "ok 8\n" : "not ok 8 $_\n";
+
+# Can we do it as a variable?
+$x = 4;
+$_ = join(':', split(' ','1 2 3 4 5 6', $x));
+print $_ eq '1:2:3:4 5 6' ? "ok 9\n" : "not ok 9 $_\n";
+
+# Does the 999 suppress null field chopping?
+$_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999));
+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 eq '' || $foo =~ /num\(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);
+$_ = join(':',$a,$b);
+print $_ eq '1:2 3 4 5 6' ? "ok 12\n" : "not ok 12 $_\n";
+
diff --git a/t/op.sprintf b/t/op.sprintf
index 81fbdaabfc..a00044f21d 100644
--- a/t/op.sprintf
+++ b/t/op.sprintf
@@ -1,8 +1,8 @@
#!./perl
-# $Header: op.sprintf,v 2.0 88/06/05 00:14:40 root Exp $
+# $Header: op.sprintf,v 3.0 89/10/18 15:31:28 lwall Locked $
print "1..1\n";
-$x = sprintf("%3s %-4s foo %5d%c%3.1f","hi",123,456,65,3.0999);
-if ($x eq ' hi 123 foo 456A3.1') {print "ok 1\n";} else {print "not ok 1\n";}
+$x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999);
+if ($x eq ' hi 123 %foo 456A3.1') {print "ok 1\n";} else {print "not ok 1 '$x'\n";}
diff --git a/t/op.stat b/t/op.stat
index ac61acc1ac..72c18a91e7 100644
--- a/t/op.stat
+++ b/t/op.stat
@@ -1,9 +1,10 @@
#!./perl
-# $Header: op.stat,v 2.0 88/06/05 00:14:43 root Exp $
+# $Header: op.stat,v 3.0 89/10/18 15:31:33 lwall Locked $
print "1..56\n";
+unlink "Op.stat.tmp";
open(foo, ">Op.stat.tmp");
($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,
@@ -98,14 +99,14 @@ while (</usr/bin/*>) {
if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";}
unless (open(tty,"/dev/tty")) {
- print stderr "Can't open /dev/tty--run t/TEST outside of make.\n";
+ print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n";
}
if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";}
if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";}
close(tty);
if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";}
open(null,"/dev/null");
-if (! -t null) {print "ok 39\n";} else {print "not ok 39\n";}
+if (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";}
close(null);
if (-t) {print "ok 40\n";} else {print "not ok 40\n";}
diff --git a/t/op.study b/t/op.study
index 8da28d6575..c62afb3052 100644
--- a/t/op.study
+++ b/t/op.study
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.study,v 2.0 88/06/05 00:14:45 root Exp $
+# $Header: op.study,v 3.0 89/10/18 15:31:38 lwall Locked $
print "1..24\n";
diff --git a/t/op.subst b/t/op.subst
index 86b5b41c76..e3bf6e2209 100644
--- a/t/op.subst
+++ b/t/op.subst
@@ -1,8 +1,8 @@
#!./perl
-# $Header: op.subst,v 2.0 88/06/05 00:14:49 root Exp $
+# $Header: op.subst,v 3.0 89/10/18 15:31:43 lwall Locked $
-print "1..13\n";
+print "1..42\n";
$x = 'foo';
$_ = "x";
@@ -31,13 +31,13 @@ if (($a =~ s/a/x/g) == 4 && $a eq 'xbxcxdx')
{print "ok 5\n";} else {print "not ok 5\n";}
if (($a =~ s/a/y/g) == 0 && $a eq 'xbxcxdx')
- {print "ok 6\n";} else {print "not ok 6\n";}
+ {print "ok 6\n";} else {print "not ok 6 $a\n";}
if (($a =~ s/b/y/g) == 1 && $a eq 'xyxcxdx')
{print "ok 7\n";} else {print "not ok 7 $a\n";}
$_ = 'ABACADA';
-if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8\n";}
+if (/a/i && s///gi && $_ eq 'BCD') {print "ok 8\n";} else {print "not ok 8 $_\n";}
$_ = '\\' x 4;
if (length($_) == 4) {print "ok 9\n";} else {print "not ok 9\n";}
@@ -49,3 +49,117 @@ if (length($_) == 8) {print "ok 11\n";} else {print "not ok 11\n";}
s/\//\/\//g;
if ($_ eq '\\//' x 4) {print "ok 12\n";} else {print "not ok 12\n";}
if (length($_) == 12) {print "ok 13\n";} else {print "not ok 13\n";}
+
+$_ = 'aaaXXXXbbb';
+s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 14\n" : "not ok 14\n";
+
+$_ = 'aaaXXXXbbb';
+s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 15\n" : "not ok 15\n";
+
+$_ = 'aaaXXXXbbb';
+s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 16\n" : "not ok 16\n";
+
+$_ = 'aaaXXXXbbb';
+s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 17\n" : "not ok 17\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 18\n" : "not ok 18\n";
+
+$_ = 'aaaXXXXbbb';
+s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 19\n" : "not ok 19\n";
+
+$_ = 'aaaXXXXbbb';
+s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 20\n" : "not ok 20\n";
+
+$_ = 'aaaXXXXbbb';
+s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 21\n" : "not ok 21\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 22\n" : "not ok 22\n";
+
+$_ = 'aaaXXXXbbb';
+s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 23\n" : "not ok 23\n";
+
+$_ = 'aaaXXXXbbb';
+s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 24\n" : "not ok 24\n";
+
+$_ = 'aaaXXXXbbb';
+s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 25\n" : "not ok 25\n";
+
+$_ = 'aaaXXXXbbb';
+s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 26\n" : "not ok 26\n";
+
+# now for some unoptimized versions of the same.
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a//;
+print $_ eq 'aaXXXXbbb' ? "ok 27\n" : "not ok 27\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a//;
+print $_ eq 'aaXXXXbbb' ? "ok 28\n" : "not ok 28\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/^a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 29\n" : "not ok 29\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/a/b/;
+print $_ eq 'baaXXXXbbb' ? "ok 30\n" : "not ok 30\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa//;
+print $_ eq 'aXXXXbbb' ? "ok 31\n" : "not ok 31\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aa/b/;
+print $_ eq 'baXXXXbbb' ? "ok 32\n" : "not ok 32\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b$//;
+print $_ eq 'aaaXXXXbb' ? "ok 33\n" : "not ok 33\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/b//;
+print $_ eq 'aaaXXXXbb' ? "ok 34\n" : "not ok 34\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb//;
+print $_ eq 'aaaXXXXb' ? "ok 35\n" : "not ok 35\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aX/y/;
+print $_ eq 'aayXXXbbb' ? "ok 36\n" : "not ok 36\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/Xb/z/;
+print $_ eq 'aaaXXXzbb' ? "ok 37\n" : "not ok 37\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/aaX.*Xbb//;
+print $_ eq 'ab' ? "ok 38\n" : "not ok 38\n";
+
+$_ = 'aaaXXXXbbb';
+$x ne $x || s/bb/x/;
+print $_ eq 'aaaXXXXxb' ? "ok 39\n" : "not ok 39\n";
+
+$_ = 'abc123xyz';
+s/\d+/$&*2/e; # yields 'abc246xyz'
+print $_ eq 'abc246xyz' ? "ok 40\n" : "not ok 40\n";
+s/\d+/sprintf("%5d",$&)/e; # yields 'abc 246xyz'
+print $_ eq 'abc 246xyz' ? "ok 41\n" : "not ok 41\n";
+s/\w/$& x 2/eg; # yields 'aabbcc 224466xxyyzz'
+print $_ eq 'aabbcc 224466xxyyzz' ? "ok 42\n" : "not ok 42\n";
diff --git a/t/op.substr b/t/op.substr
new file mode 100644
index 0000000000..c91c377330
--- /dev/null
+++ b/t/op.substr
@@ -0,0 +1,42 @@
+#!./perl
+
+# $Header: op.substr,v 3.0 89/10/18 15:31:52 lwall Locked $
+
+print "1..19\n";
+
+$a = 'abcdefxyz';
+
+print (substr($a,0,3) eq 'abc' ? "ok 1\n" : "not ok 1\n");
+print (substr($a,3,3) eq 'def' ? "ok 2\n" : "not ok 2\n");
+print (substr($a,6,999) eq 'xyz' ? "ok 3\n" : "not ok 3\n");
+print (substr($a,999,999) eq '' ? "ok 4\n" : "not ok 4\n");
+print (substr($a,6,-1) eq '' ? "ok 5\n" : "not ok 5\n");
+print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n");
+
+$[ = 1;
+
+print (substr($a,1,3) eq 'abc' ? "ok 7\n" : "not ok 7\n");
+print (substr($a,4,3) eq 'def' ? "ok 8\n" : "not ok 8\n");
+print (substr($a,7,999) eq 'xyz' ? "ok 9\n" : "not ok 9\n");
+print (substr($a,999,999) eq '' ? "ok 10\n" : "not ok 10\n");
+print (substr($a,7,-1) eq '' ? "ok 11\n" : "not ok 11\n");
+print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n");
+
+$[ = 0;
+
+substr($a,3,3) = 'XYZ';
+print $a eq 'abcXYZxyz' ? "ok 13\n" : "not ok 13\n";
+substr($a,0,2) = '';
+print $a eq 'cXYZxyz' ? "ok 14\n" : "not ok 14\n";
+y/a/a/;
+substr($a,0,0) = 'ab';
+print $a eq 'abcXYZxyz' ? "ok 15\n" : "not ok 15 $a\n";
+substr($a,0,0) = '12345678';
+print $a eq '12345678abcXYZxyz' ? "ok 16\n" : "not ok 16\n";
+substr($a,-3,3) = 'def';
+print $a eq '12345678abcXYZdef' ? "ok 17\n" : "not ok 17\n";
+substr($a,-3,3) = '<';
+print $a eq '12345678abcXYZ<' ? "ok 18\n" : "not ok 18\n";
+substr($a,-1,1) = '12345678';
+print $a eq '12345678abcXYZ12345678' ? "ok 19\n" : "not ok 19\n";
+
diff --git a/t/op.time b/t/op.time
index befe78286c..d735564412 100644
--- a/t/op.time
+++ b/t/op.time
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.time,v 2.0 88/06/05 00:14:58 root Exp $
+# $Header: op.time,v 3.0 89/10/18 15:31:56 lwall Locked $
print "1..5\n";
diff --git a/t/op.undef b/t/op.undef
new file mode 100644
index 0000000000..0226ab7f3c
--- /dev/null
+++ b/t/op.undef
@@ -0,0 +1,56 @@
+#!./perl
+
+# $Header: op.undef,v 3.0 89/10/18 15:32:01 lwall Locked $
+
+print "1..21\n";
+
+print defined($a) ? "not ok 1\n" : "ok 1\n";
+
+$a = 1+1;
+print defined($a) ? "ok 2\n" : "not ok 2\n";
+
+undef $a;
+print defined($a) ? "not ok 3\n" : "ok 3\n";
+
+$a = "hi";
+print defined($a) ? "ok 4\n" : "not ok 4\n";
+
+$a = $b;
+print defined($a) ? "not ok 5\n" : "ok 5\n";
+
+@ary = ("1arg");
+$a = pop(@ary);
+print defined($a) ? "ok 6\n" : "not ok 6\n";
+$a = pop(@ary);
+print defined($a) ? "not ok 7\n" : "ok 7\n";
+
+@ary = ("1arg");
+$a = shift(@ary);
+print defined($a) ? "ok 8\n" : "not ok 8\n";
+$a = shift(@ary);
+print defined($a) ? "not ok 9\n" : "ok 9\n";
+
+$ary{'foo'} = 'hi';
+print defined($ary{'foo'}) ? "ok 10\n" : "not ok 10\n";
+print defined($ary{'bar'}) ? "not ok 11\n" : "ok 11\n";
+undef $ary{'foo'};
+print defined($ary{'foo'}) ? "not ok 12\n" : "ok 12\n";
+
+print defined(@ary) ? "ok 13\n" : "not ok 13\n";
+print defined(%ary) ? "ok 14\n" : "not ok 14\n";
+undef @ary;
+print defined(@ary) ? "not ok 15\n" : "ok 15\n";
+undef %ary;
+print defined(%ary) ? "not ok 16\n" : "ok 16\n";
+@ary = (1);
+print defined @ary ? "ok 17\n" : "not ok 18\n";
+%ary = (1,1);
+print defined %ary ? "ok 18\n" : "not ok 18\n";
+
+sub foo { print "ok 19\n"; }
+
+&foo || print "not ok 19\n";
+
+print defined &foo ? "ok 20\n" : "not ok 20\n";
+undef &foo;
+print defined(&foo) ? "not ok 21\n" : "ok 21\n";
diff --git a/t/op.unshift b/t/op.unshift
index 948902a97f..0612c2c2a5 100644
--- a/t/op.unshift
+++ b/t/op.unshift
@@ -1,6 +1,6 @@
#!./perl
-# $Header: op.unshift,v 2.0 88/06/05 00:15:00 root Exp $
+# $Header: op.unshift,v 3.0 89/10/18 15:32:06 lwall Locked $
print "1..2\n";
diff --git a/t/op.vec b/t/op.vec
new file mode 100644
index 0000000000..bfc7d76342
--- /dev/null
+++ b/t/op.vec
@@ -0,0 +1,24 @@
+#!./perl
+
+# $Header: op.vec,v 3.0 89/10/18 15:32:11 lwall Locked $
+
+print "1..13\n";
+
+print vec($foo,0,1) == 0 ? "ok 1\n" : "not ok 1\n";
+print length($foo) == 0 ? "ok 2\n" : "not ok 2\n";
+vec($foo,0,1) = 1;
+print length($foo) == 1 ? "ok 3\n" : "not ok 3\n";
+print ord($foo) == 1 ? "ok 4\n" : "not ok 4\n";
+print vec($foo,0,1) == 1 ? "ok 5\n" : "not ok 5\n";
+
+print vec($foo,20,1) == 0 ? "ok 6\n" : "not ok 6\n";
+vec($foo,20,1) = 1;
+print vec($foo,20,1) == 1 ? "ok 7\n" : "not ok 7\n";
+print length($foo) == 3 ? "ok 8\n" : "not ok 8\n";
+print vec($foo,1,8) == 0 ? "ok 9\n" : "not ok 9\n";
+vec($foo,1,8) = 0xf1;
+print vec($foo,1,8) == 0xf1 ? "ok 10\n" : "not ok 10\n";
+print ((ord(substr($foo,1,1)) & 255) == 0xf1 ? "ok 11\n" : "not ok 11\n");
+print vec($foo,2,4) == 1 ? "ok 12\n" : "not ok 12\n";
+print vec($foo,3,4) == 15 ? "ok 13\n" : "not ok 13\n";
+
diff --git a/t/op.write b/t/op.write
new file mode 100644
index 0000000000..e1da85cc04
--- /dev/null
+++ b/t/op.write
@@ -0,0 +1,87 @@
+#!./perl
+
+# $Header: op.write,v 3.0 89/10/18 15:32:16 lwall Locked $
+
+print "1..2\n";
+
+format OUT =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<<
+$foo
+^<<<<<<<<<
+$foo
+^<<<<<<...
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+
+open(OUT, '>Op.write.tmp') || die "Can't create Op.write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT);
+close OUT;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of huma...
+now is the time for all good men to come to\n";
+
+if (`cat Op.write.tmp` eq $right)
+ { print "ok 1\n"; unlink 'Op.write.tmp'; }
+else
+ { print "not ok 1\n"; }
+
+format OUT2 =
+the quick brown @<<
+$fox
+jumped
+@*
+$multiline
+^<<<<<<<<< ~~
+$foo
+now @<<the@>>>> for all@|||||men to come @<<<<
+'i' . 's', "time\n", $good, 'to'
+.
+
+open(OUT2, '>Op.write.tmp') || die "Can't create Op.write.tmp";
+
+$fox = 'foxiness';
+$good = 'good';
+$multiline = "forescore\nand\nseven years\n";
+$foo = 'when in the course of human events it becomes necessary';
+write(OUT2);
+close OUT2;
+
+$right =
+"the quick brown fox
+jumped
+forescore
+and
+seven years
+when in
+the course
+of human
+events it
+becomes
+necessary
+now is the time for all good men to come to\n";
+
+if (`cat Op.write.tmp` eq $right)
+ { print "ok 2\n"; unlink 'Op.write.tmp'; }
+else
+ { print "not ok 2\n"; }
+
diff --git a/t/re_tests b/t/re_tests
index 807f6ece36..3a6d62a187 100644
--- a/t/re_tests
+++ b/t/re_tests
@@ -8,14 +8,22 @@ ab*c abc y $& abc
ab*bc abc y $& abc
ab*bc abbc y $& abbc
ab*bc abbbbc y $& abbbbc
+ab{0,}bc abbbbc y $& abbbbc
ab+bc abbc y $& abbc
ab+bc abc n - -
ab+bc abq n - -
+ab{1,}bc abq n - -
ab+bc abbbbc y $& abbbbc
+ab{1,}bc abbbbc y $& abbbbc
+ab{1,3}bc abbbbc y $& abbbbc
+ab{3,4}bc abbbbc y $& abbbbc
+ab{4,5}bc abbbbc n - -
ab?bc abbc y $& abbc
ab?bc abc y $& abc
+ab{0,1}bc abc y $& abc
ab?bc abbbbc n - -
ab?c abc y $& abc
+ab{0,1}c abc y $& abc
^abc$ abc y $& abc
^abc$ abcc n - -
^abc abcc y $& abc
@@ -64,6 +72,7 @@ abc) - c - -
((a)) abc y $&-$1-$2 a-a-a
(a)b(c) abc y $&-$1-$2 abc-a-c
a+b+c aabbabc y $& abc
+a{1,}b{1,}c aabbabc y $& abc
a** - c - -
a*? - c - -
(a*)* - c - -
@@ -71,8 +80,11 @@ a*? - c - -
(a|)* - c - -
(a*|b)* - c - -
(a+|b)* ab y $&-$1 ab-b
+(a+|b){0,} ab y $&-$1 ab-b
(a+|b)+ ab y $&-$1 ab-b
+(a+|b){1,} ab y $&-$1 ab-b
(a+|b)? ab y $&-$1 a-a
+(a+|b){0,1} ab y $&-$1 a-a
(^)* - c - -
(ab|)* - c - -
)( - c - -