diff options
Diffstat (limited to 't/op')
| -rwxr-xr-x | t/op/glob.t | 5 | ||||
| -rwxr-xr-x | t/op/method.t | 13 | ||||
| -rwxr-xr-x | t/op/misc.t | 7 | ||||
| -rwxr-xr-x | t/op/ref.t | 16 | ||||
| -rwxr-xr-x | t/op/runlevel.t | 2 | ||||
| -rwxr-xr-x | t/op/split.t | 16 | ||||
| -rwxr-xr-x | t/op/sprintf.t | 29 | ||||
| -rwxr-xr-x | t/op/subst.t | 7 | ||||
| -rwxr-xr-x | t/op/taint.t | 59 |
9 files changed, 139 insertions, 15 deletions
diff --git a/t/op/glob.t b/t/op/glob.t index dd95e980d5..253e4a312f 100755 --- a/t/op/glob.t +++ b/t/op/glob.t @@ -6,11 +6,12 @@ print "1..6\n"; @oops = @ops = <op/*>; -map { $files{$_}++ } <op/*>; if ($^O eq 'MSWin32') { - map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op"`; + map { $files{lc($_)}++ } <op/*>; + map { delete $files{"op/$_"} } split /[\s\n]/, `cmd /c "dir /b /l op & dir /b /l /ah op 2>nul"`, } else { + map { $files{$_}++ } <op/*>; map { delete $files{$_} } split /[\s\n]/, `echo op/*`; } if (keys %files) { diff --git a/t/op/method.t b/t/op/method.t index 21d7c8f397..d955705d1a 100755 --- a/t/op/method.t +++ b/t/op/method.t @@ -4,7 +4,7 @@ # test method calls and autoloading. # -print "1..20\n"; +print "1..24\n"; @A::ISA = 'B'; @B::ISA = 'C'; @@ -25,6 +25,14 @@ test( A->d, "C::d"); # Update hash table; test (A->d, "D::d"); # Update hash table; { + local @A::ISA = qw(C); # Update hash table with split() assignment + test (A->d, "C::d"); + $#A::ISA = -1; + test (eval { A->d } || "fail", "fail"); +} +test (A->d, "D::d"); + +{ local *B::d; eval 'sub B::d {"B::d1"}'; # Import now. test (A->d, "B::d1"); # Update hash table; @@ -109,3 +117,6 @@ test(Y->f(), "B: In Y::f, 3"); # Which sticks test(A->eee(), "new B: In A::eee, 4"); # We get a correct $autoload test(A->eee(), "new B: In A::eee, 4"); # Which sticks + +# this test added due to bug discovery +test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined"); diff --git a/t/op/misc.t b/t/op/misc.t index 660049b3f1..6156ac2f21 100755 --- a/t/op/misc.t +++ b/t/op/misc.t @@ -1,5 +1,8 @@ #!./perl +# NOTE: Please don't add tests to this file unless they *need* to be run in +# separate executable and can't simply use eval. + chdir 't' if -d 't'; @INC = "../lib"; $ENV{PERL5LIB} = "../lib"; @@ -18,8 +21,8 @@ $CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); for (@prgs){ my $switch; - if (s/^\s*-\w+//){ - $switch = $&; + if (s/^\s*(-\w.*)//){ + $switch = $1; } my($prog,$expected) = split(/\nEXPECT\n/, $_); if ($^O eq 'MSWin32') { diff --git a/t/op/ref.t b/t/op/ref.t index e83a04fbee..9fcc8ac15c 100755 --- a/t/op/ref.t +++ b/t/op/ref.t @@ -1,6 +1,6 @@ #!./perl -print "1..50\n"; +print "1..51\n"; # Test glob operations. @@ -223,12 +223,20 @@ sub moe::DESTROY { print "# moe\nok 47\n"; } print "# left block\n"; +# another glob test + +$foo = "not ok 48"; +{ local(*bar) = "foo" } +$bar = "ok 48"; +local(*bar) = *bar; +print "$bar\n"; + package FINALE; { - $ref3 = bless ["ok 50\n"]; # package destruction - my $ref2 = bless ["ok 49\n"]; # lexical destruction - local $ref1 = bless ["ok 48\n"]; # dynamic destruction + $ref3 = bless ["ok 51\n"]; # package destruction + my $ref2 = bless ["ok 50\n"]; # lexical destruction + local $ref1 = bless ["ok 49\n"]; # dynamic destruction 1; # flush any temp values on stack } diff --git a/t/op/runlevel.t b/t/op/runlevel.t index 2be2eec019..6693a829a8 100755 --- a/t/op/runlevel.t +++ b/t/op/runlevel.t @@ -304,7 +304,7 @@ EXPECT 0, 1, 2, 3 ######## sub foo { - goto bar if $a == 0; + goto bar if $a == 0 || $b == 0; $a <=> $b; } @a = (3, 2, 0, 1); diff --git a/t/op/split.t b/t/op/split.t index b449ba96fa..07246522ee 100755 --- a/t/op/split.t +++ b/t/op/split.t @@ -2,7 +2,7 @@ # $RCSfile: split.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:26 $ -print "1..16\n"; +print "1..20\n"; $FS = ':'; @@ -76,3 +76,17 @@ print "$a|$b" eq "2|4" ? "ok 15\n" : "not ok 15\n"; local(undef, $a, undef, $b) = qw(1 2 3 4); print "$a|$b" eq "2|4" ? "ok 16\n" : "not ok 16\n"; } + +# check splitting of null string +$_ = join('|', split(/x/, '',-1), 'Z'); +print $_ eq "Z" ? "ok 17\n" : "#$_\nnot ok 17\n"; + +$_ = join('|', split(/x/, '', 1), 'Z'); +print $_ eq "Z" ? "ok 18\n" : "#$_\nnot ok 18\n"; + +$_ = join('|', split(/(p+)/,'',-1), 'Z'); +print $_ eq "Z" ? "ok 19\n" : "#$_\nnot ok 19\n"; + +$_ = join('|', split(/.?/, '',-1), 'Z'); +print $_ eq "Z" ? "ok 20\n" : "#$_\nnot ok 20\n"; + diff --git a/t/op/sprintf.t b/t/op/sprintf.t index 8e1ef6958f..1450ae375f 100755 --- a/t/op/sprintf.t +++ b/t/op/sprintf.t @@ -2,7 +2,32 @@ # $RCSfile: sprintf.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:27 $ -print "1..1\n"; +print "1..4\n"; +$^W = 1; +$SIG{__WARN__} = sub { + if ($_[0] =~ /^Invalid conversion/) { + $w++; + } else { + warn @_; + } +}; + +$w = 0; $x = sprintf("%3s %-4s%%foo %5d%c%3.1f","hi",123,456,65,3.0999); -if ($x eq ' hi 123 %foo 456A3.1') {print "ok 1\n";} else {print "not ok 1 '$x'\n";} +if ($x eq ' hi 123 %foo 456A3.1' && $w == 0) { + print "ok 1\n"; +} else { + print "not ok 1 '$x'\n"; +} + +for $i (2 .. 4) { + $f = ('%6 .6s', '%6. 6s', '%6.6 s')[$i - 2]; + $w = 0; + $x = sprintf($f, ''); + if ($x eq $f && $w == 1) { + print "ok $i\n"; + } else { + print "not ok $i '$x' '$f' '$w'\n"; + } +} diff --git a/t/op/subst.t b/t/op/subst.t index 3b4734eadb..efea970dfc 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -2,7 +2,7 @@ # $RCSfile: s.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:22 $ -print "1..61\n"; +print "1..62\n"; $x = 'foo'; $_ = "x"; @@ -234,3 +234,8 @@ print exp_vars('foo $(DIR)/yyy bar',0) eq 'foo $(UNDEFINEDNAME)/xxx/yyy bar' $_ = "abcd"; s/../$x = $&, m#.#/eg; print $x eq "cd" ? "ok 61\n" : "not ok 61\n"; + +# check parsing of split subst with comment +eval 's{foo} # this is a comment, not a delimiter + {bar};'; +print @? ? "not ok 62\n" : "ok 62\n"; diff --git a/t/op/taint.t b/t/op/taint.t index e170f284ed..8437c43c45 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -82,7 +82,7 @@ print PROG 'print "@ARGV\n"', "\n"; close PROG; my $echo = "$Invoke_Perl $ECHO"; -print "1..135\n"; +print "1..140\n"; # First, let's make sure that Perl is checking the dangerous # environment variables. Maybe they aren't set yet, so we'll @@ -515,3 +515,60 @@ else { test 134, tainted $corge[1]; test 135, not tainted $corge[2]; } + +# Test for system/library calls returning string data of dubious origin. +{ + # No reliable %Config check for getpw* + if (eval { setpwent(); getpwent(); 1 }) { + setpwent(); + my @getpwent = getpwent(); + die "getpwent: $!\n" unless (@getpwent); + test 136,( not tainted $getpwent[0] + and not tainted $getpwent[1] + and not tainted $getpwent[2] + and not tainted $getpwent[3] + and not tainted $getpwent[4] + and not tainted $getpwent[5] + and tainted $getpwent[6] # gecos + and not tainted $getpwent[7] + and not tainted $getpwent[8]); + endpwent(); + } else { + print "# getpwent() is not available\n"; + print "ok 136\n"; + } + + if ($Config{d_readdir}) { # pretty hard to imagine not + local(*D); + opendir(D, "op") or die "opendir: $!\n"; + my $readdir = readdir(D); + test 137, tainted $readdir; + closedir(OP); + } else { + print "# readdir() is not available\n"; + print "ok 137\n"; + } + + if ($Config{d_readlink} && $Config{d_symlink}) { + my $symlink = "sl$$"; + unlink($symlink); + symlink("/something/naughty", $symlink) or die "symlink: $!\n"; + my $readlink = readlink($symlink); + test 138, tainted $readlink; + unlink($symlink); + } else { + print "# readlink() or symlink() is not available\n"; + print "ok 138\n"; + } +} + +# test bitwise ops (regression bug) +{ + my $why = "y"; + my $j = "x" | $why; + test 139, not tainted $j; + $why = $TAINT."y"; + $j = "x" | $why; + test 140, tainted $j; +} + |