diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-05-07 07:07:58 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-05-07 07:07:58 +0000 |
commit | 105361ce16bc636fe517601463fa5644019149c4 (patch) | |
tree | 0fef968d06962d3698e81cc3bd5cb825e7e09bcf /t | |
parent | 901ecf3430b96ad57e07dea513e1e92aee530988 (diff) | |
parent | be61827f32f7b49ea321451b189a9235d1190874 (diff) | |
download | perl-105361ce16bc636fe517601463fa5644019149c4.tar.gz |
Integrate mainline
p4raw-id: //depot/perlio@16440
Diffstat (limited to 't')
-rwxr-xr-x | t/io/fs.t | 4 | ||||
-rwxr-xr-x | t/op/arith.t | 12 | ||||
-rwxr-xr-x | t/op/exec.t | 8 | ||||
-rwxr-xr-x | t/op/local.t | 16 | ||||
-rwxr-xr-x | t/op/pwent.t | 12 | ||||
-rwxr-xr-x | t/op/tie.t | 9 |
6 files changed, 51 insertions, 10 deletions
@@ -271,7 +271,7 @@ SKIP: { # Check truncating a closed file. eval { truncate "Iofs.tmp", 5; }; - skip("no truncate - $@", 10) if $@; + skip("no truncate - $@", 6) if $@; is(-s "Iofs.tmp", 5, "truncation to five bytes"); @@ -304,7 +304,7 @@ SKIP: { } if ($^O eq 'vos') { - skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 7); + skip ("# TODO - hit VOS bug posix-973 - cannot resize an open file below the current file pos.", 3); } is(-s "Iofs.tmp", 200, "fh resize to 200 working (filename check)"); diff --git a/t/op/arith.t b/t/op/arith.t index 55a5e48084..654ce3b857 100755 --- a/t/op/arith.t +++ b/t/op/arith.t @@ -22,7 +22,7 @@ sub tryeq_sloppy ($$$) { print "ok $_[0]\n"; } else { my $error = abs ($_[1] - $_[2]) / $_[1]; - if ($error < 1e-10) { + if ($error < 1e-9) { print "ok $_[0] # $_[1] is close to $_[2], \$^O eq $^O\n"; } else { print "not ok $_[0] # $_[1] != $_[2]\n"; @@ -242,7 +242,7 @@ tryeq 120, -0x80000000/1, -0x80000000; tryeq 121, -0x80000000/-1, 0x80000000; # The example for sloppy divide, rigged to avoid the peephole optimiser. -tryeq 122, "20." / "5.", 4; +tryeq_sloppy 122, "20." / "5.", 4; tryeq 123, 2.5 / 2, 1.25; tryeq 124, 3.5 / -2, -1.75; @@ -252,9 +252,9 @@ tryeq 126, -5.5 / -2, 2.75; # Bluuurg if your floating point can't accurately cope with powers of 2 # [I suspect this is parsing string->float problems, not actual arith] tryeq_sloppy 127, 18446744073709551616/1, 18446744073709551616; # Bluuurg -tryeq 128, 18446744073709551616/2, 9223372036854775808; -tryeq 129, 18446744073709551616/4294967296, 4294967296; -tryeq 130, 18446744073709551616/9223372036854775808, 2; +tryeq_sloppy 128, 18446744073709551616/2, 9223372036854775808; +tryeq_sloppy 129, 18446744073709551616/4294967296, 4294967296; +tryeq_sloppy 130, 18446744073709551616/9223372036854775808, 2; { # The peephole optimiser is wrong to think that it can substitute intops @@ -263,7 +263,7 @@ tryeq 130, 18446744073709551616/9223372036854775808, 2; my $n = 1127; my $float = ($n % 1000) * 167772160.0; - tryeq 131, $float, 21307064320; + tryeq_sloppy 131, $float, 21307064320; # On a 32 bit machine, if the i_multiply op is used, you will probably get # -167772160. It's actually undefined behaviour, so anything may happen. diff --git a/t/op/exec.t b/t/op/exec.t index 3edbc6ac62..5f110be32e 100755 --- a/t/op/exec.t +++ b/t/op/exec.t @@ -19,7 +19,7 @@ my $Is_Win32 = $^O eq 'MSWin32'; skip_all("Tests mostly usesless on MacOS") if $^O eq 'MacOS'; -plan(tests => 20); +plan(tests => 21); my $Perl = which_perl(); @@ -74,6 +74,12 @@ is( $echo_out, "ok\n", 'piped echo emulation'); is( scalar `$Perl -le "print 'ok'" | $Perl -e "print <STDIN>"`, "ok\n", 'extra newlines on outgoing pipes'); + + { + local($/) = \2; + $out = runperl(prog => 'print q{1234}'); + is($out, "1234", 'ignore $/ when capturing output in scalar context'); + } } diff --git a/t/op/local.t b/t/op/local.t index 9f977b2cd4..6da03912e9 100755 --- a/t/op/local.t +++ b/t/op/local.t @@ -1,6 +1,6 @@ #!./perl -print "1..71\n"; +print "1..75\n"; sub foo { local($a, $b) = @_; @@ -130,6 +130,7 @@ print +(!defined $a[0]) ? "" : "not ", "ok 41\n"; sub TIEHASH { bless {}, $_[0] } sub STORE { print "# STORE [@_]\n"; $_[0]->{$_[1]} = $_[2] } sub FETCH { my $v = $_[0]->{$_[1]}; print "# FETCH [@_=$v]\n"; $v } + sub EXISTS { print "# EXISTS [@_]\n"; exists $_[0]->{$_[1]}; } sub DELETE { print "# DELETE [@_]\n"; delete $_[0]->{$_[1]}; } sub CLEAR { print "# CLEAR [@_]\n"; %{$_[0]} = (); } } @@ -141,6 +142,8 @@ tie %h, 'TH'; { local($h{'a'}) = 'foo'; local($h{'b'}) = $h{'b'}; + local($h{'y'}); + local($h{'z'}) = 33; print +($h{'a'} eq 'foo') ? "" : "not ", "ok 42\n"; print +($h{'b'} == 2) ? "" : "not ", "ok 43\n"; local($h{'c'}); @@ -182,6 +185,8 @@ $ENV{_X_} = 'a'; $ENV{_Y_} = 'b'; $ENV{_Z_} = 'c'; { + local($ENV{_A_}); + local($ENV{_B_}) = 'foo'; local($ENV{_X_}) = 'foo'; local($ENV{_Y_}) = $ENV{_Y_}; print +($ENV{_X_} eq 'foo') ? "" : "not ", "ok 54\n"; @@ -243,3 +248,12 @@ while (/(o.+?),/gc) { print "not " if exists $x{c}; print "ok 71\n"; } + +# these tests should be physically located after tests 46 and 58, +# but are here instead to avoid renumbering everything. + +# local() should preserve the existenceness of tied hashes and %ENV +print "not " if exists $h{'y'}; print "ok 72\n"; +print "not " if exists $h{'z'}; print "ok 73\n"; +print "not " if exists $ENV{_A_}; print "ok 74\n"; +print "not " if exists $ENV{_B_}; print "ok 75\n"; diff --git a/t/op/pwent.t b/t/op/pwent.t index fc71f574ad..4d9de4490f 100755 --- a/t/op/pwent.t +++ b/t/op/pwent.t @@ -49,6 +49,18 @@ BEGIN { } } + if (not defined $where) { # Try NIS+ + foreach my $niscat (qw(/bin/niscat)) { + if (-x $niscat && + open(PW, "$niscat passwd.org_dir 2>/dev/null |") && + defined(<PW>)) { + $where = "NIS+ $niscat passwd.org_dir"; + undef $reason; + last; + } + } + } + if ($reason) { # Give up. print "1..0 # Skip: $reason\n"; exit 0; diff --git a/t/op/tie.t b/t/op/tie.t index 9a651555fc..f8f2322632 100755 --- a/t/op/tie.t +++ b/t/op/tie.t @@ -202,3 +202,12 @@ EXPECT tie FH, 'main'; EXPECT +######## +# correct unlocalisation of tied hashes (patch #16431) +use Tie::Hash ; +tie %tied, Tie::StdHash; +{ local $hash{'foo'} } print "exist1\n" if exists $hash{'foo'}; +{ local $tied{'foo'} } print "exist2\n" if exists $tied{'foo'}; +{ local $ENV{'foo'} } print "exist3\n" if exists $ENV{'foo'}; +EXPECT + |