Don’t let list const modification affect future retvals

In commit f99a5f08f203, I inadvertently made modifications to val-
ues return by list ‘constants’ affect what values are returned sub-
sequently.

It’s for this type of situation that PADTMP exists (values are never
referenced, but copied).  So use it.

This is similar to 5608dcc62, which fixed #3105.

diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 78f21ac..111a8e1 100644 (file)
--- a/dist/constant/t/constant.t
+++ b/dist/constant/t/constant.t
@@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings
 
 
 use strict;
-use Test::More tests => 104;
+use Test::More tests => 105;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -392,7 +392,7 @@ SKIP: {
 # Test that list constants are also immutable.  This only works under
 # 5.19.3 and later.
 SKIP: {
-    skip "fails under 5.19.2 and earlier", 2 if $] < 5.019003;
+    skip "fails under 5.19.2 and earlier", 3 if $] < 5.019003;
     local $TODO = "disabled for now; breaks CPAN; see perl #119045";
     use constant constant_list => 1..2;
     for (constant_list) {
@@ -401,4 +401,16 @@ SKIP: {
        like $@, qr/^Modification of a read-only value attempted at /,
            "list constant has constant elements ($num)";
     }
+    undef $TODO;
+    # Whether values are modifiable or no, modifying them should not affect
+    # future return values.
+    my @values;
+    for(1..2) {
+       for ((constant_list)[0]) {
+           push @values, $_;
+           eval {$_++};
+       }
+    }
+    is $values[1], $values[0],
+       'modifying list const elements does not affect future retavls';
 }

diff --git a/universal.c b/universal.c
index a57572b..46511d3 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -921,6 +921,15 @@ XS(XS_Internals_SvREADONLY)        /* This is dangerous stuff. */
        if (SvTRUE(ST(1))) {
            if (SvIsCOW(sv)) sv_force_normal(sv);
            SvREADONLY_on(sv);
+           if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) {
+               /* for constant.pm; nobody else should be calling this
+                  on arrays anyway. */
+               SV **svp;
+               for (svp = AvARRAY(sv) + AvFILLp(sv)
+                  ; svp >= AvARRAY(sv)
+                  ; --svp)
+                   if (*svp) SvPADTMP_on(*svp);
+           }
            XSRETURN_YES;
        }
        else {