f707a9
diff -up constant-1.27/lib/constant.pm.127 constant-1.27/lib/constant.pm
f707a9
--- constant-1.27/lib/constant.pm.127	2015-04-27 13:39:46.613767559 +0200
f707a9
+++ constant-1.27/lib/constant.pm	2015-01-27 23:47:42.000000000 +0100
f707a9
@@ -3,8 +3,8 @@ use 5.008;
f707a9
 use strict;
f707a9
 use warnings::register;
f707a9
 
f707a9
-use vars qw($VERSION %declared);
f707a9
-$VERSION = '1.27';
f707a9
+our $VERSION = '1.33';
f707a9
+our %declared;
f707a9
 
f707a9
 #=======================================================================
f707a9
 
f707a9
@@ -24,13 +24,24 @@ my $boolean = qr/^[01]?\z/;
f707a9
 BEGIN {
f707a9
     # We'd like to do use constant _CAN_PCS => $] > 5.009002
f707a9
     # but that's a bit tricky before we load the constant module :-)
f707a9
-    # By doing this, we save 1 run time check for *every* call to import.
f707a9
-    no strict 'refs';
f707a9
+    # By doing this, we save several run time checks for *every* call
f707a9
+    # to import.
f707a9
     my $const = $] > 5.009002;
f707a9
-    *_CAN_PCS = sub () {$const};
f707a9
-
f707a9
     my $downgrade = $] < 5.015004; # && $] >= 5.008
f707a9
-    *_DOWNGRADE = sub () { $downgrade };
f707a9
+    my $constarray = exists &_make_const;
f707a9
+    if ($const) {
f707a9
+	Internals::SvREADONLY($const, 1);
f707a9
+	Internals::SvREADONLY($downgrade, 1);
f707a9
+	$constant::{_CAN_PCS}   = \$const;
f707a9
+	$constant::{_DOWNGRADE} = \$downgrade;
f707a9
+	$constant::{_CAN_PCS_FOR_ARRAY} = \$constarray;
f707a9
+    }
f707a9
+    else {
f707a9
+	no strict 'refs';
f707a9
+	*{"_CAN_PCS"}   = sub () {$const};
f707a9
+	*{"_DOWNGRADE"} = sub () { $downgrade };
f707a9
+	*{"_CAN_PCS_FOR_ARRAY"} = sub () { $constarray };
f707a9
+    }
f707a9
 }
f707a9
 
f707a9
 #=======================================================================
