From bbad36071d5a6d4be3588f0f10c88247439076d8 Mon Sep 17 00:00:00 2001 From: Ilya Zakharevich Date: Thu, 16 Jan 1997 23:48:18 -0500 Subject: [PATCH] Test patches for OS/2 a) Teaches tests in os2/OS2/*/* new format of $Config{extensions}; os2/OS2/ExtAttr/t/os2_ea.t os2/OS2/PrfDB/t/os2_prfdb.t os2/OS2/REXX/t/rx_cmprt.t os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_sql.test os2/OS2/REXX/t/rx_tiesql.test os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_varset.t os2/OS2/REXX/t/rx_vrexx.t b) Closes all the files before unlinking - for DOSISH systems; t/cmd/while.t t/comp/multiline.t t/io/argv.t t/lib/anydbm.t t/lib/gdbm.t t/lib/ndbm.t t/lib/odbm.t t/lib/sdbm.t c) t/README mentions running `harness' to get better granularity; t/README d) New test op/lex_assign.t added - will check optimization of lexicals when applied - 153 cases (some just ignored since hard to implement). MANIFEST t/op/lex_assign.t e) When a script is started via shell, $Config{exe_ext} may be appended. t/op/magic.t f) path/echo may print a warning if run without args t/comp/colon.t g) Error explanations more verbose t/op/cmp.t t/op/magic.t p5p-msgid: <199701170448.XAA28948@monk.mps.ohio-state.edu> --- MANIFEST | 1 + os2/OS2/ExtAttr/t/os2_ea.t | 4 +- os2/OS2/PrfDB/t/os2_prfdb.t | 5 +- os2/OS2/REXX/t/rx_cmprt.t | 2 +- os2/OS2/REXX/t/rx_dllld.t | 2 +- os2/OS2/REXX/t/rx_objcall.t | 2 +- os2/OS2/REXX/t/rx_sql.test | 2 +- os2/OS2/REXX/t/rx_tiesql.test | 2 +- os2/OS2/REXX/t/rx_tievar.t | 2 +- os2/OS2/REXX/t/rx_tieydb.t | 2 +- os2/OS2/REXX/t/rx_varset.t | 2 +- os2/OS2/REXX/t/rx_vrexx.t | 2 +- t/README | 5 + t/cmd/while.t | 1 + t/comp/colon.t | 2 +- t/comp/multiline.t | 2 + t/io/argv.t | 1 + t/lib/anydbm.t | 1 + t/lib/gdbm.t | 1 + t/lib/ndbm.t | 1 + t/lib/odbm.t | 1 + t/lib/sdbm.t | 1 + t/op/cmp.t | 4 +- t/op/lex_assign.t | 214 ++++++++++++++++++++++++++++++++++++++++++ t/op/magic.t | 8 +- 25 files changed, 252 insertions(+), 18 deletions(-) create mode 100644 t/op/lex_assign.t diff --git a/MANIFEST b/MANIFEST index 6b202da..6a45129 100644 --- a/MANIFEST +++ b/MANIFEST @@ -657,6 +657,7 @@ t/op/inc.t See if inc/dec of integers near 32 bit limit work t/op/index.t See if index works t/op/int.t See if int works t/op/join.t See if join works +t/op/lex_assign.t See if assignment to lexicals work t/op/list.t See if array lists work t/op/local.t See if local works t/op/magic.t See if magic variables work diff --git a/os2/OS2/ExtAttr/t/os2_ea.t b/os2/OS2/ExtAttr/t/os2_ea.t index dc6f996..a1da398 100644 --- a/os2/OS2/ExtAttr/t/os2_ea.t +++ b/os2/OS2/ExtAttr/t/os2_ea.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } @@ -76,4 +76,4 @@ print "ok 12\n"; } print "ok 21\n"; - +unlink 't.out'; diff --git a/os2/OS2/PrfDB/t/os2_prfdb.t b/os2/OS2/PrfDB/t/os2_prfdb.t index 4c0883d..a8c9752 100644 --- a/os2/OS2/PrfDB/t/os2_prfdb.t +++ b/os2/OS2/PrfDB/t/os2_prfdb.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::PrfDB\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)PrfDB\b/) { print "1..0\n"; exit 0; } @@ -183,3 +183,6 @@ tie %hash2, 'OS2::PrfDB', $inifile; print "ok 47\n"; print ($hash2{nnn}->{mmm} eq "67" ? "ok 48\n" : "not ok 48\n# `$val'\n"); + +untie %hash2; +unlink $inifile; diff --git a/os2/OS2/REXX/t/rx_cmprt.t b/os2/OS2/REXX/t/rx_cmprt.t index a73e43e..f2113e3 100644 --- a/os2/OS2/REXX/t/rx_cmprt.t +++ b/os2/OS2/REXX/t/rx_cmprt.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_dllld.t b/os2/OS2/REXX/t/rx_dllld.t index 317743f..9d81bf3 100644 --- a/os2/OS2/REXX/t/rx_dllld.t +++ b/os2/OS2/REXX/t/rx_dllld.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_objcall.t b/os2/OS2/REXX/t/rx_objcall.t index b4f04c3..cb3c52a 100644 --- a/os2/OS2/REXX/t/rx_objcall.t +++ b/os2/OS2/REXX/t/rx_objcall.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_sql.test b/os2/OS2/REXX/t/rx_sql.test index 4f98425..602c76d 100644 --- a/os2/OS2/REXX/t/rx_sql.test +++ b/os2/OS2/REXX/t/rx_sql.test @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bOS2::REXX\b/) { + if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_tiesql.test b/os2/OS2/REXX/t/rx_tiesql.test index 2947516..c85a1e9 100644 --- a/os2/OS2/REXX/t/rx_tiesql.test +++ b/os2/OS2/REXX/t/rx_tiesql.test @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib'; require Config; import Config; - if ($Config{'extensions'} !~ /\bOS2::REXX\b/) { + if ($Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_tievar.t b/os2/OS2/REXX/t/rx_tievar.t index 6132e23..77f90c2 100644 --- a/os2/OS2/REXX/t/rx_tievar.t +++ b/os2/OS2/REXX/t/rx_tievar.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_tieydb.t b/os2/OS2/REXX/t/rx_tieydb.t index 8251051..30a2daf 100644 --- a/os2/OS2/REXX/t/rx_tieydb.t +++ b/os2/OS2/REXX/t/rx_tieydb.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_varset.t b/os2/OS2/REXX/t/rx_varset.t index 9d4f3b2..166cf53 100644 --- a/os2/OS2/REXX/t/rx_varset.t +++ b/os2/OS2/REXX/t/rx_varset.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/os2/OS2/REXX/t/rx_vrexx.t b/os2/OS2/REXX/t/rx_vrexx.t index a40749f..04ca663 100644 --- a/os2/OS2/REXX/t/rx_vrexx.t +++ b/os2/OS2/REXX/t/rx_vrexx.t @@ -2,7 +2,7 @@ BEGIN { chdir 't' if -d 't/lib'; @INC = '../lib' if -d 'lib'; require Config; import Config; - if (-d 'lib' and $Config{'extensions'} !~ /\bOS2::REXX\b/) { + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { print "1..0\n"; exit 0; } diff --git a/t/README b/t/README index 00bf561..6fb569b 100644 --- a/t/README +++ b/t/README @@ -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 '#'. +If you know that "basic" features work and expect that some test are going +to fail, it is adviced to run tests via Test::Harness thusly: + ./perl -I../lib harness +This would pinpoint failed tests with better granularity. + If you come up with new tests, send them to larry@wall.org. diff --git a/t/cmd/while.t b/t/cmd/while.t index 4c8c10e..c6e464d 100755 --- a/t/cmd/while.t +++ b/t/cmd/while.t @@ -90,6 +90,7 @@ loop: while () { 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";} +close(fh) || die "Can't close Cmd_while.tmp."; unlink 'Cmd_while.tmp' || `/bin/rm Cmd_While.tmp`; #$x = 0; diff --git a/t/comp/colon.t b/t/comp/colon.t index 2a37367..d2c64fe 100755 --- a/t/comp/colon.t +++ b/t/comp/colon.t @@ -110,7 +110,7 @@ ok 18, (not eval "qw:1" and not eval "qw:echo:ohce: >= 0"); ok 19, (not eval "qx:1" and - eval "qx:echo: eq qx|echo|" and + eval "qx:echo 1: eq qx|echo 1|" and # echo without args may warn not eval "qx:echo:ohce: >= 0"); ok 20, (not eval "s:1" and diff --git a/t/comp/multiline.t b/t/comp/multiline.t index 634b06a..0e022e9 100755 --- a/t/comp/multiline.t +++ b/t/comp/multiline.t @@ -35,6 +35,8 @@ 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";} + +close(try) || (die "Can't close temp file."); 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/io/argv.t b/t/io/argv.t index 40ed23b..bf592f9 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -34,3 +34,4 @@ else {print "not ok 5\n";} `/bin/rm -f Io.argv.tmp` if -x '/bin/rm'; +unlink 'Io.argv.tmp'; diff --git a/t/lib/anydbm.t b/t/lib/anydbm.t index 80b39df..52ab22b 100755 --- a/t/lib/anydbm.t +++ b/t/lib/anydbm.t @@ -111,4 +111,5 @@ 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"); +untie %h; unlink 'Op.dbmx.dir', $Dfile; diff --git a/t/lib/gdbm.t b/t/lib/gdbm.t index c888c00..62bb936 100755 --- a/t/lib/gdbm.t +++ b/t/lib/gdbm.t @@ -114,4 +114,5 @@ 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"); +untie %h; unlink 'Op.dbmx.dir', $Dfile; diff --git a/t/lib/ndbm.t b/t/lib/ndbm.t index 15aa93a..8e2ba81 100755 --- a/t/lib/ndbm.t +++ b/t/lib/ndbm.t @@ -117,4 +117,5 @@ 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"); +untie %h; unlink 'Op.dbmx.dir', $Dfile; diff --git a/t/lib/odbm.t b/t/lib/odbm.t index 0b1fa50..0c530d2 100755 --- a/t/lib/odbm.t +++ b/t/lib/odbm.t @@ -117,4 +117,5 @@ 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"); +untie %h; unlink 'Op.dbmx.dir', $Dfile; diff --git a/t/lib/sdbm.t b/t/lib/sdbm.t index 1bb3fde..65419f9 100755 --- a/t/lib/sdbm.t +++ b/t/lib/sdbm.t @@ -116,4 +116,5 @@ 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"); +untie %h; unlink 'Op.dbmx.dir', $Dfile; diff --git a/t/op/cmp.t b/t/op/cmp.t index aba7c2e..4a7e68d 100755 --- a/t/op/cmp.t +++ b/t/op/cmp.t @@ -18,7 +18,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - print "not ok $ok ($FOO[$i] <=> $FOO[$j])\n"; + print "not ok $ok ($FOO[$i] <=> $FOO[$j]) gives: '$cmp'\n"; } $ok++; $cmp = $FOO[$i] cmp $FOO[$j]; @@ -29,7 +29,7 @@ for my $i (0..$#FOO) { print "ok $ok\n"; } else { - print "not ok $ok ($FOO[$i] cmp $FOO[$j])\n"; + print "not ok $ok ($FOO[$i] cmp $FOO[$j]) gives '$cmp'\n"; } } } diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t new file mode 100644 index 0000000..d35f39c --- /dev/null +++ b/t/op/lex_assign.t @@ -0,0 +1,214 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; +} + +umask 0; +$xref = \ ""; +@a = (1..5); +%h = (1..6); +$aref = \@a; +$href = \%h; +open OP, qq{$^X -le 'print "aaa Ok ok" while \$i++ < 100'|}; +$chopit = 'aaaaaa'; +@chopar = (113 .. 119); +$posstr = '123456'; +$cstr = 'aBcD.eF'; +pos $posstr = 3; +$nn = $n = 2; +sub subb {"in s"} + +@INPUT = ; +print "1..", (scalar @INPUT), "\n"; +$ord = 0; + +sub wrn {"@_"} + +for (@INPUT) { + $ord++; + ($op, undef, $comment) = /^([^\#]+)(\#\s+(.*))?/; + $comment = $op unless defined $comment; + $op = "$op==$op" unless $op =~ /==/; + ($op, $expectop) = $op =~ /(.*)==(.*)/; + + $skip = ($op =~ /^'\?\?\?'/) ? "skip" : "not"; + $integer = ($comment =~ /^i_/) ? "use integer" : '' ; + (print "#skipping $comment:\nok $ord\n"), next if $skip eq 'skip'; + + eval < # glob + # readline +'faked' # rcatline +(@z = (1 .. 3)) # aassign +chop $chopit # chop +(chop (@x=@chopar)) # schop +chomp $chopit # chomp +(chop (@x=@chopar)) # schomp +pos $posstr # pos +pos $chopit # pos returns undef +$nn++==2 # postinc +$nn++==3 # i_postinc +$nn--==4 # postdec +$nn--==3 # i_postdec +$n ** $n # pow +$n * $n # multiply +$n * $n # i_multiply +$n / $n # divide +$n / $n # i_divide +$n % $n # modulo +$n % $n # i_modulo +$n x $n # repeat +$n + $n # add +$n + $n # i_add +$n - $n # subtract +$n - $n # i_subtract +$n . $n # concat +$n . $a=='2fake' # concat with self +"3$a"=='3fake' # concat with self in stringify +"$n" # stringify +$n << $n # left_shift +$n >> $n # right_shift +$n <=> $n # ncmp +$n <=> $n # i_ncmp +$n cmp $n # scmp +$n & $n # bit_and +$n ^ $n # bit_xor +$n | $n # bit_or +-$n # negate +-$n # i_negate +~$n # complement +atan2 $n,$n # atan2 +sin $n # sin +cos $n # cos +'???' # rand +exp $n # exp +log $n # log +sqrt $n # sqrt +int $n # int +hex $n # hex +oct $n # oct +abs $n # abs +length $posstr # length +substr $posstr, 2, 2 # substr +vec("abc",2,8) # vec +index $posstr, 2 # index +rindex $posstr, 2 # rindex +sprintf "%i%i", $n, $n # sprintf +ord $n # ord +chr $n # chr +crypt $n, $n # crypt +ucfirst ($cstr . "a") # ucfirst padtmp +ucfirst $cstr # ucfirst +lcfirst $cstr # lcfirst +uc $cstr # uc +lc $cstr # lc +quotemeta $cstr # quotemeta +@$aref # rv2av +@$undefed # rv2av undef +each %h==1 # each +values %h # values +keys %h # keys +%$href # rv2hv +pack "C2", $n,$n # pack +split /a/, "abad" # split +join "a"; @a # join +push @a,3==6 # push +unshift @aaa # unshift +reverse @a # reverse +reverse $cstr # reverse - scal +grep $_, 1,0,2,0,3 # grepwhile +map "x$_", 1,0,2,0,3 # mapwhile +subb() # entersub +caller # caller +warn "ignore this\n" # warn +'faked' # die +open BLAH, "