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