Test (im)mutability of constants and constant-like subs

including many to-do tests

diff --git a/dist/constant/t/constant.t b/dist/constant/t/constant.t
index 326268b..6b2ac27 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 => 96;
+use Test::More tests => 104;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -346,3 +346,64 @@ $kloong = 'schlozhauer';
     eval 'use constant undef, 5; 1';
     like $@, qr/\ACan't use undef as constant name at /;
 }
+
+# Constants created by "use constant" should be read-only
+
+# This test will not test what we are trying to test if this glob entry
+# exists already, so test that, too.
+ok !exists $::{immutable};
+eval q{
+    use constant immutable => 23987423874;
+    for (immutable) { eval { $_ = 22 } }
+    like $@, qr/^Modification of a read-only value attempted at /,
+       'constant created in empty stash slot is immutable';
+    eval { for (immutable) { ${\$_} = 432 } };
+    SKIP: {
+       require Config;
+       local $TODO;
+       if ($Config::Config{useithreads}) {
+           skip "fails under threads", 1 if $] < 5.019001;
+           $TODO = ' ';
+       }
+       like $@, qr/^Modification of a read-only value attempted at /,
+           '... and immutable through refgen, too';
+    }
+};
+() = \&{"immutable"}; # reify
+eval 'for (immutable) { $_ = 42 }';
+like $@, qr/^Modification of a read-only value attempted at /,
+    '... and after reification';
+
+# Use an existing stash element this time.
+# This next line is sufficient to trigger a different code path in
+# constant.pm.
+() = \%::existing_stash_entry;
+use constant existing_stash_entry => 23987423874;
+for (existing_stash_entry) { eval { $_ = 22 } }
+like $@, qr/^Modification of a read-only value attempted at /,
+    'constant created in existing stash slot is immutable';
+eval { for (existing_stash_entry) { ${\$_} = 432 } };
+SKIP: {
+    local $TODO;
+    if ($Config::Config{useithreads}) {
+       skip "fails under threads", 1 if $] < 5.019001;
+       $TODO = ' ';
+    }
+    like $@, qr/^Modification of a read-only value attempted at /,
+       '... and immutable through refgen, too';
+}
+
+# Test that list constants are also immutable.  This only works under
+# 5.19.1 and later (er, except it doesn’t work under that version yet,
+# either, hence the to-do status).
+SKIP: {
+    skip "fails under 5.19.0 and earlier", 2 if $] < 5.019001;
+    local $TODO = " ";
+    use constant constant_list => 1..2;
+    for (constant_list) {
+       my $num = $_;
+       eval { $_++ };
+       like $@, qr/^Modification of a read-only value attempted at /,
+           "list constant has constant elements ($num)";
+    }
+}

diff --git a/t/op/sub.t b/t/op/sub.t
index d328ac3..2835f05 100644 (file)
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 18 );
+plan( tests => 20 );
 
 sub empty_sub {}
 
@@ -114,3 +114,12 @@ $::TODO = "not fixed yet";
 sub { is \$_[0], \$_[0],
         '[perl #78194] \$_[0] == \$_[0] when @_ aliases "$x"' }
  ->("${\''}");
+
+# The return statement should make no difference in this case:
+sub not_constant () {        42 }
+sub not_constantr() { return 42 }
+eval { ${\not_constant}++ };
+is $@, "", 'sub (){42} returns a mutable value';
+undef $::TODO;
+eval { ${\not_constantr}++ };
+is $@, "", 'sub (){ return 42 } returns a mutable value';