diff options
author | Larry Wall <larry@wall.org> | 1989-10-18 00:00:00 +0000 |
---|---|---|
committer | Larry Wall <larry@wall.org> | 1989-10-18 00:00:00 +0000 |
commit | a687059cbaf2c6fdccb5e0fae2aee80ec15625a8 (patch) | |
tree | 674c8533b7bd942204f23782934c72f8624dd308 /t | |
parent | 13281fa4f8547e0eb31d1986b865d9b7ec7d0dcc (diff) | |
download | perl-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/TEST | 9 | ||||
-rw-r--r-- | t/base.cond | 2 | ||||
-rw-r--r-- | t/base.if | 2 | ||||
-rw-r--r-- | t/base.lex | 45 | ||||
-rw-r--r-- | t/base.pat | 2 | ||||
-rw-r--r-- | t/base.term | 2 | ||||
-rw-r--r-- | t/cmd.elsif | 10 | ||||
-rw-r--r-- | t/cmd.for | 4 | ||||
-rw-r--r-- | t/cmd.mod | 9 | ||||
-rw-r--r-- | t/cmd.subval | 37 | ||||
-rw-r--r-- | t/cmd.switch | 75 | ||||
-rw-r--r-- | t/cmd.while | 4 | ||||
-rw-r--r-- | t/comp.cmdopt | 2 | ||||
-rw-r--r-- | t/comp.cpp | 2 | ||||
-rw-r--r-- | t/comp.decl | 2 | ||||
-rw-r--r-- | t/comp.multiline | 2 | ||||
-rw-r--r-- | t/comp.package | 33 | ||||
-rw-r--r-- | t/comp.script | 2 | ||||
-rw-r--r-- | t/comp.term | 11 | ||||
-rw-r--r-- | t/io.argv | 2 | ||||
-rw-r--r-- | t/io.dup | 28 | ||||
-rw-r--r-- | t/io.fs | 7 | ||||
-rw-r--r-- | t/io.inplace | 2 | ||||
-rw-r--r-- | t/io.pipe | 4 | ||||
-rw-r--r-- | t/io.print | 8 | ||||
-rw-r--r-- | t/io.tell | 2 | ||||
-rw-r--r-- | t/op.append | 2 | ||||
-rw-r--r-- | t/op.array | 100 | ||||
-rw-r--r-- | t/op.auto | 2 | ||||
-rw-r--r-- | t/op.chop | 15 | ||||
-rw-r--r-- | t/op.cond | 2 | ||||
-rw-r--r-- | t/op.dbm | 95 | ||||
-rw-r--r-- | t/op.delete | 8 | ||||
-rw-r--r-- | t/op.do | 2 | ||||
-rw-r--r-- | t/op.each | 12 | ||||
-rw-r--r-- | t/op.eval | 4 | ||||
-rw-r--r-- | t/op.exec | 2 | ||||
-rw-r--r-- | t/op.exp | 2 | ||||
-rw-r--r-- | t/op.flip | 2 | ||||
-rw-r--r-- | t/op.fork | 2 | ||||
-rw-r--r-- | t/op.glob | 22 | ||||
-rw-r--r-- | t/op.goto | 2 | ||||
-rw-r--r-- | t/op.index | 26 | ||||
-rw-r--r-- | t/op.int | 2 | ||||
-rw-r--r-- | t/op.join | 2 | ||||
-rw-r--r-- | t/op.list | 36 | ||||
-rw-r--r-- | t/op.local | 45 | ||||
-rw-r--r-- | t/op.magic | 9 | ||||
-rw-r--r-- | t/op.mkdir | 15 | ||||
-rw-r--r-- | t/op.oct | 2 | ||||
-rw-r--r-- | t/op.ord | 2 | ||||
-rw-r--r-- | t/op.pack | 18 | ||||
-rw-r--r-- | t/op.pat | 29 | ||||
-rw-r--r-- | t/op.push | 6 | ||||
-rw-r--r-- | t/op.range | 30 | ||||
-rw-r--r-- | t/op.read | 19 | ||||
-rw-r--r-- | t/op.regexp | 2 | ||||
-rw-r--r-- | t/op.repeat | 2 | ||||
-rw-r--r-- | t/op.sleep | 2 | ||||
-rw-r--r-- | t/op.sort | 19 | ||||
-rw-r--r-- | t/op.split | 28 | ||||
-rw-r--r-- | t/op.sprintf | 6 | ||||
-rw-r--r-- | t/op.stat | 7 | ||||
-rw-r--r-- | t/op.study | 2 | ||||
-rw-r--r-- | t/op.subst | 122 | ||||
-rw-r--r-- | t/op.substr | 42 | ||||
-rw-r--r-- | t/op.time | 2 | ||||
-rw-r--r-- | t/op.undef | 56 | ||||
-rw-r--r-- | t/op.unshift | 2 | ||||
-rw-r--r-- | t/op.vec | 24 | ||||
-rw-r--r-- | t/op.write | 87 | ||||
-rw-r--r-- | t/re_tests | 12 |
72 files changed, 1119 insertions, 119 deletions
@@ -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 @@ -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";} @@ -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; @@ -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";} @@ -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"; @@ -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"; @@ -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"; @@ -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"; @@ -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"; @@ -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"; @@ -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"; @@ -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}; } @@ -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 { @@ -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";} @@ -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";} @@ -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"; @@ -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"; @@ -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"; @@ -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"; @@ -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"); @@ -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"; @@ -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"; @@ -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"); @@ -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"; @@ -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"); @@ -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"; @@ -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";} @@ -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"; + @@ -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 - - |