f707a9
@@ -46,13 +57,13 @@ sub import {
f707a9
     return unless @_;			# Ignore 'use constant;'
f707a9
     my $constants;
f707a9
     my $multiple  = ref $_[0];
f707a9
-    my $pkg = caller;
f707a9
+    my $caller = caller;
f707a9
     my $flush_mro;
f707a9
     my $symtab;
f707a9
 
f707a9
     if (_CAN_PCS) {
f707a9
 	no strict 'refs';
f707a9
-	$symtab = \%{$pkg . '::'};
f707a9
+	$symtab = \%{$caller . '::'};
f707a9
     };
f707a9
 
f707a9
     if ( $multiple ) {
f707a9
@@ -70,6 +81,20 @@ sub import {
f707a9
     }
f707a9
 
f707a9
     foreach my $name ( keys %$constants ) {
f707a9
+	my $pkg;
f707a9
+	my $symtab = $symtab;
f707a9
+	my $orig_name = $name;
f707a9
+	if ($name =~ s/(.*)(?:::|')(?=.)//s) {
f707a9
+	    $pkg = $1;
f707a9
+	    if (_CAN_PCS && $pkg ne $caller) {
f707a9
+		no strict 'refs';
f707a9
+		$symtab = \%{$pkg . '::'};
f707a9
+	    }
f707a9
+	}
f707a9
+	else {
f707a9
+	    $pkg = $caller;
f707a9
+	}
f707a9
+
f707a9
 	# Normal constant name
f707a9
 	if ($name =~ $normal_constant_name and !$forbidden{$name}) {
f707a9
 	    # Everything is okay
f707a9
@@ -117,7 +142,7 @@ sub import {
f707a9
 	    my $full_name = "${pkg}::$name";
f707a9
 	    $declared{$full_name}++;
f707a9
 	    if ($multiple || @_ == 1) {
f707a9
-		my $scalar = $multiple ? $constants->{$name} : $_[0];
f707a9
+		my $scalar = $multiple ? $constants->{$orig_name} : $_[0];
f707a9
 
f707a9
 		if (_DOWNGRADE) { # for 5.8 to 5.14
f707a9
 		    # Work around perl bug #31991: Sub names (actually glob
f707a9
@@ -128,27 +153,50 @@ sub import {
f707a9
 
f707a9
 		# The constant serves to optimise this entire block out on
f707a9
 		# 5.8 and earlier.
f707a9
-		if (_CAN_PCS && $symtab && !exists $symtab->{$name}) {
f707a9
-		    # No typeglob yet, so we can use a reference as space-
f707a9
-		    # efficient proxy for a constant subroutine
f707a9
+		if (_CAN_PCS) {
f707a9
+		    # Use a reference as a proxy for a constant subroutine.
f707a9
+		    # If this is not a glob yet, it saves space.  If it is
f707a9
+		    # a glob, we must still create it this way to get the
f707a9
+		    # right internal flags set, as constants are distinct
f707a9
+		    # from subroutines created with sub(){...}.
f707a9
 		    # The check in Perl_ck_rvconst knows that inlinable
f707a9
 		    # constants from cv_const_sv are read only. So we have to:
f707a9
 		    Internals::SvREADONLY($scalar, 1);
f707a9
-		    $symtab->{$name} = \$scalar;
f707a9
-		    ++$flush_mro;
f707a9
+		    if (!exists $symtab->{$name}) {
f707a9
+			$symtab->{$name} = \$scalar;
f707a9
+			++$flush_mro->{$pkg};
f707a9
+		    }
f707a9
+		    else {
f707a9
+			local $constant::{_dummy} = \$scalar;
f707a9
+			*$full_name = \&{"_dummy"};
f707a9
+		    }
f707a9
 		} else {
f707a9
 		    *$full_name = sub () { $scalar };
f707a9
 		}
f707a9
 	    } elsif (@_) {
f707a9
 		my @list = @_;
f707a9
-		*$full_name = sub () { @list };
f707a9
+		if (_CAN_PCS_FOR_ARRAY) {
f707a9
+		    _make_const($list[$_]) for 0..$#list;
f707a9
+		    _make_const(@list);
f707a9
+		    if (!exists $symtab->{$name}) {
f707a9
+			$symtab->{$name} = \@list;
f707a9
+			$flush_mro->{$pkg}++;
f707a9
+		    }
f707a9
+		    else {
f707a9
+			local $constant::{_dummy} = \@list;
f707a9
+			*$full_name = \&{"_dummy"};
f707a9
+		    }
f707a9
+		}
f707a9
+		else { *$full_name = sub () { @list }; }
f707a9
 	    } else {
f707a9
 		*$full_name = sub () { };
f707a9
 	    }
f707a9
 	}
f707a9
     }
f707a9
     # Flush the cache exactly once if we make any direct symbol table changes.
f707a9
-    mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro;
f707a9
+    if (_CAN_PCS && $flush_mro) {
f707a9
+	mro::method_changed_in($_) for keys %$flush_mro;
f707a9
+    }
f707a9
 }
f707a9
 
f707a9
 1;
f707a9
@@ -190,7 +238,7 @@ This pragma allows you to declare consta
f707a9
 
f707a9
 When you declare a constant such as C<PI> using the method shown
f707a9
 above, each machine your script runs upon can have as many digits
f707a9
-of accuracy as it can use. Also, your program will be easier to
f707a9
+of accuracy as it can use.  Also, your program will be easier to
f707a9
 read, more likely to be maintained (and maintained correctly), and
f707a9
 far less likely to send a space probe to the wrong planet because
f707a9
 nobody noticed the one equation in which you wrote C<3.14195>.
f707a9
@@ -203,7 +251,7 @@ away if the constant is false.
f707a9
 =head1 NOTES
f707a9
 
f707a9
 As with all C<use> directives, defining a constant happens at
f707a9
-compile time. Thus, it's probably not correct to put a constant
f707a9
+compile time.  Thus, it's probably not correct to put a constant
f707a9
 declaration inside of a conditional statement (like C
f707a9
 { use constant ... }>).
f707a9
 
f707a9
@@ -221,10 +269,6 @@ point to data which may be changed, as t
f707a9
     ARRAY->[1] = " be changed";
f707a9
     print ARRAY->[1];
f707a9
 
f707a9
-Dereferencing constant references incorrectly (such as using an array
f707a9
-subscript on a constant hash reference, or vice versa) will be trapped at
f707a9
-compile time.
f707a9
-
f707a9
 Constants belong to the package they are defined in.  To refer to a
f707a9
 constant defined in another package, specify the full package name, as
f707a9
 in C<Some::Package::CONSTANT>.  Constants may be exported by modules,
f707a9
@@ -233,11 +277,18 @@ as C<< Some::Package->CONSTANT >> or as
f707a9
 C<$obj> is an instance of C<Some::Package>.  Subclasses may define
f707a9
 their own constants to override those in their base class.
f707a9
 
f707a9
+As of version 1.32 of this module, constants can be defined in packages
f707a9
+other than the caller, by including the package name in the name of the
f707a9
+constant:
f707a9
+
f707a9
+    use constant "OtherPackage::FWIBBLE" => 7865;
f707a9
+    constant->import("Other::FWOBBLE",$value); # dynamically at run time
f707a9
+
f707a9
 The use of all caps for constant names is merely a convention,
f707a9
 although it is recommended in order to make constants stand out
f707a9
 and to help avoid collisions with other barewords, keywords, and
f707a9
-subroutine names. Constant names must begin with a letter or
f707a9
-underscore. Names beginning with a double underscore are reserved. Some
f707a9
+subroutine names.  Constant names must begin with a letter or
f707a9
+underscore.  Names beginning with a double underscore are reserved.  Some
f707a9
 poor choices for names will generate warnings, if warnings are enabled at
f707a9
 compile time.
f707a9
 
f707a9
@@ -312,15 +363,15 @@ constants without any problems.
f707a9
 =head1 TECHNICAL NOTES
f707a9
 
f707a9
 In the current implementation, scalar constants are actually
f707a9
-inlinable subroutines. As of version 5.004 of Perl, the appropriate
f707a9
+inlinable subroutines.  As of version 5.004 of Perl, the appropriate
f707a9
 scalar constant is inserted directly in place of some subroutine
f707a9
-calls, thereby saving the overhead of a subroutine call. See
f707a9
+calls, thereby saving the overhead of a subroutine call.  See
f707a9
 L<perlsub/"Constant Functions"> for details about how and when this
f707a9
 happens.
f707a9
 
f707a9
 In the rare case in which you need to discover at run time whether a
f707a9
 particular constant has been declared via this module, you may use
f707a9
-this function to examine the hash C<%constant::declared>. If the given
f707a9
+this function to examine the hash C<%constant::declared>.  If the given
f707a9
 constant name does not include a package name, the current package is
f707a9
 used.
f707a9
 
f707a9
@@ -335,11 +386,12 @@ used.
f707a9
 
f707a9
 =head1 CAVEATS
f707a9
 
f707a9
-In the current version of Perl, list constants are not inlined
f707a9
-and some symbols may be redefined without generating a warning.
f707a9
+List constants are not inlined unless you are using Perl v5.20 or higher.
f707a9
+In v5.20 or higher, they are still not read-only, but that may change in
f707a9
+future versions.
f707a9
 
f707a9
 It is not possible to have a subroutine or a keyword with the same
f707a9
-name as a constant in the same package. This is probably a Good Thing.
f707a9
+name as a constant in the same package.  This is probably a Good Thing.
f707a9
 
f707a9
 A constant with a name in the list C
f707a9
 ENV INC SIG> is not allowed anywhere but in package C<main::>, for
f707a9
diff -up constant-1.27/t/constant.t.127 constant-1.27/t/constant.t
f707a9
--- constant-1.27/t/constant.t.127	2013-03-21 01:48:49.000000000 +0100
f707a9
+++ constant-1.27/t/constant.t	2015-01-24 16:02:08.000000000 +0100
f707a9
@@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n
f707a9
 
f707a9
 
f707a9
 use strict;
f707a9
-use Test::More tests => 96;
f707a9
+use Test::More tests => 109;
f707a9
 my $TB = Test::More->builder;
f707a9
 
f707a9
 BEGIN { use_ok('constant'); }
f707a9
@@ -122,7 +122,7 @@ print $output CCODE->($curr_test+4);
f707a9
 $TB->current_test($curr_test+4);
f707a9
 
f707a9
 eval q{ CCODE->{foo} };
f707a9
-ok scalar($@ =~ /^Constant is not a HASH/);
f707a9
+ok scalar($@ =~ /^Constant is not a HASH|Not a HASH reference/);
f707a9
 
f707a9
 
f707a9
 # Allow leading underscore
f707a9
@@ -346,3 +346,78 @@ $kloong = 'schlozhauer';
f707a9
     eval 'use constant undef, 5; 1';
f707a9
     like $@, qr/\ACan't use undef as constant name at /;
f707a9
 }
f707a9
+
f707a9
+# Constants created by "use constant" should be read-only
f707a9
+
f707a9
+# This test will not test what we are trying to test if this glob entry
f707a9
+# exists already, so test that, too.
f707a9
+ok !exists $::{immutable};
f707a9
+eval q{
f707a9
+    use constant immutable => 23987423874;
f707a9
+    for (immutable) { eval { $_ = 22 } }
f707a9
+    like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+	'constant created in empty stash slot is immutable';
f707a9
+    eval { for (immutable) { ${\$_} = 432 } };
f707a9
+    SKIP: {
f707a9
+	require Config;
f707a9
+	if ($Config::Config{useithreads}) {
f707a9
+	    skip "fails under threads", 1 if $] < 5.019003;
f707a9
+	}
f707a9
+	like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+	    '... and immutable through refgen, too';
f707a9
+    }
f707a9
+};
f707a9
+() = \&{"immutable"}; # reify
f707a9
+eval 'for (immutable) { $_ = 42 }';
f707a9
+like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+    '... and after reification';
f707a9
+
f707a9
+# Use an existing stash element this time.
f707a9
+# This next line is sufficient to trigger a different code path in
f707a9
+# constant.pm.
f707a9
+() = \%::existing_stash_entry;
f707a9
+use constant existing_stash_entry => 23987423874;
f707a9
+for (existing_stash_entry) { eval { $_ = 22 } }
f707a9
+like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+    'constant created in existing stash slot is immutable';
f707a9
+eval { for (existing_stash_entry) { ${\$_} = 432 } };
f707a9
+SKIP: {
f707a9
+    if ($Config::Config{useithreads}) {
f707a9
+	skip "fails under threads", 1 if $] < 5.019003;
f707a9
+    }
f707a9
+    like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+	'... and immutable through refgen, too';
f707a9
+}
f707a9
+
f707a9
+# Test that list constants are also immutable.  This only works under
f707a9
+# 5.19.3 and later.
f707a9
+SKIP: {
f707a9
+    skip "fails under 5.19.2 and earlier", 3 if $] < 5.019003;
f707a9
+    local $TODO = "disabled for now; breaks CPAN; see perl #119045";
f707a9
+    use constant constant_list => 1..2;
f707a9
+    for (constant_list) {
f707a9
+	my $num = $_;
f707a9
+	eval { $_++ };
f707a9
+	like $@, qr/^Modification of a read-only value attempted at /,
f707a9
+	    "list constant has constant elements ($num)";
f707a9
+    }
f707a9
+    undef $TODO;
f707a9
+    # Whether values are modifiable or no, modifying them should not affect
f707a9
+    # future return values.
f707a9
+    my @values;
f707a9
+    for(1..2) {
f707a9
+	for ((constant_list)[0]) {
f707a9
+	    push @values, $_;
f707a9
+	    eval {$_++};
f707a9
+	}
f707a9
+    }
f707a9
+    is $values[1], $values[0],
f707a9
+	'modifying list const elements does not affect future retavls';
f707a9
+}
f707a9
+
f707a9
+use constant { "tahi" => 1, "rua::rua" => 2, "toru'toru" => 3 };
f707a9
+use constant "wha::wha" => 4;
f707a9
+is tahi, 1, 'unqualified constant declared with constants in other pkgs';
f707a9
+is rua::rua, 2, 'constant declared with ::';
f707a9
+is toru::toru, 3, "constant declared with '";
f707a9
+is wha::wha, 4, 'constant declared by itself with ::';
f707a9
diff -up constant-1.27/t/utf8.t.127 constant-1.27/t/utf8.t