diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/README | 5 | ||||
| -rwxr-xr-x | t/SDBM_File.so | 4 | ||||
| -rwxr-xr-x | t/TEST | 4 | ||||
| -rwxr-xr-x | t/bar | 110 | ||||
| -rwxr-xr-x | t/base/lex.t | 2 | ||||
| -rwxr-xr-x | t/base/term.t | 4 | ||||
| l--------- | t/c | 1 | ||||
| -rwxr-xr-x | t/cmd/elsif.t | 8 | ||||
| -rwxr-xr-x | t/cmd/while.t | 16 | ||||
| -rwxr-xr-x | t/comp/multiline.t | 2 | ||||
| -rwxr-xr-x | t/comp/package.t | 6 | ||||
| -rwxr-xr-x | t/comp/script.t | 5 | ||||
| -rwxr-xr-x | t/foo | 282 | ||||
| -rw-r--r-- | t/foo.out | 36 | ||||
| -rw-r--r-- | t/foo_tests | 1 | ||||
| -rwxr-xr-x | t/io/tell.t | 2 | ||||
| -rwxr-xr-x | t/lib/anydbm.t | 114 | ||||
| -rwxr-xr-x | t/lib/db-btree.t | 351 | ||||
| -rwxr-xr-x | t/lib/db-hash.t | 253 | ||||
| -rwxr-xr-x | t/lib/db-recno.t | 142 | ||||
| -rwxr-xr-x | t/lib/english.t | 4 | ||||
| -rwxr-xr-x | t/lib/gdbm.t | 117 | ||||
| -rwxr-xr-x | t/lib/ndbm.t | 7 | ||||
| -rwxr-xr-x | t/lib/odbm.t | 120 | ||||
| -rwxr-xr-x | t/lib/posix.t | 74 | ||||
| -rwxr-xr-x | t/lib/sdbm.t | 9 | ||||
| -rwxr-xr-x | t/lib/soundex.t | 143 | ||||
| -rw-r--r-- | t/make.out | 1 | ||||
| -rw-r--r-- | t/makefile | 7 | ||||
| -rwxr-xr-x | t/op/array.t | 4 | ||||
| -rwxr-xr-x | t/op/chop.t | 44 | ||||
| -rwxr-xr-x | t/op/delete.t | 10 | ||||
| -rwxr-xr-x | t/op/flip.t | 4 | ||||
| -rwxr-xr-x | t/op/goto.t | 2 | ||||
| -rwxr-xr-x | t/op/magic.t | 2 | ||||
| -rwxr-xr-x | t/op/misc.t | 174 | ||||
| -rwxr-xr-x | t/op/pat.t | 26 | ||||
| -rwxr-xr-x | t/op/quotemeta.t | 26 | ||||
| -rwxr-xr-x | t/op/rand.t | 25 | ||||
| -rw-r--r-- | t/op/re_tests | 65 | ||||
| -rwxr-xr-x | t/op/read.t | 2 | ||||
| -rwxr-xr-x | t/op/readdir.t | 7 | ||||
| -rwxr-xr-x | t/op/ref.t | 23 | ||||
| -rwxr-xr-x | t/op/sort.t | 2 | ||||
| -rwxr-xr-x | t/op/split.t | 3 | ||||
| -rwxr-xr-x | t/op/substr.t | 4 | ||||
| -rwxr-xr-x | t/op/time.t | 8 | ||||
| -rwxr-xr-x | t/op/write.t | 24 | ||||
| l--------- | t/perl | 1 | ||||
| -rw-r--r-- | t/perl5a1.tar | bin | 8192 -> 0 bytes | |||
| -rw-r--r-- | t/re_tests | 274 | ||||
| -rw-r--r-- | t/tmp/bullet | 13 | ||||
| -rwxr-xr-x | t/x | 3 |
53 files changed, 2018 insertions, 558 deletions
@@ -8,4 +8,9 @@ If you put out extra lines with a '#' character on the front, you don't have to worry about removing the extra print statements later since TEST ignores lines beginning with '#'. +Several tests assume you have sucessfully included the POSIX +extension. If you have not, lib/[nos]dbm.t will fail. Try replacing +the O_CREAT|O_RDWR with either 0x202 or 0x102 in the tie statements +and run the tests again. + If you come up with new tests, send them to lwall@netlabs.com. diff --git a/t/SDBM_File.so b/t/SDBM_File.so deleted file mode 100755 index ace796d88b..0000000000 --- a/t/SDBM_File.so +++ /dev/null @@ -1,4 +0,0 @@ -#!./perl -Dst - -$ref = [[],2,[3,4,5,]]; -print ${$$ref[2]}[2] == 5 ? "ok 16\n" : "not ok 16\n"; @@ -37,7 +37,7 @@ while ($test = shift) { chop($te); print "$te" . '.' x (15 - length($te)); if ($sharpbang) { - open(results,"./$test|") || (print "can't run.\n"); + open(results,"./$test |") || (print "can't run.\n"); } else { open(script,"$test") || die "Can't run $test.\n"; $_ = <script>; @@ -47,7 +47,7 @@ while ($test = shift) { } else { $switch = ''; } - open(results,"./perl$switch $test|") || (print "can't run.\n"); + open(results,"./perl$switch $test |") || (print "can't run.\n"); } $ok = 0; $next = 0; diff --git a/t/bar b/t/bar deleted file mode 100755 index 0170138188..0000000000 --- a/t/bar +++ /dev/null @@ -1,110 +0,0 @@ -#!./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/lex.t b/t/base/lex.t index 1828ac62e8..f25cd2a12c 100755 --- a/t/base/lex.t +++ b/t/base/lex.t @@ -65,7 +65,7 @@ print qq/ok 14\n/; print qq(ok 15\n); print qq -ok 16\n +[ok 16\n] ; print q<ok 17 diff --git a/t/base/term.t b/t/base/term.t index 0f9a46f6c9..42cd56fe0b 100755 --- a/t/base/term.t +++ b/t/base/term.t @@ -29,7 +29,7 @@ if ($x == '1') {print "ok 4\n";} else {print "not ok 4\n";} # check <> pseudoliteral -open(try, "/dev/null") || (die "Can't open /dev/null."); +open(try, "/dev/null") || open(try,"nla0:") || (die "Can't open /dev/null."); if (<try> eq '') { print "ok 5\n"; } @@ -38,5 +38,5 @@ else { die "/dev/null IS NOT A CHARACTER SPECIAL FILE!!!!\n" unless -c '/dev/null'; } -open(try, "../Makefile") || (die "Can't open ../Makefile."); +open(try, "../Configure") || (die "Can't open ../Configure."); if (<try> ne '') {print "ok 6\n";} else {print "not ok 6\n";} @@ -1 +0,0 @@ -TEST
\ No newline at end of file diff --git a/t/cmd/elsif.t b/t/cmd/elsif.t index e42fa61137..7eace161e0 100755 --- a/t/cmd/elsif.t +++ b/t/cmd/elsif.t @@ -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 '$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";} +if (($x = &foo(1)) == 1) {print "ok 1\n";} else {print "not ok 1 '$x'\n";} +if (($x = &foo(2)) == 2) {print "ok 2\n";} else {print "not ok 2 '$x'\n";} +if (($x = &foo(3)) == 3) {print "ok 3\n";} else {print "not ok 3 '$x'\n";} +if (($x = &foo(4)) == 4) {print "ok 4\n";} else {print "not ok 4 '$x'\n";} diff --git a/t/cmd/while.t b/t/cmd/while.t index f42174eeca..4c8c10e990 100755 --- a/t/cmd/while.t +++ b/t/cmd/while.t @@ -4,7 +4,7 @@ print "1..10\n"; -open (tmp,'>Cmd.while.tmp') || die "Can't create Cmd.while.tmp."; +open (tmp,'>Cmd_while.tmp') || die "Can't create Cmd_while.tmp."; print tmp "tvi925\n"; print tmp "tvi920\n"; print tmp "vt100\n"; @@ -14,7 +14,7 @@ close tmp; # test "last" command -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; while (<fh>) { last if /vt100/; } @@ -23,7 +23,7 @@ if (!eof && /vt100/) {print "ok 1\n";} else {print "not ok 1 $_\n";} # test "next" command $bad = ''; -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; while (<fh>) { next if /vt100/; $bad = 1 if /vt100/; @@ -33,7 +33,7 @@ if (!eof || /vt100/ || $bad) {print "not ok 2\n";} else {print "ok 2\n";} # test "redo" command $bad = ''; -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; while (<fh>) { if (s/vt100/VT100/g) { s/VT100/Vt100/g; @@ -49,7 +49,7 @@ if (!eof || $bad) {print "not ok 3\n";} else {print "ok 3\n";} # test "last" command $badcont = ''; -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; line: while (<fh>) { if (/vt100/) {last line;} } continue { @@ -62,7 +62,7 @@ if (!$badcont) {print "ok 5\n";} else {print "not ok 5\n";} $bad = ''; $badcont = 1; -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; entry: while (<fh>) { next entry if /vt100/; $bad = 1 if /vt100/; @@ -76,7 +76,7 @@ if (!$badcont) {print "ok 7\n";} else {print "not ok 7\n";} $bad = ''; $badcont = ''; -open(fh,'Cmd.while.tmp') || die "Can't open Cmd.while.tmp."; +open(fh,'Cmd_while.tmp') || die "Can't open Cmd_while.tmp."; loop: while (<fh>) { if (s/vt100/VT100/g) { s/VT100/Vt100/g; @@ -90,7 +90,7 @@ loop: while (<fh>) { if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";} if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";} -`/bin/rm -f Cmd.while.tmp`; +unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`; #$x = 0; #while (1) { diff --git a/t/comp/multiline.t b/t/comp/multiline.t index 1d238f95b3..634b06a7a8 100755 --- a/t/comp/multiline.t +++ b/t/comp/multiline.t @@ -35,6 +35,6 @@ if ($count == 3) {print "ok 3\n";} else {print "not ok 3\n";} $_ = `cat Comp.try`; if (/.*\n.*\n.*\n$/) {print "ok 4\n";} else {print "not ok 4\n";} -`/bin/rm -f Comp.try`; +unlink 'Comp.try' || `/bin/rm -f Comp.try`; if ($_ eq $y) {print "ok 5\n";} else {print "not ok 5\n";} diff --git a/t/comp/package.t b/t/comp/package.t index 456c0ffa4d..ca800bb364 100755 --- a/t/comp/package.t +++ b/t/comp/package.t @@ -19,9 +19,9 @@ $ABC'dyick = 6; $xyz = 2; -$main = join(':', sort(keys %::_main)); -$XYZ = join(':', sort(keys %::_XYZ)); -$ABC = join(':', sort(keys %::_ABC)); +$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 '$ABC'\n"; diff --git a/t/comp/script.t b/t/comp/script.t index 7dd78cdd95..f37e46bb66 100755 --- a/t/comp/script.t +++ b/t/comp/script.t @@ -5,6 +5,7 @@ print "1..3\n"; $x = `./perl -e 'print "ok\n";'`; +if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "print ""ok\n""";`; } if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} @@ -13,11 +14,13 @@ print try 'print "ok\n";'; print try "\n"; close try; $x = `./perl Comp.script`; +if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. Comp.script`; } if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";} $x = `./perl <Comp.script`; +if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. <Comp.script`; } if ($x eq "ok\n") {print "ok 3\n";} else {print "not ok 3\n";} -`/bin/rm -f Comp.script`; +unlink 'Comp.script' || `/bin/rm -f Comp.script`; diff --git a/t/foo b/t/foo deleted file mode 100755 index 034c5c6457..0000000000 --- a/t/foo +++ /dev/null @@ -1,282 +0,0 @@ -#!./perl - -BEGIN { @INC = '../lib' } -require "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__ -&bnorm -abc:NaN - 1 a:NaN -1bcd2:NaN -11111b:NaN -+1z:NaN --1z:NaN -0:+0 -+0:+0 -+00:+0 -+0 0 0:+0 -000000 0000000 00000:+0 --0:+0 --0000:+0 -+1:+1 -+01:+1 -+001:+1 -+00000100000:+100000 -123456789:+123456789 --1:-1 --01:-1 --001:-1 --123456789:-123456789 --00000100000:-100000 -&bneg -abd:NaN -+0:+0 -+1:-1 --1:+1 -+123456789:-123456789 --123456789:+123456789 -&babs -abc:NaN -+0:+0 -+1:+1 --1:+1 -+123456789:+123456789 --123456789:+123456789 -&bcmp -abc:abc: -abc:+0: -+0:abc: -+0:+0:0 --1:+0:-1 -+0:-1:1 -+1:+0:1 -+0:+1:-1 --1:+1:-1 -+1:-1:1 --1:-1:0 -+1:+1:0 -+123:+123:0 -+123:+12:1 -+12:+123:-1 --123:-123:0 --123:-12:-1 --12:-123:1 -+123:+124:-1 -+124:+123:1 --123:-124:1 --124:-123:-1 -&badd -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+0:+0:+0 -+1:+0:+1 -+0:+1:+1 -+1:+1:+2 --1:+0:-1 -+0:-1:-1 --1:-1:-2 --1:+1:+0 -+1:-1:+0 -+9:+1:+10 -+99:+1:+100 -+999:+1:+1000 -+9999:+1:+10000 -+99999:+1:+100000 -+999999:+1:+1000000 -+9999999:+1:+10000000 -+99999999:+1:+100000000 -+999999999:+1:+1000000000 -+9999999999:+1:+10000000000 -+99999999999:+1:+100000000000 -+10:-1:+9 -+100:-1:+99 -+1000:-1:+999 -+10000:-1:+9999 -+100000:-1:+99999 -+1000000:-1:+999999 -+10000000:-1:+9999999 -+100000000:-1:+99999999 -+1000000000:-1:+999999999 -+10000000000:-1:+9999999999 -+123456789:+987654321:+1111111110 --123456789:+987654321:+864197532 --123456789:-987654321:-1111111110 -+123456789:-987654321:-864197532 -&bsub -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+0:+0:+0 -+1:+0:+1 -+0:+1:-1 -+1:+1:+0 --1:+0:-1 -+0:-1:+1 --1:-1:+0 --1:+1:-2 -+1:-1:+2 -+9:+1:+8 -+99:+1:+98 -+999:+1:+998 -+9999:+1:+9998 -+99999:+1:+99998 -+999999:+1:+999998 -+9999999:+1:+9999998 -+99999999:+1:+99999998 -+999999999:+1:+999999998 -+9999999999:+1:+9999999998 -+99999999999:+1:+99999999998 -+10:-1:+11 -+100:-1:+101 -+1000:-1:+1001 -+10000:-1:+10001 -+100000:-1:+100001 -+1000000:-1:+1000001 -+10000000:-1:+10000001 -+100000000:-1:+100000001 -+1000000000:-1:+1000000001 -+10000000000:-1:+10000000001 -+123456789:+987654321:-864197532 --123456789:+987654321:-1111111110 --123456789:-987654321:+864197532 -+123456789:-987654321:+1111111110 -&bmul -abc:abc:NaN -abc:+0:NaN -+0:abc:NaN -+0:+0:+0 -+0:+1:+0 -+1:+0:+0 -+0:-1:+0 --1:+0:+0 -+123456789123456789:+0:+0 -+0:+123456789123456789:+0 --1:-1:+1 --1:+1:-1 -+1:-1:-1 -+1:+1:+1 -+2:+3:+6 --2:+3:-6 -+2:-3:-6 --2:-3:+6 -+111:+111:+12321 -+10101:+10101:+102030201 -+1001001:+1001001:+1002003002001 -+100010001:+100010001:+10002000300020001 -+10000100001:+10000100001:+100002000030000200001 -+11111111111:+9:+99999999999 -+22222222222:+9:+199999999998 -+33333333333:+9:+299999999997 -+44444444444:+9:+399999999996 -+55555555555:+9:+499999999995 -+66666666666:+9:+599999999994 -+77777777777:+9:+699999999993 -+88888888888:+9:+799999999992 -+99999999999:+9:+899999999991 -&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/foo.out b/t/foo.out deleted file mode 100644 index 422ebf8155..0000000000 --- a/t/foo.out +++ /dev/null @@ -1,36 +0,0 @@ -{ -5 TYPE = block exit ===> DONE - FLAGS = (UNKNOWN,KIDS,PARENS) - { -1 TYPE = block entry ===> 2 - } - { -2 TYPE = next statement ===> 3 - FLAGS = (SCALAR) - LINE = 1 - } - { -4 TYPE = subroutine entry ===> 5 - FLAGS = (UNKNOWN,KIDS) - { - TYPE = null operation ===> (4) - WAS = subroutine reference - FLAGS = (SCALAR,KIDS) - { -3 TYPE = glob value ===> 4 - FLAGS = (SCALAR) - GV = main::foo - } - } - } -} - -SUB ODBM_File::init = (xsub 0x7efb8 0) - -SUB SDBM_File::init = (xsub 0x80318 0) - -SUB NDBM_File::init = (xsub 0x7ddf8 0) - -EXECUTING... - -- syntax OK diff --git a/t/foo_tests b/t/foo_tests deleted file mode 100644 index ee8f80050a..0000000000 --- a/t/foo_tests +++ /dev/null @@ -1 +0,0 @@ -'((a))'i ABC y $&-$1-$2 A-A-A diff --git a/t/io/tell.t b/t/io/tell.t index af012b08cf..5badafeacb 100755 --- a/t/io/tell.t +++ b/t/io/tell.t @@ -6,7 +6,7 @@ print "1..13\n"; $TST = 'tst'; -open($TST, '../Makefile') || (die "Can't open ../Makefile"); +open($TST, '../Configure') || (die "Can't open ../Configure"); if (eof(tst)) { print "not ok 1\n"; } else { print "ok 1\n"; } diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t new file mode 100755 index 0000000000..11ac103a64 --- /dev/null +++ b/t/lib/anydbm.t @@ -0,0 +1,114 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} +require AnyDBM_File; +#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT +use Fcntl; + +print "1..12\n"; + +unlink <Op.dbmx*>; + +umask(0); +print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); + +$Dfile = "Op.dbmx.pag"; +if (! -e $Dfile) { + ($Dfile) = <Op.dbmx*>; +} +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +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'}; + +untie(%h); +print (tie(%h,AnyDBM_File,'Op.dbmx', O_RDWR, 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";} + +$h{'foo'} = ''; +$h{''} = 'bar'; + +# 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($Dfile); +print ($size > 0 ? "ok 9\n" : "not ok 9\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +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', $Dfile; diff --git a/t/lib/db-btree.t b/t/lib/db-btree.t new file mode 100755 index 0000000000..308b8f489a --- /dev/null +++ b/t/lib/db-btree.t @@ -0,0 +1,351 @@ +#!./perl + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDB_File\b/) { + print "1..0\n"; + exit 0; + } +} + +use DB_File; +use Fcntl; + +print "1..73\n"; + +$Dfile = "Op.db-btree"; +unlink $Dfile; + +umask(0); + +# Check the interface to BTREEINFO + +$dbh = TIEHASH DB_File::BTREEINFO ; +print (($dbh->{flags} == undef) ? "ok 1\n" : "not ok 1\n") ; +print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ; +print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ; +print (($dbh->{lorder} == undef) ? "ok 4\n" : "not ok 4\n") ; +print (($dbh->{minkeypage} == undef) ? "ok 5\n" : "not ok 5\n") ; +print (($dbh->{maxkeypage} == undef) ? "ok 6\n" : "not ok 6\n") ; +print (($dbh->{compare} == undef) ? "ok 7\n" : "not ok 7\n") ; +print (($dbh->{prefix} == undef) ? "ok 8\n" : "not ok 8\n") ; + +$dbh->{flags} = 3000 ; +print ($dbh->{flags} == 3000 ? "ok 9\n" : "not ok 9\n") ; + +$dbh->{cachesize} = 9000 ; +print ($dbh->{cachesize} == 9000 ? "ok 10\n" : "not ok 10\n") ; +# +$dbh->{psize} = 400 ; +print (($dbh->{psize} == 400) ? "ok 11\n" : "not ok 11\n") ; + +$dbh->{lorder} = 65 ; +print (($dbh->{lorder} == 65) ? "ok 12\n" : "not ok 12\n") ; + +$dbh->{minkeypage} = 123 ; +print (($dbh->{minkeypage} == 123) ? "ok 13\n" : "not ok 13\n") ; + +$dbh->{maxkeypage} = 1234 ; +print ($dbh->{maxkeypage} == 1234 ? "ok 14\n" : "not ok 14\n") ; + +$dbh->{compare} = 1234 ; +print ($dbh->{compare} == 1234 ? "ok 15\n" : "not ok 15\n") ; + +$dbh->{prefix} = 1234 ; +print ($dbh->{prefix} == 1234 ? "ok 16\n" : "not ok 16\n") ; + +# Check that an invalid entry is caught both for store & fetch +eval '$dbh->{fred} = 1234' ; +print ($@ eq '' ? "ok 17\n" : "not ok 17\n") ; +eval '$q = $dbh->{fred}' ; +print ($@ eq '' ? "ok 18\n" : "not ok 18\n") ; + +# Now check the interface to BTREE + +print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 19\n" : "not ok 19"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +print (($mode & 0777) == 0640 ? "ok 20\n" : "not ok 20\n"); + +while (($key,$value) = each(%h)) { + $i++; +} +print (!$i ? "ok 21\n" : "not ok 21\n"); + +$h{'goner1'} = 'snork'; + +$h{'abc'} = 'ABC'; +print ($h{'abc'} == 'ABC' ? "ok 22\n" : "not ok 22\n") ; +print (defined $h{'jimmy'} ? "not ok 23\n" : "ok 23\n"); + +$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'; +$X->STORE('b', 'B') ; + +$h{'c'} = 'C'; + +#$h{'d'} = 'D'; +$X->put('d', 'D') ; + +$h{'e'} = 'E'; +$h{'f'} = 'F'; +$h{'g'} = 'X'; +$h{'h'} = 'H'; +$h{'i'} = 'I'; + +$h{'goner2'} = 'snork'; +delete $h{'goner2'}; + + +# IMPORTANT - $X must be undefined before the untie otherwise the +# underlying DB close routine will not get called. +undef $X ; +untie(%h); + + +# tie to the same file again +print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE)) ? "ok 24\n" : "not ok 24\n"); + +# Modify an entry from the previous tie +$h{'g'} = 'G'; + +$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'}; +$X->DELETE('goner3'); + +@keys = keys(%h); +@values = values(%h); + +if ($#keys == 29 && $#values == 29) {print "ok 25\n";} else {print "not ok 25\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 26\n";} else {print "not ok 26\n";} + +@keys = ('blurfl', keys(h), 'dyick'); +if ($#keys == 31) {print "ok 27\n";} else {print "not ok 27\n";} + +#Check that the keys can be retrieved in order +$ok = 1 ; +foreach (keys %h) +{ + ($ok = 0), last if defined $previous && $previous gt $_ ; + $previous = $_ ; +} +print ($ok ? "ok 28\n" : "not ok 28\n") ; + +$h{'foo'} = ''; +print ($h{'foo'} eq '' ? "ok 29\n" : "not ok 29\n") ; + +$h{''} = 'bar'; +print ($h{''} eq 'bar' ? "ok 30\n" : "not ok 30\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 31\n" : "not ok 31\n"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +print ($size > 0 ? "ok 32\n" : "not ok 32\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +print join(':',200..400) eq join(':',@foo) ? "ok 33\n" : "not ok 33\n"; + +# Now check all the non-tie specific stuff + + +# Check R_NOOVERWRITE flag will make put fail when attempting to overwrite +# an existing record. + +$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ; +print ($status == 1 ? "ok 34\n" : "not ok 34\n") ; + +# check that the value of the key 'x' has not been changed by the +# previous test +print ($h{'x'} eq 'X' ? "ok 35\n" : "not ok 35\n") ; + +# standard put +$status = $X->put('key', 'value') ; +print ($status == 0 ? "ok 36\n" : "not ok 36\n") ; + +#check that previous put can be retrieved +$status = $X->get('key', $value) ; +print ($status == 0 ? "ok 37\n" : "not ok 37\n") ; +print ($value eq 'value' ? "ok 38\n" : "not ok 38\n") ; + +# Attempting to delete an existing key should work + +$status = $X->del('q') ; +print ($status == 0 ? "ok 39\n" : "not ok 39\n") ; +$status = $X->del('') ; +print ($status == 0 ? "ok 40\n" : "not ok 40\n") ; + +# Make sure that the key deleted, cannot be retrieved +print (($h{'q'} eq undef) ? "ok 41\n" : "not ok 41\n") ; +print (($h{''} eq undef) ? "ok 42\n" : "not ok 42\n") ; + +undef $X ; +untie %h ; + +print (($X = tie(%h, DB_File,$Dfile, O_RDWR, 0640, $DB_BTREE )) ? "ok 43\n" : "not ok 43"); + +# Attempting to delete a non-existant key should fail + +$status = $X->del('joe') ; +print ($status == 1 ? "ok 44\n" : "not ok 44\n") ; + +# Check the get interface + +# First a non-existing key +$status = $X->get('aaaa', $value) ; +print ($status == 1 ? "ok 45\n" : "not ok 45\n") ; + +# Next an existing key +$status = $X->get('a', $value) ; +print ($status == 0 ? "ok 46\n" : "not ok 46\n") ; +print ($value eq 'A' ? "ok 47\n" : "not ok 47\n") ; + +# seq +# ### + +# use seq to find an approximate match +$key = 'ke' ; +$value = '' ; +$status = $X->seq($key, $value, R_CURSOR) ; +print ($status == 0 ? "ok 48\n" : "not ok 48\n") ; +print ($key eq 'key' ? "ok 49\n" : "not ok 49\n") ; +print ($value eq 'value' ? "ok 50\n" : "not ok 50\n") ; + +# seq when the key does not match +$key = 'zzz' ; +$value = '' ; +$status = $X->seq($key, $value, R_CURSOR) ; +print ($status == 1 ? "ok 51\n" : "not ok 51\n") ; + + +# use seq to set the cursor, then delete the record @ the cursor. + +$key = 'x' ; +$value = '' ; +$status = $X->seq($key, $value, R_CURSOR) ; +print ($status == 0 ? "ok 52\n" : "not ok 52\n") ; +print ($key eq 'x' ? "ok 53\n" : "not ok 53\n") ; +print ($value eq 'X' ? "ok 54\n" : "not ok 54\n") ; +$status = $X->del(0, R_CURSOR) ; +print ($status == 0 ? "ok 55\n" : "not ok 55\n") ; +$status = $X->get('x', $value) ; +print ($status == 1 ? "ok 56\n" : "not ok 56\n") ; + +# ditto, but use put to replace the key/value pair. +$key = 'y' ; +$value = '' ; +$status = $X->seq($key, $value, R_CURSOR) ; +print ($status == 0 ? "ok 57\n" : "not ok 57\n") ; +print ($key eq 'y' ? "ok 58\n" : "not ok 58\n") ; +print ($value eq 'Y' ? "ok 59\n" : "not ok 59\n") ; + +$key = "replace key" ; +$value = "replace value" ; +$status = $X->put($key, $value, R_CURSOR) ; +print ($status == 0 ? "ok 60\n" : "not ok 60\n") ; +print ($key eq 'replace key' ? "ok 61\n" : "not ok 61\n") ; +print ($value eq 'replace value' ? "ok 62\n" : "not ok 62\n") ; +$status = $X->get('y', $value) ; +print ($status == 1 ? "ok 63\n" : "not ok 63\n") ; + +# use seq to walk forwards through a file + +$status = $X->seq($key, $value, R_FIRST) ; +print ($status == 0 ? "ok 64\n" : "not ok 64\n") ; +$previous = $key ; + +$ok = 1 ; +while (($status = $X->seq($key, $value, R_NEXT)) == 0) +{ + ($ok = 0), last if ($previous cmp $key) == 1 ; +} + +print ($status == 1 ? "ok 65\n" : "not ok 65\n") ; +print ($ok == 1 ? "ok 66\n" : "not ok 66\n") ; + +# use seq to walk backwards through a file +$status = $X->seq($key, $value, R_LAST) ; +print ($status == 0 ? "ok 67\n" : "not ok 67\n") ; +$previous = $key ; + +$ok = 1 ; +while (($status = $X->seq($key, $value, R_PREV)) == 0) +{ + ($ok = 0), last if ($previous cmp $key) == -1 ; + #print "key = [$key] value = [$value]\n" ; +} + +print ($status == 1 ? "ok 68\n" : "not ok 68\n") ; +print ($ok == 1 ? "ok 69\n" : "not ok 69\n") ; + + +# check seq FIRST/LAST + +# sync +# #### + +$status = $X->sync ; +print ($status == 0 ? "ok 70\n" : "not ok 70\n") ; + + +# fd +# ## + +$status = $X->fd ; +print ($status != 0 ? "ok 71\n" : "not ok 71\n") ; + + +undef $X ; +untie %h ; + +unlink $Dfile; + +# Now try an in memory file +print (($Y = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_BTREE )) ? "ok 72\n" : "not ok 72"); + +# fd with an in memory file should return failure +$status = $Y->fd ; +print ($status == -1 ? "ok 73\n" : "not ok 73\n") ; + +undef $Y ; +untie %h ; + +exit ; diff --git a/t/lib/db-hash.t b/t/lib/db-hash.t new file mode 100755 index 0000000000..6c3ef55200 --- /dev/null +++ b/t/lib/db-hash.t @@ -0,0 +1,253 @@ +#!./perl + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDB_File\b/) { + print "1..0\n"; + exit 0; + } +} + +use DB_File; +use Fcntl; + +print "1..43\n"; + +$Dfile = "Op.db-hash"; +unlink $Dfile; + +umask(0); + +# Check the interface to HASHINFO + +$dbh = TIEHASH DB_File::HASHINFO ; +print (($dbh->{bsize} == undef) ? "ok 1\n" : "not ok 1\n") ; +print (($dbh->{ffactor} == undef) ? "ok 2\n" : "not ok 2\n") ; +print (($dbh->{nelem} == undef) ? "ok 3\n" : "not ok 3\n") ; +print (($dbh->{cachesize} == undef) ? "ok 4\n" : "not ok 4\n") ; +print (($dbh->{hash} == undef) ? "ok 5\n" : "not ok 5\n") ; +print (($dbh->{lorder} == undef) ? "ok 6\n" : "not ok 6\n") ; + +$dbh->{bsize} = 3000 ; +print ($dbh->{bsize} == 3000 ? "ok 7\n" : "not ok 7\n") ; + +$dbh->{ffactor} = 9000 ; +print ($dbh->{ffactor} == 9000 ? "ok 8\n" : "not ok 8\n") ; +# +$dbh->{nelem} = 400 ; +print (($dbh->{nelem} == 400) ? "ok 9\n" : "not ok 9\n") ; + +$dbh->{cachesize} = 65 ; +print (($dbh->{cachesize} == 65) ? "ok 10\n" : "not ok 10\n") ; + +$dbh->{hash} = "abc" ; +print (($dbh->{hash} eq "abc") ? "ok 11\n" : "not ok 11\n") ; + +$dbh->{lorder} = 1234 ; +print ($dbh->{lorder} == 1234 ? "ok 12\n" : "not ok 12\n") ; + +# Check that an invalid entry is caught both for store & fetch +eval '$dbh->{fred} = 1234' ; +print ($@ eq '' ? "ok 13\n" : "not ok 13\n") ; +eval '$q = $dbh->{fred}' ; +print ($@ eq '' ? "ok 14\n" : "not ok 14\n") ; + +# Now check the interface to HASH + +print (($X = tie(%h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 15\n" : "not ok 15"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +print (($mode & 0777) == 0640 ? "ok 16\n" : "not ok 16\n"); + +while (($key,$value) = each(%h)) { + $i++; +} +print (!$i ? "ok 17\n" : "not ok 17\n"); + +$h{'goner1'} = 'snork'; + +$h{'abc'} = 'ABC'; +print ($h{'abc'} == 'ABC' ? "ok 18\n" : "not ok 18\n") ; +print (defined $h{'jimmy'} ? "not ok 19\n" : "ok 19\n"); + +$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'; +$X->STORE('b', 'B') ; + +$h{'c'} = 'C'; + +#$h{'d'} = 'D'; +$X->put('d', 'D') ; + +$h{'e'} = 'E'; +$h{'f'} = 'F'; +$h{'g'} = 'X'; +$h{'h'} = 'H'; +$h{'i'} = 'I'; + +$h{'goner2'} = 'snork'; +delete $h{'goner2'}; + + +# IMPORTANT - $X must be undefined before the untie otherwise the +# underlying DB close routine will not get called. +undef $X ; +untie(%h); + + +# tie to the same file again, do not supply a type - should default to HASH +print (($X = tie(%h,DB_File,$Dfile, O_RDWR, 0640)) ? "ok 20\n" : "not ok 20: $!\n"); + +# Modify an entry from the previous tie +$h{'g'} = 'G'; + +$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'}; +$X->DELETE('goner3'); + +@keys = keys(%h); +@values = values(%h); + +if ($#keys == 29 && $#values == 29) {print "ok 21\n";} else {print "not ok 21\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 22\n";} else {print "not ok 22\n";} + +@keys = ('blurfl', keys(h), 'dyick'); +if ($#keys == 31) {print "ok 23\n";} else {print "not ok 23\n";} + +$h{'foo'} = ''; +print ($h{'foo'} eq '' ? "ok 24\n" : "not ok 24\n") ; + +$h{''} = 'bar'; +print ($h{''} eq 'bar' ? "ok 25\n" : "not ok 25\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 26\n" : "not ok 26\n"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +print ($size > 0 ? "ok 27\n" : "not ok 27\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +print join(':',200..400) eq join(':',@foo) ? "ok 28\n" : "not ok 28\n"; + + +# Now check all the non-tie specific stuff + +# Check NOOVERWRITE will make put fail when attempting to overwrite +# an existing record. + +$status = $X->put( 'x', 'newvalue', R_NOOVERWRITE) ; +print ($status == 1 ? "ok 29\n" : "not ok 29\n") ; + +# check that the value of the key 'x' has not been changed by the +# previous test +print ($h{'x'} eq 'X' ? "ok 30\n" : "not ok 30\n") ; + +# standard put +$status = $X->put('key', 'value') ; +print ($status == 0 ? "ok 31\n" : "not ok 31\n") ; + +#check that previous put can be retrieved +$status = $X->get('key', $value) ; +print ($status == 0 ? "ok 32\n" : "not ok 32\n") ; +print ($value eq 'value' ? "ok 33\n" : "not ok 33\n") ; + +# Attempting to delete an existing key should work + +$status = $X->del('q') ; +print ($status == 0 ? "ok 34\n" : "not ok 34\n") ; + +# Make sure that the key deleted, cannot be retrieved +print (($h{'q'} eq undef) ? "ok 35\n" : "not ok 35\n") ; + +# Attempting to delete a non-existant key should fail + +$status = $X->del('joe') ; +print ($status == 1 ? "ok 36\n" : "not ok 36\n") ; + +# Check the get interface + +# First a non-existing key +$status = $X->get('aaaa', $value) ; +print ($status == 1 ? "ok 37\n" : "not ok 37\n") ; + +# Next an existing key +$status = $X->get('a', $value) ; +print ($status == 0 ? "ok 38\n" : "not ok 38\n") ; +print ($value eq 'A' ? "ok 39\n" : "not ok 39\n") ; + +# seq +# ### + +# ditto, but use put to replace the key/value pair. + +# use seq to walk backwards through a file - check that this reversed is + +# check seq FIRST/LAST + +# sync +# #### + +$status = $X->sync ; +print ($status == 0 ? "ok 40\n" : "not ok 40\n") ; + + +# fd +# ## + +$status = $X->fd ; +print ($status != 0 ? "ok 41\n" : "not ok 41\n") ; + +undef $X ; +untie %h ; + +unlink $Dfile; + +# Now try an in memory file +print (($X = tie(%h, DB_File,undef, O_RDWR|O_CREAT, 0640, $DB_HASH )) ? "ok 42\n" : "not ok 42"); + +# fd with an in memory file should return fail +$status = $X->fd ; +print ($status == -1 ? "ok 43\n" : "not ok 43\n") ; + +untie %h ; +undef $X ; + +exit ; diff --git a/t/lib/db-recno.t b/t/lib/db-recno.t new file mode 100755 index 0000000000..64ad7b8a9e --- /dev/null +++ b/t/lib/db-recno.t @@ -0,0 +1,142 @@ +#!./perl + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bDB_File\b/) { + print "1..0\n"; + exit 0; + } +} + +use DB_File; +use Fcntl; + +print "1..30\n"; + +$Dfile = "Op.db-recno"; +unlink $Dfile; + +umask(0); + +# Check the interface to RECNOINFO + +$dbh = TIEHASH DB_File::RECNOINFO ; +print (($dbh->{bval} == undef) ? "ok 1\n" : "not ok 1\n") ; +print (($dbh->{cachesize} == undef) ? "ok 2\n" : "not ok 2\n") ; +print (($dbh->{psize} == undef) ? "ok 3\n" : "not ok 3\n") ; +print (($dbh->{flags} == undef) ? "ok 4\n" : "not ok 4\n") ; +print (($dbh->{lorder} == undef) ? "ok 5\n" : "not ok 5\n") ; +print (($dbh->{reclen} == undef) ? "ok 6\n" : "not ok 6\n") ; +print (($dbh->{bfname} == undef) ? "ok 7\n" : "not ok 7\n") ; + +$dbh->{bval} = 3000 ; +print ($dbh->{bval} == 3000 ? "ok 8\n" : "not ok 8\n") ; + +$dbh->{cachesize} = 9000 ; +print ($dbh->{cachesize} == 9000 ? "ok 9\n" : "not ok 9\n") ; + +$dbh->{psize} = 400 ; +print (($dbh->{psize} == 400) ? "ok 10\n" : "not ok 10\n") ; + +$dbh->{flags} = 65 ; +print (($dbh->{flags} == 65) ? "ok 11\n" : "not ok 11\n") ; + +$dbh->{lorder} = 123 ; +print (($dbh->{lorder} == 123) ? "ok 12\n" : "not ok 12\n") ; + +$dbh->{reclen} = 1234 ; +print ($dbh->{reclen} == 1234 ? "ok 13\n" : "not ok 13\n") ; + +$dbh->{bfname} = 1234 ; +print ($dbh->{bfname} == 1234 ? "ok 14\n" : "not ok 14\n") ; + + +# Check that an invalid entry is caught both for store & fetch +eval '$dbh->{fred} = 1234' ; +print ($@ eq '' ? "ok 15\n" : "not ok 15\n") ; +eval '$q = $dbh->{fred}' ; +print ($@ eq '' ? "ok 16\n" : "not ok 16\n") ; + +# Now check the interface to RECNOINFO + +print (($X = tie(@h, DB_File,$Dfile, O_RDWR|O_CREAT, 0640, $DB_RECNO )) ? "ok 17\n" : "not ok 17"); + +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +print (($mode & 0777) == 0640 ? "ok 18\n" : "not ok 18\n"); + +#$l = @h ; +$l = $X->length ; +print (!$l ? "ok 19\n" : "not ok 19\n"); + +@data = qw( a b c d ever f g h i j k longername m n o p) ; + +$h[0] = shift @data ; +print ($h[0] eq 'a' ? "ok 20\n" : "not ok 20\n") ; + +foreach (@data) + { $h[++$i] = $_ } + +unshift (@data, 'a') ; + +print (defined $h[1] ? "ok 21\n" : "not ok 21\n"); +print (! defined $h[16] ? "ok 22\n" : "not ok 22\n"); +print ($X->length == @data ? "ok 23\n" : "not ok 23\n") ; + + +# Overwrite an entry & check fetch it +$h[3] = 'replaced' ; +$data[3] = 'replaced' ; +print ($h[3] eq 'replaced' ? "ok 24\n" : "not ok 24\n"); + +#PUSH +@push_data = qw(added to the end) ; +#push (@h, @push_data) ; +$X->push(@push_data) ; +push (@data, @push_data) ; +print ($h[++$i] eq 'added' ? "ok 25\n" : "not ok 25\n"); + +# POP +pop (@data) ; +#$value = pop(@h) ; +$value = $X->pop ; +print ($value eq 'end' ? "not ok 26\n" : "ok 26\n"); + +# SHIFT +#$value = shift @h +$value = $X->shift ; +print ($value eq shift @data ? "not ok 27\n" : "ok 27\n"); + +# UNSHIFT + +# empty list +$X->unshift ; +print ($X->length == @data ? "ok 28\n" : "not ok 28\n") ; + +@new_data = qw(add this to the start of the array) ; +#unshift @h, @new_data ; +$X->unshift (@new_data) ; +unshift (@data, @new_data) ; +print ($X->length == @data ? "ok 29\n" : "not ok 29\n") ; + +# SPLICE + +# Now both arrays should be identical + +$ok = 1 ; +$j = 0 ; +foreach (@data) +{ + $ok = 0, last if $_ ne $h[$j ++] ; +} +print ($ok ? "ok 30\n" : "not ok 30\n") ; + +# IMPORTANT - $X must be undefined before the untie otherwise the +# underlying DB close routine will not get called. +undef $X ; +untie(@h); + +unlink $Dfile; + +exit ; diff --git a/t/lib/english.t b/t/lib/english.t index 5c76407357..d7a30f9305 100755 --- a/t/lib/english.t +++ b/t/lib/english.t @@ -3,7 +3,7 @@ print "1..16\n"; BEGIN { @INC = '../lib' } -require English; import English; +use English; print $PID == $$ ? "ok 1\n" : "not ok 1\n"; @@ -29,7 +29,7 @@ $LIST_SEPARATOR = "\n"; print "@foo"; undef $OUTPUT_RECORD_SEPARATOR; -eval 'no such function'; +eval 'NO SUCH FUNCTION'; print "ok 10\n" if $EVAL_ERROR =~ /method/; print $UID == $< ? "ok 11\n" : "not ok 11\n"; diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t new file mode 100755 index 0000000000..0d2c1fe023 --- /dev/null +++ b/t/lib/gdbm.t @@ -0,0 +1,117 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ + +BEGIN { + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bGDBM_File\b/) { + print "1..0\n"; + exit 0; + } +} + +use GDBM_File; + +print "1..12\n"; + +unlink <Op.dbmx*>; + +umask(0); +print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 0640) ? "ok 1\n" : "not ok 1\n"); + +$Dfile = "Op.dbmx.pag"; +if (! -e $Dfile) { + ($Dfile) = <Op.dbmx*>; +} +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +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'}; + +untie(%h); +print (tie(%h,GDBM_File,'Op.dbmx', &GDBM_WRCREAT, 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";} + +$h{'foo'} = ''; +$h{''} = 'bar'; + +# 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($Dfile); +print ($size > 0 ? "ok 9\n" : "not ok 9\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +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', $Dfile; diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index c69e2f8739..e3093dbcfb 100755 --- a/t/lib/ndbm.t +++ b/t/lib/ndbm.t @@ -3,6 +3,7 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { + chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bNDBM_File\b/) { @@ -12,13 +13,15 @@ BEGIN { } require NDBM_File; +#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT +use Fcntl; print "1..12\n"; unlink <Op.dbmx*>; umask(0); -print (tie(%h,NDBM_File,'Op.dbmx', 0x202, 0640) ? "ok 1\n" : "not ok 1\n"); +print (tie(%h,NDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { @@ -52,7 +55,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,NDBM_File,'Op.dbmx', 0x2, 0640) ? "ok 4\n" : "not ok 4\n"); +print (tie(%h,NDBM_File,'Op.dbmx', &O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); $h{'j'} = 'J'; $h{'k'} = 'K'; diff --git a/t/lib/odbm.t b/t/lib/odbm.t new file mode 100755 index 0000000000..b49aa91043 --- /dev/null +++ b/t/lib/odbm.t @@ -0,0 +1,120 @@ +#!./perl + +# $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bODBM_File\b/) { + print "1..0\n"; + exit 0; + } +} + +require ODBM_File; +#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT +use Fcntl; + +print "1..12\n"; + +unlink <Op.dbmx*>; + +umask(0); +print (tie(%h,ODBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); + +$Dfile = "Op.dbmx.pag"; +if (! -e $Dfile) { + ($Dfile) = <Op.dbmx*>; +} +($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($Dfile); +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'}; + +untie(%h); +print (tie(%h,ODBM_File,'Op.dbmx', O_RDWR, 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";} + +$h{'foo'} = ''; +$h{''} = 'bar'; + +# 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($Dfile); +print ($size > 0 ? "ok 9\n" : "not ok 9\n"); + +@h{0..200} = 200..400; +@foo = @h{0..200}; +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', $Dfile; diff --git a/t/lib/posix.t b/t/lib/posix.t new file mode 100755 index 0000000000..bde6e0bbac --- /dev/null +++ b/t/lib/posix.t @@ -0,0 +1,74 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($Config{'extensions'} !~ /\bPOSIX\b/) { + print STDERR "1..0\n"; + exit 0; + } +} +use FileHandle; +use POSIX qw(fcntl_h signal_h limits_h _exit getcwd open read write); +use strict subs; + +$mystdout = new_from_fd FileHandle 1,"w"; +autoflush STDOUT; +autoflush $mystdout; +print "1..16\n"; + +print $mystdout "ok ",fileno($mystdout),"\n"; +write(1,"ok 2\nnot ok 2\n", 5); + +$testfd = open("TEST", O_RDONLY, 0) and print "ok 3\n"; +read($testfd, $buffer, 9) if $testfd > 2; +print $buffer eq "#!./perl\n" ? "ok 4\n" : "not ok 4\n"; + +@fds = POSIX::pipe(); +print $fds[0] == $testfd + 1 ? "ok 5\n" : "not ok 5\n"; +$writer = FileHandle->new_from_fd($fds[1], "w"); +$reader = FileHandle->new_from_fd($fds[0], "r"); +print $writer "ok 6\n"; +close $writer; +print <$reader>; +close $reader; + +$sigset = new POSIX::SigSet 1,3; +delset $sigset 1; +if (!ismember $sigset 1) { print "ok 7\n" } +if (ismember $sigset 3) { print "ok 8\n" } +$mask = new POSIX::SigSet &SIGINT; +$action = new POSIX::SigAction 'main::SigHUP', $mask, 0; +sigaction(&SIGHUP, $action); +$SIG{'INT'} = 'SigINT'; +kill 'HUP', $$; +sleep 1; +print "ok 12\n"; + +sub SigHUP { + print "ok 9\n"; + kill 'INT', $$; + sleep 2; + print "ok 10\n"; +} + +sub SigINT { + print "ok 11\n"; +} + +print &_POSIX_OPEN_MAX > $fds[1] ? "ok 13\n" : "not ok 13\n"; + +print getcwd() =~ m#/t$# ? "ok 14\n" : "not ok 14\n"; + +# Pick up whether we're really able to dynamically load everything. +print &POSIX::acos(1.0) == 0.0 ? "ok 15\n" : "not ok 15\n"; + +ungetc STDIN 65; +CORE::read(STDIN, $buf,1); +print $buf eq 'A' ? "ok 16\n" : "not ok 16\n"; + +flush STDOUT; +autoflush STDOUT 0; +print '@#!*$@(!@#$'; +_exit(0); diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t index 1304be29b2..a754bb72a4 100755 --- a/t/lib/sdbm.t +++ b/t/lib/sdbm.t @@ -3,21 +3,24 @@ # $RCSfile: dbm.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:43 $ BEGIN { + chdir 't' if -d 't'; @INC = '../lib'; require Config; import Config; if ($Config{'extensions'} !~ /\bSDBM_File\b/) { - print STDERR "1..0\n"; + print "1..0\n"; exit 0; } } require SDBM_File; +#If Fcntl is not available, try 0x202 or 0x102 for O_RDWR|O_CREAT +use Fcntl; print "1..12\n"; unlink <Op.dbmx*>; umask(0); -print (tie(%h,SDBM_File,'Op.dbmx', 0x202, 0640) ? "ok 1\n" : "not ok 1\n"); +print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR|O_CREAT, 0640) ? "ok 1\n" : "not ok 1\n"); $Dfile = "Op.dbmx.pag"; if (! -e $Dfile) { @@ -51,7 +54,7 @@ $h{'goner2'} = 'snork'; delete $h{'goner2'}; untie(%h); -print (tie(%h,SDBM_File,'Op.dbmx', 0x2, 0640) ? "ok 4\n" : "not ok 4\n"); +print (tie(%h,SDBM_File,'Op.dbmx', O_RDWR, 0640) ? "ok 4\n" : "not ok 4\n"); $h{'j'} = 'J'; $h{'k'} = 'K'; diff --git a/t/lib/soundex.t b/t/lib/soundex.t new file mode 100755 index 0000000000..d35f264c7a --- /dev/null +++ b/t/lib/soundex.t @@ -0,0 +1,143 @@ +#!./perl +# +# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $ +# +# test module for soundex.pl +# +# $Log: soundex.t,v $ +# Revision 1.2 1994/03/24 00:30:27 mike +# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu> +# in the way I handles leasing characters which were different but had +# the same soundex code. This showed up comparing it with Oracle's +# soundex output. +# +# Revision 1.1 1994/03/02 13:03:02 mike +# Initial revision +# +# + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +use Text::Soundex; + +$test = 0; +print "1..13\n"; + +while (<DATA>) +{ + chop; + next if /^\s*;?#/; + next if /^\s*$/; + + ++$test; + $bad = 0; + + if (/^eval\s+/) + { + ($try = $_) =~ s/^eval\s+//; + + eval ($try); + if ($@) + { + $bad++; + print "not ok $test\n"; + print "# eval '$try' returned $@"; + } + } + elsif (/^\(/) + { + ($in, $out) = split (':'); + + $try = "\@expect = $out; \@got = &soundex $in;"; + eval ($try); + + if (@expect != @got) + { + $bad++; + print "not ok $test\n"; + print "# expected ", scalar @expect, " results, got ", scalar @got, "\n"; + print "# expected (", join (', ', @expect), + ") got (", join (', ', @got), ")\n"; + } + else + { + while (@got) + { + $expect = shift @expect; + $got = shift @got; + + if ($expect ne $got) + { + $bad++; + print "not ok $test\n"; + print "# expected $expect, got $got\n"; + } + } + } + } + else + { + ($in, $out) = split (':'); + + $try = "\$expect = $out; \$got = &soundex ($in);"; + eval ($try); + + if ($expect ne $got) + { + $bad++; + print "not ok $test\n"; + print "# expected $expect, got $got\n"; + } + } + + print "ok $test\n" unless $bad; +} + +__END__ +# +# 1..6 +# +# Knuth's test cases, scalar in, scalar out +# +'Euler':'E460' +'Gauss':'G200' +'Hilbert':'H416' +'Knuth':'K530' +'Lloyd':'L300' +'Lukasiewicz':'L222' +# +# 7..8 +# +# check default bad code +# +'2 + 2 = 4':undef +undef:undef +# +# 9 +# +# check array in, array out +# +('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222') +# +# 10 +# +# check array with explicit undef +# +('Mike', undef, 'Stok'):('M200', undef, 'S320') +# +# 11..12 +# +# check setting $Text::Soundex::noCode +# +eval $soundex_nocode = 'Z000'; +('Mike', undef, 'Stok'):('M200', 'Z000', 'S320') +# +# 13 +# +# a subtle difference between me & oracle, spotted by Rich Pinder +# <rpinder@hsc.usc.edu> +# +CZARKOWSKA:C622 diff --git a/t/make.out b/t/make.out deleted file mode 100644 index bc43d67974..0000000000 --- a/t/make.out +++ /dev/null @@ -1 +0,0 @@ -forceme 'cd ..; make' diff --git a/t/makefile b/t/makefile deleted file mode 100644 index 5ef5395865..0000000000 --- a/t/makefile +++ /dev/null @@ -1,7 +0,0 @@ -all: - forceme 'cd ..; $(MAKE)' - -perl: fooperl - -fooperl: - forceme 'cd ..; $(MAKE) perl' diff --git a/t/op/array.t b/t/op/array.t index 089fb5528e..ed471b4c4d 100755 --- a/t/op/array.t +++ b/t/op/array.t @@ -23,9 +23,9 @@ 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 +$#ary += 1; # see if element 5 gone for good 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";} +if (defined $ary[5]) {print "not ok 11\n";} else {print "ok 11\n";} $[ = 0; @foo = (); diff --git a/t/op/chop.t b/t/op/chop.t index d20b546465..3516c2d18c 100755 --- a/t/op/chop.t +++ b/t/op/chop.t @@ -2,7 +2,7 @@ # $RCSfile: chop.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:40 $ -print "1..4\n"; +print "1..22\n"; # optimized @@ -28,3 +28,45 @@ 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"; + +$_ = "foo\n\n"; +print chomp() == 1 ? "ok 5\n" : "not ok 5\n"; +print $_ eq "foo\n" ? "ok 6\n" : "not ok 6\n"; + +$_ = "foo\n"; +print chomp() == 1 ? "ok 7\n" : "not ok 7\n"; +print $_ eq "foo" ? "ok 8\n" : "not ok 8\n"; + +$_ = "foo"; +print chomp() == 0 ? "ok 9\n" : "not ok 9\n"; +print $_ eq "foo" ? "ok 10\n" : "not ok 10\n"; + +$_ = "foo"; +$/ = "oo"; +print chomp() == 2 ? "ok 11\n" : "not ok 11\n"; +print $_ eq "f" ? "ok 12\n" : "not ok 12\n"; + +$_ = "bar"; +$/ = "oo"; +print chomp() == 0 ? "ok 13\n" : "not ok 13\n"; +print $_ eq "bar" ? "ok 14\n" : "not ok 14\n"; + +$_ = "f\n\n\n\n\n"; +$/ = ""; +print chomp() == 5 ? "ok 15\n" : "not ok 15\n"; +print $_ eq "f" ? "ok 16\n" : "not ok 16\n"; + +$_ = "f\n\n"; +$/ = ""; +print chomp() == 2 ? "ok 17\n" : "not ok 17\n"; +print $_ eq "f" ? "ok 18\n" : "not ok 18\n"; + +$_ = "f\n"; +$/ = ""; +print chomp() == 1 ? "ok 19\n" : "not ok 19\n"; +print $_ eq "f" ? "ok 20\n" : "not ok 20\n"; + +$_ = "f"; +$/ = ""; +print chomp() == 0 ? "ok 21\n" : "not ok 21\n"; +print $_ eq "f" ? "ok 22\n" : "not ok 22\n"; diff --git a/t/op/delete.t b/t/op/delete.t index 86ed9b47ba..010cbf1003 100755 --- a/t/op/delete.t +++ b/t/op/delete.t @@ -2,7 +2,7 @@ # $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $ -print "1..6\n"; +print "1..7\n"; $foo{1} = 'a'; $foo{2} = 'b'; @@ -27,3 +27,11 @@ $foo{'bar'} = 'y'; $foo = join('',values(foo)); if ($foo eq 'xy' || $foo eq 'yx') {print "ok 6\n";} else {print "not ok 6\n";} + +$refhash{"top"}->{"foo"} = "FOO"; +$refhash{"top"}->{"bar"} = "BAR"; + +delete $refhash{"top"}->{"bar"}; +@list = keys %{$refhash{"top"}}; + +print "@list" eq "foo" ? "ok 7\n" : "not ok 7 @list\n"; diff --git a/t/op/flip.t b/t/op/flip.t index 72425da3a2..475f55a8c8 100755 --- a/t/op/flip.t +++ b/t/op/flip.t @@ -17,9 +17,9 @@ if ($y eq '12E0123E0') {print "ok 7\n";} else {print "not ok 7\n";} @a = ('a','b','c','d','e','f','g'); -open(of,'../Makefile'); +open(of,'../Configure'); while (<of>) { - (3 .. 5) && $foo .= $_; + (3 .. 5) && ($foo .= $_); } $x = ($foo =~ y/\n/\n/); diff --git a/t/op/goto.t b/t/op/goto.t index 21a35c1de3..087331907e 100755 --- a/t/op/goto.t +++ b/t/op/goto.t @@ -32,6 +32,8 @@ print "#2\t:$foo: == 4\n"; if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} $x = `./perl -e 'goto foo;' 2>&1`; +if ($x =~ /DCL-W-NOCOMD/) { $x = `\$ mcr sys\$disk:[]perl. -e "goto foo;"`; } + if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} sub foo { diff --git a/t/op/magic.t b/t/op/magic.t index 3243c625ce..b43f71c809 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -12,7 +12,7 @@ if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";} unlink 'ajslkdfpqjsjfk'; $! = 0; open(foo,'ajslkdfpqjsjfk'); -if ($! == 2) {print "ok 2\n";} else {print "not ok 2\n";} +if ($!) {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. diff --git a/t/op/misc.t b/t/op/misc.t new file mode 100755 index 0000000000..decba2d609 --- /dev/null +++ b/t/op/misc.t @@ -0,0 +1,174 @@ +#!./perl + +chdir 't' if -d 't'; +@INC = "../lib"; +$ENV{PERL5LIB} = "../lib"; + +$|=1; + +undef $/; +@prgs = split "\n########\n", <DATA>; +print "1..", scalar @prgs, "\n"; + +$tmpfile = "misctmp000"; +1 while -f ++$tmpfile; +END { unlink $tmpfile if $tmpfile; } + +for (@prgs){ + my $switch; + if (s/^\s*-\w+//){ + $switch = $&; + } + my($prog,$expected) = split(/\nEXPECT\n/, $_); + open TEST, "| sh -c './perl $switch' >$tmpfile 2>&1"; + print TEST $prog, "\n"; + close TEST; + $status = $?; + $results = `cat $tmpfile`; + $results =~ s/\n+$//; + $expected =~ s/\n+$//; + if ( $results ne $expected){ + print STDERR "PROG: $switch\n$prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; +} + +__END__ +$foo=undef; $foo->go; +EXPECT +Can't call method "go" without a package or object reference at - line 1. +######## +BEGIN + { + "foo"; + } +######## +-P +use POSIX; +######## +$array[128]=1 +######## +$x=0x0eabcd; print $x->ref; +EXPECT +Can't call method "ref" without a package or object reference at - line 1. +######## +chop ($str .= <STDIN>); +######## +close ($banana); +######## +$x=2;$y=3;$x<$y ? $x : $y += 23;print $x; +EXPECT +25 +######## +eval {sub bar {print "In bar";}} +######## +system "./perl -ne 'print if eof' /dev/null" +######## +chop($file = <>); +######## +package N; +sub new {my ($obj,$n)=@_; bless \$n} +$aa=new N 1; +$aa=12345; +print $aa; +EXPECT +12345 +######## +%@x=0; +EXPECT +Can't coerce HASH to string in repeat at - line 1. +######## +$_="foo"; +printf(STDOUT "%s\n", $_); +EXPECT +foo +######## +push(@a, 1, 2, 3,) +######## +quotemeta "" +######## +for ("ABCDE") { + ⊂ +s/./&sub($&)/eg; +print;} +sub sub {local($_) = @_; +$_ x 4;} +EXPECT +Modification of a read-only value attempted at - line 3. +######## +package FOO;sub new {bless {FOO => BAR}}; +package main; +use strict vars; +my $self = new FOO; +print $$self{FOO}; +EXPECT +BAR +######## +$_="foo"; +s/.{1}//s; +print; +EXPECT +oo +######## +print scalar ("foo","bar") +EXPECT +bar +######## +sub by_number { $a <=> $b; };# inline function for sort below +$as_ary{0}="a0"; +@ordered_array=sort by_number keys(%as_ary); +######## +sub NewShell +{ + local($Host) = @_; + my($m2) = $#Shells++; + $Shells[$m2]{HOST} = $Host; + return $m2; +} + +sub ShowShell +{ + local($i) = @_; +} + +&ShowShell(&NewShell(beach,Work,"+0+0")); +&ShowShell(&NewShell(beach,Work,"+0+0")); +&ShowShell(&NewShell(beach,Work,"+0+0")); +######## + { + package FAKEARRAY; + + sub TIEARRAY + { print "TIEARRAY @_\n"; + die "bomb out\n" unless $count ++ ; + bless ['foo'] + } + sub FETCH { print "fetch @_\n"; $_[0]->[$_[1]] } + sub STORE { print "store @_\n"; $_[0]->[$_[1]] = $_[2] } + sub DESTROY { print "DESTROY \n"; undef @{$_[0]}; } + } + +eval 'tie @h, FAKEARRAY, fred' ; +tie @h, FAKEARRAY, fred ; +EXPECT +TIEARRAY FAKEARRAY fred +TIEARRAY FAKEARRAY fred +DESTROY +######## +BEGIN { die "phooey\n" } +EXPECT +phooey +BEGIN failed--compilation aborted at - line 1. +######## +BEGIN { 1/$zero } +EXPECT +Illegal division by zero at - line 1. +BEGIN failed--compilation aborted at - line 1. +######## +BEGIN { undef = 0 } +EXPECT +Modification of a read-only value attempted at - line 1. +BEGIN failed--compilation aborted at - line 1. diff --git a/t/op/pat.t b/t/op/pat.t index a669526177..d93e6d66e2 100755 --- a/t/op/pat.t +++ b/t/op/pat.t @@ -2,7 +2,7 @@ # $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $ -print "1..51\n"; +print "1..60\n"; $x = "abc\ndef\n"; @@ -73,7 +73,7 @@ while ($_ = shift(XXX)) { /not ok 26/ && reset 'X'; } -while (($key,$val) = each(XXX)) { +while (($key,$val) = each(%XXX)) { print "not ok 27\n"; exit; } @@ -182,3 +182,25 @@ print "abc" =~ /^abc$|$xyz/ ? "ok 49\n" : "not ok 49\n"; eval '"abc" =~ /a(bc$)|$xyz/; $result = "$&:$1"'; print $@ eq "" ? "ok 50\n" : "not ok 50\n"; print $result eq "abc:bc" ? "ok 51\n" : "not ok 51\n"; + + +$_="abcfooabcbar"; +$x=/abc/g; +print $` eq "" ? "ok 52\n" : "not ok 52\n" if $x; +$x=/abc/g; +print $` eq "abcfoo" ? "ok 53\n" : "not ok 53\n" if $x; +$x=/abc/g; +print $x == 0 ? "ok 54\n" : "not ok 54\n"; +$x=/ABC/gi; +print $` eq "" ? "ok 55\n" : "not ok 55\n" if $x; +$x=/ABC/gi; +print $` eq "abcfoo" ? "ok 56\n" : "not ok 56\n" if $x; +$x=/ABC/gi; +print $x == 0 ? "ok 57\n" : "not ok 57\n"; +$x=/abc/g; +print $' eq "fooabcbar" ? "ok 58\n" : "not ok 58\n" if $x; +$x=/abc/g; +print $' eq "bar" ? "ok 59\n" : "not ok 59\n" if $x; +$_ .= ''; +@x=/abc/g; +print scalar @x == 2 ? "ok 60\n" : "not ok 60\n"; diff --git a/t/op/quotemeta.t b/t/op/quotemeta.t new file mode 100755 index 0000000000..09794571b1 --- /dev/null +++ b/t/op/quotemeta.t @@ -0,0 +1,26 @@ +#!./perl +print "1..15\n"; + +$_=join "", grep $_=chr($_), 32..127; + +#95 characters - 52 letters - 10 digits = 33 backslashes +#95 characters + 33 backslashes = 128 characters +$_=quotemeta $_; +if ( length == 128 ){print "ok 1\n"} else {print "not ok 1\n"} +if (tr/\\//cd == 94){print "ok 2\n"} else {print "not ok 2\n"} + +#perl5a11 bus errors on this: +if (length quotemeta "" == 0){print "ok 3\n"} else {print "not ok 3\n"} + +print "aA\UbB\LcC\EdD" eq "aABBccdD" ? "ok 4\n" : "not ok 4 \n"; +print "aA\LbB\UcC\EdD" eq "aAbbCCdD" ? "ok 5\n" : "not ok 5 \n"; +print "\L\upERL" eq "Perl" ? "ok 6\n" : "not ok 6 \n"; +print "\u\LpERL" eq "Perl" ? "ok 7\n" : "not ok 7 \n"; +print "\U\lPerl" eq "pERL" ? "ok 8\n" : "not ok 8 \n"; +print "\l\UPerl" eq "pERL" ? "ok 9\n" : "not ok 9 \n"; +print "\u\LpE\Q#X#\ER\EL" eq "Pe\\#x\\#rL" ? "ok 10\n" : "not ok 10 \n"; +print "\l\UPe\Q!x!\Er\El" eq "pE\\!X\\!Rl" ? "ok 11\n" : "not ok 11 \n"; +print "\Q\u\LpE.X.R\EL\E." eq "Pe\\.x\\.rL." ? "ok 12\n" : "not ok 12 \n"; +print "\Q\l\UPe*x*r\El\E*" eq "pE\\*X\\*Rl*" ? "ok 13\n" : "not ok 13 \n"; +print "\U\lPerl\E\E\E\E" eq "pERL" ? "ok 14\n" : "not ok 14 \n"; +print "\l\UPerl\E\E\E\E" eq "pERL" ? "ok 15\n" : "not ok 15 \n"; diff --git a/t/op/rand.t b/t/op/rand.t new file mode 100755 index 0000000000..14e6ccfbed --- /dev/null +++ b/t/op/rand.t @@ -0,0 +1,25 @@ +#!./perl + +#From jhi@snakemail.hut.fi Mon May 16 10:36:46 1994 +#Date: Sun, 15 May 1994 20:39:09 +0300 +#From: Jarkko Hietaniemi <jhi@snakemail.hut.fi> + +print "1..2\n"; + +$n = 1000; + +$c = 0; +for (1..$n) { + last if (rand() > 1 || rand() < 0); + $c++; +} + +if ($c == $n) {print "ok 1\n";} else {print "not ok 1\n"} + +$c = 0; +for (1..$n) { + last if (rand(10) > 10 || rand(10) < 0); + $c++; +} + +if ($c == $n) {print "ok 2\n";} else {print "not ok 2\n"} diff --git a/t/op/re_tests b/t/op/re_tests index ee03d6fdbd..f8c4c6eafb 100644 --- a/t/op/re_tests +++ b/t/op/re_tests @@ -56,10 +56,7 @@ a[^]b]c adc y $& adc ab|cd abc y $& ab ab|cd abcd y $& ab ()ef def y $&-$1 ef- -()* - c - - *a - c - - -^* - c - - -$* - c - - (*)b - c - - $b b n - - a\ - c - - @@ -74,19 +71,13 @@ abc) - c - - a+b+c aabbabc y $& abc a{1,}b{1,}c aabbabc y $& abc a** - c - - -a*? - c - - -(a*)* - c - - -(a*)+ - c - - -(a|)* - c - - -(a*|b)* - c - - +a.+?c abcabc y $& abc (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 - - [^ab]* cde y $& cde abc n - - @@ -95,7 +86,6 @@ a* y $& ([abc])*bcd abcd y $&-$1 abcd-a a|b|c|d|e e y $& e (a|b|c|d|e)f ef y $&-$1 ef-e -((a*|b))* - c - - abcd*efg abcdefg y $& abcdefg ab* xabyabbbz y $& ab ab* xayabbbz y $& a @@ -144,23 +134,23 @@ a[-]?c ac y $& ac 'ab*c'i ABC y $& ABC 'ab*bc'i ABC y $& ABC 'ab*bc'i ABBC y $& ABBC -'ab*bc'i ABBBBC y $& ABBBBC -'ab{0,}bc'i ABBBBC y $& ABBBBC -'ab+bc'i ABBC y $& ABBC +'ab*?bc'i ABBBBC y $& ABBBBC +'ab{0,}?bc'i ABBBBC y $& ABBBBC +'ab+?bc'i ABBC y $& ABBC 'ab+bc'i ABC n - - 'ab+bc'i ABQ n - - 'ab{1,}bc'i ABQ n - - 'ab+bc'i ABBBBC y $& ABBBBC -'ab{1,}bc'i ABBBBC y $& ABBBBC -'ab{1,3}bc'i ABBBBC y $& ABBBBC -'ab{3,4}bc'i ABBBBC y $& ABBBBC -'ab{4,5}bc'i ABBBBC n - - -'ab?bc'i ABBC y $& ABBC -'ab?bc'i ABC y $& ABC -'ab{0,1}bc'i ABC y $& ABC -'ab?bc'i ABBBBC n - - -'ab?c'i ABC y $& ABC -'ab{0,1}c'i ABC y $& ABC +'ab{1,}?bc'i ABBBBC y $& ABBBBC +'ab{1,3}?bc'i ABBBBC y $& ABBBBC +'ab{3,4}?bc'i ABBBBC y $& ABBBBC +'ab{4,5}?bc'i ABBBBC n - - +'ab??bc'i ABBC y $& ABBC +'ab??bc'i ABC y $& ABC +'ab{0,1}?bc'i ABC y $& ABC +'ab??bc'i ABBBBC n - - +'ab??c'i ABC y $& ABC +'ab{0,1}?c'i ABC y $& ABC '^abc$'i ABC y $& ABC '^abc$'i ABCC n - - '^abc'i ABCC y $& ABC @@ -170,7 +160,7 @@ a[-]?c ac y $& ac '$'i ABC y $& 'a.c'i ABC y $& ABC 'a.c'i AXC y $& AXC -'a.*c'i AXYZC y $& AXYZC +'a.*?c'i AXYZC y $& AXYZC 'a.*c'i AXYZD n - - 'a[bc]d'i ABC n - - 'a[bc]d'i ABD y $& ABD @@ -193,10 +183,7 @@ a[-]?c ac y $& ac 'ab|cd'i ABC y $& AB 'ab|cd'i ABCD y $& AB '()ef'i DEF y $&-$1 EF- -'()*'i - c - - '*a'i - c - - -'^*'i - c - - -'$*'i - c - - '(*)b'i - c - - '$b'i B n - - 'a\'i - c - - @@ -211,19 +198,16 @@ a[-]?c ac y $& ac 'a+b+c'i AABBABC y $& ABC 'a{1,}b{1,}c'i AABBABC y $& ABC 'a**'i - c - - -'a*?'i - c - - -'(a*)*'i - c - - -'(a*)+'i - c - - -'(a|)*'i - c - - -'(a*|b)*'i - c - - +'a.+?c'i ABCABC y $& ABC +'a.*?c'i ABCABC y $& ABC +'a.{0,5}?c'i ABCABC y $& ABC '(a+|b)*'i AB y $&-$1 AB-B '(a+|b){0,}'i AB y $&-$1 AB-B '(a+|b)+'i AB y $&-$1 AB-B '(a+|b){1,}'i AB y $&-$1 AB-B '(a+|b)?'i AB y $&-$1 A-A '(a+|b){0,1}'i AB y $&-$1 A-A -'(^)*'i - c - - -'(ab|)*'i - c - - +'(a+|b){0,1}?'i AB y $&-$1 - ')('i - c - - '[^ab]*'i CDE y $& CDE 'abc'i n - - @@ -232,7 +216,6 @@ a[-]?c ac y $& ac '([abc])*bcd'i ABCD y $&-$1 ABCD-A 'a|b|c|d|e'i E y $& E '(a|b|c|d|e)f'i EF y $&-$1 EF-E -'((a*|b))*'i - c - - 'abcd*efg'i ABCDEFG y $& ABCDEFG 'ab*'i XABYABBBZ y $& AB 'ab*'i XAYABBBZ y $& A @@ -262,6 +245,8 @@ a[-]?c ac y $& ac '((((((((((a))))))))))\41'i AA n - - '((((((((((a))))))))))\41'i A! y $& A! '(((((((((a)))))))))'i A y $& A +'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a))))))))))'i A y $1 A +'(?:(?:(?:(?:(?:(?:(?:(?:(?:(a|b|c))))))))))'i C y $1 C 'multiple words of text'i UH-UH n - - 'multiple words'i MULTIPLE WORDS, YEAH y $& MULTIPLE WORDS '(.*)c(.*)'i ABCDE y $&-$1-$2 ABCDE-AB-DE @@ -272,3 +257,11 @@ a[-]?c ac y $& ac 'a[-]?c'i AC y $& AC '(abc)\1'i ABCABC y $1 ABC '([a-c]*)\1'i ABCABC y $1 ABC +a(?!b). abad y $& ad +a(?=d). abad y $& ad +a(?=c|d). abad y $& ad +a(?:b|c|d)(.) ace y $1 e +a(?:b|c|d)*(.) ace y $1 e +a(?:b|c|d)+?(.) ace y $1 e +a(?:b|(c|e){1,2}?|d)+?(.) ace y $1$2 ce +^(.+)?B AB y $1 A diff --git a/t/op/read.t b/t/op/read.t index 8c571c035b..2746970d15 100755 --- a/t/op/read.t +++ b/t/op/read.t @@ -12,7 +12,7 @@ $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); +seek (FOO,0,2) || seek(FOO,20000,0); $got = read(FOO,$buf,4); print ($got == 0 ? "ok 3\n" : "not ok 3\n"); diff --git a/t/op/readdir.t b/t/op/readdir.t index 18006991cd..1215f11c8a 100755 --- a/t/op/readdir.t +++ b/t/op/readdir.t @@ -6,13 +6,18 @@ if ($@) { print "1..0\n"; exit; } print "1..3\n"; if (opendir(OP, "op")) { print "ok 1\n"; } else { print "not ok 1\n"; } -@D = grep(/^[^\.].*\.t$/, readdir(OP)); +@D = grep(/^[^\.].*\.t$/i, readdir(OP)); closedir(OP); if (@D > 20 && @D < 100) { print "ok 2\n"; } else { print "not ok 2\n"; } @R = sort @D; @G = <op/*.t>; +if ($G[0] =~ m#.*\](\w+\.t)#i) { + # grep is to convert filespecs returned from glob under VMS to format + # identical to that returned by readdir + @G = grep(s#.*\](\w+\.t).*#op/$1#i,<op/*.t>); +} while (@R && @G && "op/".$R[0] eq $G[0]) { shift(@R); shift(@G); diff --git a/t/op/ref.t b/t/op/ref.t index 60bb75ce33..73a54ff3c8 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -1,6 +1,6 @@ #!./perl -print "1..40\n"; +print "1..41\n"; # Test glob operations. @@ -73,7 +73,7 @@ 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"; +print $ref->[2]->[0] == 3 ? "ok 19\n" : "not ok 19\n"; # Test references to hashes of references. @@ -151,8 +151,8 @@ DESTROY { return unless $string; print $string; - # Test that the object has already been "cursed". - print ref shift eq HASH ? "ok 35\n" : "not ok 35\n"; + # Test that the object has not already been "cursed". + print ref shift ne HASH ? "ok 35\n" : "not ok 35\n"; } # Now test inheritance of methods. @@ -180,12 +180,21 @@ sub BASEOBJ'doit { $ref->{shift}; } +package UNIVERSAL; +@ISA = 'LASTCHANCE'; + +package LASTCHANCE; +sub foo { print $_[1] } + +package WHATEVER; +foo WHATEVER "ok 38\n"; + package FINALE; { - $ref3 = bless ["ok 40\n"]; # package destruction - my $ref2 = bless ["ok 39\n"]; # lexical destruction - local $ref1 = bless ["ok 38\n"]; # dynamic destruction + $ref3 = bless ["ok 41\n"]; # package destruction + my $ref2 = bless ["ok 40\n"]; # lexical destruction + local $ref1 = bless ["ok 39\n"]; # dynamic destruction 1; # flush any temp values on stack } diff --git a/t/op/sort.t b/t/op/sort.t index 56a0fd3e92..dc01e5f11d 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -12,7 +12,7 @@ sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0; } $x = join('', sort @harry); print ($x eq 'AbelCaincatdogx' ? "ok 1\n" : "not ok 1\n"); -$x = join('', sort backwards @harry); +$x = join('', sort( backwards @harry)); print ($x eq 'xdogcatCainAbel' ? "ok 2\n" : "not ok 2\n"); $x = join('', sort @george, 'to', @harry); diff --git a/t/op/split.t b/t/op/split.t index d87998e098..2354530817 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -48,6 +48,9 @@ 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`; +if ($foo =~ /DCL-W-NOCOMD/) { + $foo = `\$ mcr sys\$disk:[]perl. "-D1024" -e "(\$a,\$b) = split;"`; +} 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? diff --git a/t/op/substr.t b/t/op/substr.t index 25336365b9..08e1c39969 100755 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -10,7 +10,7 @@ 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,0,-6) eq 'abc' ? "ok 5\n" : "not ok 5\n"); print (substr($a,-3,1) eq 'x' ? "ok 6\n" : "not ok 6\n"); $[ = 1; @@ -19,7 +19,7 @@ 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,1,-6) eq 'abc' ? "ok 11\n" : "not ok 11\n"); print (substr($a,-3,1) eq 'x' ? "ok 12\n" : "not ok 12\n"); $[ = 0; diff --git a/t/op/time.t b/t/op/time.t index 6d23832dfa..186a81cf8a 100755 --- a/t/op/time.t +++ b/t/op/time.t @@ -2,7 +2,8 @@ # $RCSfile: time.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:32 $ -print "1..5\n"; +if ($does_gmtime = gmtime(time)) { print "1..5\n" } +else { print "1..3\n" } ($beguser,$begsys) = times; @@ -14,7 +15,8 @@ if ($now > $beg && $now - $beg < 10){print "ok 1\n";} else {print "not ok 1\n";} for ($i = 0; $i < 100000; $i++) { ($nowuser, $nowsys) = times; - $i = 200000 if $nowuser > $beguser && $nowsys > $begsys; + $i = 200000 if $nowuser > $beguser && ( $nowsys > $begsys || + (!$nowsys && !$begsys)); last if time - $beg > 20; } @@ -29,6 +31,8 @@ if ($sec != $xsec && $mday && $year) else {print "not ok 3\n";} +exit 0 unless $does_gmtime; + ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($beg); ($xsec,$foo) = localtime($now); diff --git a/t/op/write.t b/t/op/write.t index eb00d81b59..bfb4785155 100755 --- a/t/op/write.t +++ b/t/op/write.t @@ -17,10 +17,12 @@ $foo ^<<<<<<... $foo now @<<the@>>>> for all@|||||men to come @<<<< -'i' . 's', "time\n", $good, 'to' +{ + 'i' . 's', "time\n", $good, 'to' +} . -open(OUT, '>Op.write.tmp') || die "Can't create Op.write.tmp"; +open(OUT, '>Op_write.tmp') || die "Can't create Op_write.tmp"; $fox = 'foxiness'; $good = 'good'; @@ -40,8 +42,8 @@ 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'; } +if (`cat Op_write.tmp` eq $right) + { print "ok 1\n"; unlink 'Op_write.tmp'; } else { print "not ok 1\n"; } @@ -57,7 +59,7 @@ now @<<the@>>>> for all@|||||men to come @<<<< 'i' . 's', "time\n", $good, 'to' . -open OUT2, '>Op.write.tmp' or die "Can't create Op.write.tmp"; +open OUT2, '>Op_write.tmp' or die "Can't create Op_write.tmp"; $fox = 'foxiness'; $good = 'good'; @@ -80,8 +82,8 @@ 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'; } +if (`cat Op_write.tmp` eq $right) + { print "ok 2\n"; unlink 'Op_write.tmp'; } else { print "not ok 2\n"; } @@ -92,6 +94,7 @@ $fox jumped @* $multiline +and ^<<<<<<<<< ~~ $foo now @<<the@>>>> for all@|||||men to come @<<<< @@ -99,7 +102,7 @@ now @<<the@>>>> for all@|||||men to come @<<<< . EOFORMAT -open(OUT2, '>Op.write.tmp') || die "Can't create Op.write.tmp"; +open(OUT2, '>Op_write.tmp') || die "Can't create Op_write.tmp"; $fox = 'foxiness'; $good = 'good'; @@ -114,6 +117,7 @@ jumped forescore and seven years +and when in the course of human @@ -122,8 +126,8 @@ becomes necessary now is the time for all good men to come to\n"; -if (`cat Op.write.tmp` eq $right) - { print "ok 3\n"; unlink 'Op.write.tmp'; } +if (`cat Op_write.tmp` eq $right) + { print "ok 3\n"; unlink 'Op_write.tmp'; } else { print "not ok 3\n"; } diff --git a/t/perl b/t/perl deleted file mode 120000 index f2271dea4a..0000000000 --- a/t/perl +++ /dev/null @@ -1 +0,0 @@ -../perl
\ No newline at end of file diff --git a/t/perl5a1.tar b/t/perl5a1.tar Binary files differdeleted file mode 100644 index 0c0b43ce1b..0000000000 --- a/t/perl5a1.tar +++ /dev/null diff --git a/t/re_tests b/t/re_tests new file mode 100644 index 0000000000..b1a5ef28cf --- /dev/null +++ b/t/re_tests @@ -0,0 +1,274 @@ +abc abc y $& abc +abc xbc n - - +abc axc n - - +abc abx n - - +abc xabcy y $& abc +abc ababc y $& abc +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 +^abc$ aabc n - - +abc$ aabc y $& abc +^ abc y $& +$ abc y $& +a.c abc y $& abc +a.c axc y $& axc +a.*c axyzc y $& axyzc +a.*c axyzd n - - +a[bc]d abc n - - +a[bc]d abd y $& abd +a[b-d]e abd n - - +a[b-d]e ace y $& ace +a[b-d] aac y $& ac +a[-b] a- y $& a- +a[b-] a- y $& a- +a[b-a] - c - - +a[]b - c - - +a[ - c - - +a] a] y $& a] +a[]]b a]b y $& a]b +a[^bc]d aed y $& aed +a[^bc]d abd n - - +a[^-b]c adc y $& adc +a[^-b]c a-c n - - +a[^]b]c a]c n - - +a[^]b]c adc y $& adc +ab|cd abc y $& ab +ab|cd abcd y $& ab +()ef def y $&-$1 ef- +()* - c - - +*a - c - - +^* - c - - +$* - c - - +(*)b - c - - +$b b n - - +a\ - c - - +a\(b a(b y $&-$1 a(b- +a\(*b ab y $& ab +a\(*b a((b y $& a((b +a\\b a\b y $& a\b +abc) - c - - +(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 abcabc y $& abc +(a*)* - c - - +(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 - - +[^ab]* cde y $& cde +abc n - - +a* y $& +([abc])*d abbbcd y $&-$1 abbbcd-c +([abc])*bcd abcd y $&-$1 abcd-a +a|b|c|d|e e y $& e +(a|b|c|d|e)f ef y $&-$1 ef-e +((a*|b))* - c - - +abcd*efg abcdefg y $& abcdefg +ab* xabyabbbz y $& ab +ab* xayabbbz y $& a +(ab|cd)e abcde y $&-$1 cde-cd +[abhgefdc]ij hij y $& hij +^(ab|cd)e abcde n x$1y xy +(abc|)ef abcdef y $&-$1 ef- +(a|b)c*d abcd y $&-$1 bcd-b +(ab|ab*)bc abc y $&-$1 abc-a +a([bc]*)c* abc y $&-$1 abc-bc +a([bc]*)(c*d) abcd y $&-$1-$2 abcd-bc-d +a([bc]+)(c*d) abcd y $&-$1-$2 abcd-bc-d +a([bc]*)(c+d) abcd y $&-$1-$2 abcd-b-cd +a[bcd]*dcdcde adcdcde y $& adcdcde +a[bcd]+dcdcde adcdcde n - - +(ab|a)b*c abc y $&-$1 abc-ab +((a)(b)c)(d) abcd y $1-$2-$3-$4 abc-a-b-d +[a-zA-Z_][a-zA-Z0-9_]* alpha y $& alpha +^a(bc+|b[eh])g|.h$ abh y $&-$1 bh- +(bc+d$|ef*g.|h?i(j|k)) effgz y $&-$1-$2 effgz-effgz- +(bc+d$|ef*g.|h?i(j|k)) ij y $&-$1-$2 ij-ij-j +(bc+d$|ef*g.|h?i(j|k)) effg n - - +(bc+d$|ef*g.|h?i(j|k)) bcdd n - - +(bc+d$|ef*g.|h?i(j|k)) reffgz y $&-$1-$2 effgz-effgz- +((((((((((a)))))))))) a y $10 a +((((((((((a))))))))))\10 aa y $& aa +((((((((((a))))))))))\41 aa n - - +((((((((((a))))))))))\41 a! y $& a! +(((((((((a))))))))) a y $& a +multiple words of text uh-uh n - - +multiple words multiple words, yeah y $& multiple words +(.*)c(.*) abcde y $&-$1-$2 abcde-ab-de +\((.*), (.*)\) (a, b) y ($2, $1) (b, a) +[k] ab n - - +abcd abcd y $&-\$&-\\$& abcd-$&-\abcd +a(bc)d abcd y $1-\$1-\\$1 bc-$1-\bc +a[-]?c ac y $& ac +(abc)\1 abcabc y $1 abc +([a-c]*)\1 abcabc y $1 abc +'abc'i ABC y $& ABC +'abc'i XBC n - - +'abc'i AXC n - - +'abc'i ABX n - - +'abc'i XABCY y $& ABC +'abc'i ABABC y $& ABC +'ab*c'i ABC y $& ABC +'ab*bc'i ABC y $& ABC +'ab*bc'i ABBC y $& ABBC +'ab*bc'i ABBBBC y $& ABBBBC +'ab{0,}bc'i ABBBBC y $& ABBBBC +'ab+bc'i ABBC y $& ABBC +'ab+bc'i ABC n - - +'ab+bc'i ABQ n - - +'ab{1,}bc'i ABQ n - - +'ab+bc'i ABBBBC y $& ABBBBC +'ab{1,}bc'i ABBBBC y $& ABBBBC +'ab{1,3}bc'i ABBBBC y $& ABBBBC +'ab{3,4}bc'i ABBBBC y $& ABBBBC +'ab{4,5}bc'i ABBBBC n - - +'ab?bc'i ABBC y $& ABBC +'ab?bc'i ABC y $& ABC +'ab{0,1}bc'i ABC y $& ABC +'ab?bc'i ABBBBC n - - +'ab?c'i ABC y $& ABC +'ab{0,1}c'i ABC y $& ABC +'^abc$'i ABC y $& ABC +'^abc$'i ABCC n - - +'^abc'i ABCC y $& ABC +'^abc$'i AABC n - - +'abc$'i AABC y $& ABC +'^'i ABC y $& +'$'i ABC y $& +'a.c'i ABC y $& ABC +'a.c'i AXC y $& AXC +'a.*c'i AXYZC y $& AXYZC +'a.*c'i AXYZD n - - +'a[bc]d'i ABC n - - +'a[bc]d'i ABD y $& ABD +'a[b-d]e'i ABD n - - +'a[b-d]e'i ACE y $& ACE +'a[b-d]'i AAC y $& AC +'a[-b]'i A- y $& A- +'a[b-]'i A- y $& A- +'a[b-a]'i - c - - +'a[]b'i - c - - +'a['i - c - - +'a]'i A] y $& A] +'a[]]b'i A]B y $& A]B +'a[^bc]d'i AED y $& AED +'a[^bc]d'i ABD n - - +'a[^-b]c'i ADC y $& ADC +'a[^-b]c'i A-C n - - +'a[^]b]c'i A]C n - - +'a[^]b]c'i ADC y $& ADC +'ab|cd'i ABC y $& AB +'ab|cd'i ABCD y $& AB +'()ef'i DEF y $&-$1 EF- +'()*'i - c - - +'*a'i - c - - +'^*'i - c - - +'$*'i - c - - +'(*)b'i - c - - +'$b'i B n - - +'a\'i - c - - +'a\(b'i A(B y $&-$1 A(B- +'a\(*b'i AB y $& AB +'a\(*b'i A((B y $& A((B +'a\\b'i A\B y $& A\B +'abc)'i - c - - +'(abc'i - c - - +'((a))'i ABC y $&-$1-$2 A-A-A +'(a)b(c)'i ABC y $&-$1-$2 ABC-A-C +'a+b+c'i AABBABC y $& ABC +'a{1,}b{1,}c'i AABBABC y $& ABC +'a**'i - c - - +'a.+?c'i ABCABC y $& ABC +'(a*)*'i - c - - +'(a*)+'i - c - - +'(a|)*'i - c - - +'(a*|b)*'i - c - - +'(a+|b)*'i AB y $&-$1 AB-B +'(a+|b){0,}'i AB y $&-$1 AB-B +'(a+|b)+'i AB y $&-$1 AB-B +'(a+|b){1,}'i AB y $&-$1 AB-B +'(a+|b)?'i AB y $&-$1 A-A +'(a+|b){0,1}'i AB y $&-$1 A-A +'(^)*'i - c - - +'(ab|)*'i - c - - +')('i - c - - +'[^ab]*'i CDE y $& CDE +'abc'i n - - +'a*'i y $& +'([abc])*d'i ABBBCD y $&-$1 ABBBCD-C +'([abc])*bcd'i ABCD y $&-$1 ABCD-A +'a|b|c|d|e'i E y $& E +'(a|b|c|d|e)f'i EF y $&-$1 EF-E +'((a*|b))*'i - c - - +'abcd*efg'i ABCDEFG y $& ABCDEFG +'ab*'i XABYABBBZ y $& AB +'ab*'i XAYABBBZ y $& A +'(ab|cd)e'i ABCDE y $&-$1 CDE-CD +'[abhgefdc]ij'i HIJ y $& HIJ +'^(ab|cd)e'i ABCDE n x$1y XY +'(abc|)ef'i ABCDEF y $&-$1 EF- +'(a|b)c*d'i ABCD y $&-$1 BCD-B +'(ab|ab*)bc'i ABC y $&-$1 ABC-A +'a([bc]*)c*'i ABC y $&-$1 ABC-BC +'a([bc]*)(c*d)'i ABCD y $&-$1-$2 ABCD-BC-D +'a([bc]+)(c*d)'i ABCD y $&-$1-$2 ABCD-BC-D +'a([bc]*)(c+d)'i ABCD y $&-$1-$2 ABCD-B-CD +'a[bcd]*dcdcde'i ADCDCDE y $& ADCDCDE +'a[bcd]+dcdcde'i ADCDCDE n - - +'(ab|a)b*c'i ABC y $&-$1 ABC-AB +'((a)(b)c)(d)'i ABCD y $1-$2-$3-$4 ABC-A-B-D +'[a-zA-Z_][a-zA-Z0-9_]*'i ALPHA y $& ALPHA +'^a(bc+|b[eh])g|.h$'i ABH y $&-$1 BH- +'(bc+d$|ef*g.|h?i(j|k))'i EFFGZ y $&-$1-$2 EFFGZ-EFFGZ- +'(bc+d$|ef*g.|h?i(j|k))'i IJ y $&-$1-$2 IJ-IJ-J +'(bc+d$|ef*g.|h?i(j|k))'i EFFG n - - +'(bc+d$|ef*g.|h?i(j|k))'i BCDD n - - +'(bc+d$|ef*g.|h?i(j|k))'i REFFGZ y $&-$1-$2 EFFGZ-EFFGZ- +'((((((((((a))))))))))'i A y $10 A +'((((((((((a))))))))))\10'i AA y $& AA +'((((((((((a))))))))))\41'i AA n - - +'((((((((((a))))))))))\41'i A! y $& A! +'(((((((((a)))))))))'i A y $& A +'multiple words of text'i UH-UH n - - +'multiple words'i MULTIPLE WORDS, YEAH y $& MULTIPLE WORDS +'(.*)c(.*)'i ABCDE y $&-$1-$2 ABCDE-AB-DE +'\((.*), (.*)\)'i (A, B) y ($2, $1) (B, A) +'[k]'i AB n - - +'abcd'i ABCD y $&-\$&-\\$& ABCD-$&-\ABCD +'a(bc)d'i ABCD y $1-\$1-\\$1 BC-$1-\BC +'a[-]?c'i AC y $& AC +'(abc)\1'i ABCABC y $1 ABC +'([a-c]*)\1'i ABCABC y $1 ABC diff --git a/t/tmp/bullet b/t/tmp/bullet deleted file mode 100644 index 048f271a1f..0000000000 --- a/t/tmp/bullet +++ /dev/null @@ -1,13 +0,0 @@ - - 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?) @@ -1,3 +0,0 @@ -#!./perl -Dx - -$foo !~ /foo/; |