Change 18383: Backport #18319 to 5.8.0, from Dave Mitchell.

[Jarkko Hietaniemi]

Change 18383 by jhi@lyta on 2003/01/01 17:02:29

        Backport #18319 to 5.8.0, from Dave Mitchell.

Affected files ...

... //depot/maint-5.8/perl/op.c#6 edit
... //depot/maint-5.8/perl/t/op/eval.t#3 edit

Differences ...

==== //depot/maint-5.8/perl/op.c#6 (text) ====
Index: perl/op.c
--- perl/op.c#5~18173~  Fri Nov 22 18:02:33 2002
+++ perl/op.c   Wed Jan  1 09:02:29 2003
@@ -610,7 +610,9 @@
     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
        SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
-       SvREADONLY_off(PL_curpad[po]);  /* could be a freed constant */
+       /* SV could be a shared hash key (eg bugid #19022) */
+       if (!SvFAKE(PL_curpad[po]))
+           SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
 #endif
     }
     if ((I32)po < PL_padix)

==== //depot/maint-5.8/perl/t/op/eval.t#3 (xtext) ====
Index: perl/t/op/eval.t
--- perl/t/op/eval.t#2~18209~   Thu Nov 28 11:07:20 2002
+++ perl/t/op/eval.t    Wed Jan  1 09:02:29 2003
@@ -1,6 +1,11 @@
 #!./perl
 
-print "1..47\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+}
+
+print "1..50\n";
 
 eval 'print "ok 1\n";';
 
@@ -247,4 +252,45 @@
    $eval = eval 'sub { eval "sub { %S }" }';
    $eval->({});
    print "ok 47\n";
+}
+
+
+my $test = 48;
+require './test.pl';
+$NO_ENDING = 1;
+# [perl #19022] used to end up with shared hash warnings
+# The program should generate no output, so anything we see is on stderr
+my $got = runperl (prog => '$h{a}=1; foreach my $k (keys %h) {eval qq{\$k}}',
+                  stderr => 1);
+
+if ($got eq '') {
+  print "ok $test\n";
+} else {
+  print "not ok $test\n";
+  _diag ("# Got '$got'\n");
+}
+$test++;
+
+# And a buggy way of fixing #19022 made this fail - $k became undef after the
+# eval for a build with copy on write
+{
+  my %h;
+  $h{a}=1;
+  foreach my $k (keys %h) {
+    if (defined $k and $k eq 'a') {
+      print "ok $test\n";
+    } else {
+      print "not $test # got ", _q ($k), "\n";
+    }
+    $test++;
+
+    eval "\$k";
+
+    if (defined $k and $k eq 'a') {
+      print "ok $test\n";
+    } else {
+      print "not $test # got ", _q ($k), "\n";
+    }
+    $test++;
+  }
 }
End of Patch.