Integrate mainline

p4raw-id: //depot/perlio@16440

5 files changed, 49 insertions, 8 deletions

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
+