This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
constant.pm: Make list constants read-only
authorFather Chrysostomos <sprout@cpan.org>
Sun, 30 Jun 2013 06:59:48 +0000 (23:59 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 26 Jul 2013 06:48:01 +0000 (23:48 -0700)
Here we take advantage of the array-ref-stash-elem mechanism added in
the previous commit, which causes the actual elements of the stored
array to be pushed on to the stack.

dist/constant/lib/constant.pm
dist/constant/t/constant.t

index 861d4f0..f947117 100644 (file)
@@ -27,16 +27,19 @@ BEGIN {
     # By doing this, we save 1 run time check for *every* call to import.
     my $const = $] > 5.009002;
     my $downgrade = $] < 5.015004; # && $] >= 5.008
+    my $constarray = $] > 5.019001;
     if ($const) {
        Internals::SvREADONLY($const, 1);
        Internals::SvREADONLY($downgrade, 1);
        $constant::{_CAN_PCS}   = \$const;
        $constant::{_DOWNGRADE} = \$downgrade;
+       $constant::{_CAN_PCS_FOR_ARRAY} = \$constarray;
     }
     else {
        no strict 'refs';
        *{"_CAN_PCS"}   = sub () {$const};
        *{"_DOWNGRADE"} = sub () { $downgrade };
+       *{"_CAN_PCS_FOR_ARRAY"} = sub () { $constarray };
     }
 }
 
@@ -157,7 +160,19 @@ sub import {
                }
            } elsif (@_) {
                my @list = @_;
-               *$full_name = sub () { @list };
+               if (_CAN_PCS_FOR_ARRAY) {
+                   Internals::SvREADONLY(@list, 1);
+                   Internals::SvREADONLY($list[$_], 1) for 0..$#list;
+                   if ($symtab && !exists $symtab->{$name}) {
+                       $symtab->{$name} = \@list;
+                       $flush_mro++;
+                   }
+                   else {
+                       local $constant::{_dummy} = \@list;
+                       *$full_name = \&{"_dummy"};
+                   }
+               }
+               else { *$full_name = sub () { @list }; }
            } else {
                *$full_name = sub () { };
            }
index 93fb578..3a82271 100644 (file)
@@ -396,7 +396,6 @@ SKIP: {
 # either, hence the to-do status).
 SKIP: {
     skip "fails under 5.19.1 and earlier", 2 if $] < 5.019002;
-    local $TODO = " ";
     use constant constant_list => 1..2;
     for (constant_list) {
        my $num = $_;