diff -up constant-1.27/lib/constant.pm.127 constant-1.27/lib/constant.pm

--- constant-1.27/lib/constant.pm.127	2015-04-27 13:39:46.613767559 +0200

+++ constant-1.27/lib/constant.pm	2015-01-27 23:47:42.000000000 +0100

@@ -3,8 +3,8 @@ use 5.008;

 use strict;

 use warnings::register;

-use vars qw($VERSION %declared);

-$VERSION = '1.27';

+our $VERSION = '1.33';

+our %declared;

 #=======================================================================

@@ -24,13 +24,24 @@ my $boolean = qr/^[01]?\z/;

 BEGIN {

     # We'd like to do use constant _CAN_PCS => $] > 5.009002

     # but that's a bit tricky before we load the constant module :-)

-    # By doing this, we save 1 run time check for *every* call to import.

-    no strict 'refs';

+    # By doing this, we save several run time checks for *every* call

+    # to import.

     my $const = $] > 5.009002;

-    *_CAN_PCS = sub () {$const};

-

     my $downgrade = $] < 5.015004; # && $] >= 5.008

-    *_DOWNGRADE = sub () { $downgrade };

+    my $constarray = exists &_make_const;

+    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 };

+    }

 }

 #=======================================================================

@@ -46,13 +57,13 @@ sub import {

     return unless @_;			# Ignore 'use constant;'

     my $constants;

     my $multiple  = ref $_[0];

-    my $pkg = caller;

+    my $caller = caller;

     my $flush_mro;

     my $symtab;

     if (_CAN_PCS) {

 	no strict 'refs';

-	$symtab = \%{$pkg . '::'};

+	$symtab = \%{$caller . '::'};

     };

     if ( $multiple ) {

@@ -70,6 +81,20 @@ sub import {

     }

     foreach my $name ( keys %$constants ) {

+	my $pkg;

+	my $symtab = $symtab;

+	my $orig_name = $name;

+	if ($name =~ s/(.*)(?:::|')(?=.)//s) {

+	    $pkg = $1;

+	    if (_CAN_PCS && $pkg ne $caller) {

+		no strict 'refs';

+		$symtab = \%{$pkg . '::'};

+	    }

+	}

+	else {

+	    $pkg = $caller;

+	}

+

 	# Normal constant name

 	if ($name =~ $normal_constant_name and !$forbidden{$name}) {

 	    # Everything is okay

@@ -117,7 +142,7 @@ sub import {

 	    my $full_name = "${pkg}::$name";

 	    $declared{$full_name}++;

 	    if ($multiple || @_ == 1) {

-		my $scalar = $multiple ? $constants->{$name} : $_[0];

+		my $scalar = $multiple ? $constants->{$orig_name} : $_[0];

 		if (_DOWNGRADE) { # for 5.8 to 5.14

 		    # Work around perl bug #31991: Sub names (actually glob

@@ -128,27 +153,50 @@ sub import {

 		# The constant serves to optimise this entire block out on

 		# 5.8 and earlier.

-		if (_CAN_PCS && $symtab && !exists $symtab->{$name}) {

-		    # No typeglob yet, so we can use a reference as space-

-		    # efficient proxy for a constant subroutine

+		if (_CAN_PCS) {

+		    # Use a reference as a proxy for a constant subroutine.

+		    # If this is not a glob yet, it saves space.  If it is

+		    # a glob, we must still create it this way to get the

+		    # right internal flags set, as constants are distinct

+		    # from subroutines created with sub(){...}.

 		    # The check in Perl_ck_rvconst knows that inlinable

 		    # constants from cv_const_sv are read only. So we have to:

 		    Internals::SvREADONLY($scalar, 1);

-		    $symtab->{$name} = \$scalar;

-		    ++$flush_mro;

+		    if (!exists $symtab->{$name}) {

+			$symtab->{$name} = \$scalar;

+			++$flush_mro->{$pkg};

+		    }

+		    else {

+			local $constant::{_dummy} = \$scalar;

+			*$full_name = \&{"_dummy"};

+		    }

 		} else {

 		    *$full_name = sub () { $scalar };

 		}

 	    } elsif (@_) {

 		my @list = @_;

-		*$full_name = sub () { @list };

+		if (_CAN_PCS_FOR_ARRAY) {

+		    _make_const($list[$_]) for 0..$#list;

+		    _make_const(@list);

+		    if (!exists $symtab->{$name}) {

+			$symtab->{$name} = \@list;

+			$flush_mro->{$pkg}++;

+		    }

+		    else {

+			local $constant::{_dummy} = \@list;

+			*$full_name = \&{"_dummy"};

+		    }

+		}

+		else { *$full_name = sub () { @list }; }

 	    } else {

 		*$full_name = sub () { };

 	    }

 	}

     }

     # Flush the cache exactly once if we make any direct symbol table changes.

-    mro::method_changed_in($pkg) if _CAN_PCS && $flush_mro;

+    if (_CAN_PCS && $flush_mro) {

+	mro::method_changed_in($_) for keys %$flush_mro;

+    }

 }

 1;

@@ -190,7 +238,7 @@ This pragma allows you to declare consta

 When you declare a constant such as C<PI> using the method shown

 above, each machine your script runs upon can have as many digits

-of accuracy as it can use. Also, your program will be easier to

+of accuracy as it can use.  Also, your program will be easier to

 read, more likely to be maintained (and maintained correctly), and

 far less likely to send a space probe to the wrong planet because

 nobody noticed the one equation in which you wrote C<3.14195>.

@@ -203,7 +251,7 @@ away if the constant is false.

 =head1 NOTES

 As with all C<use> directives, defining a constant happens at

-compile time. Thus, it's probably not correct to put a constant

+compile time.  Thus, it's probably not correct to put a constant

 declaration inside of a conditional statement (like C

 { use constant ... }>).

@@ -221,10 +269,6 @@ point to data which may be changed, as t

     ARRAY->[1] = " be changed";

     print ARRAY->[1];

-Dereferencing constant references incorrectly (such as using an array

-subscript on a constant hash reference, or vice versa) will be trapped at

-compile time.

-

 Constants belong to the package they are defined in.  To refer to a

 constant defined in another package, specify the full package name, as

 in C<Some::Package::CONSTANT>.  Constants may be exported by modules,

@@ -233,11 +277,18 @@ as C<< Some::Package->CONSTANT >> or as

 C<$obj> is an instance of C<Some::Package>.  Subclasses may define

 their own constants to override those in their base class.

+As of version 1.32 of this module, constants can be defined in packages

+other than the caller, by including the package name in the name of the

+constant:

+

+    use constant "OtherPackage::FWIBBLE" => 7865;

+    constant->import("Other::FWOBBLE",$value); # dynamically at run time

+

 The use of all caps for constant names is merely a convention,

 although it is recommended in order to make constants stand out

 and to help avoid collisions with other barewords, keywords, and

-subroutine names. Constant names must begin with a letter or

-underscore. Names beginning with a double underscore are reserved. Some

+subroutine names.  Constant names must begin with a letter or

+underscore.  Names beginning with a double underscore are reserved.  Some

 poor choices for names will generate warnings, if warnings are enabled at

 compile time.

@@ -312,15 +363,15 @@ constants without any problems.

 =head1 TECHNICAL NOTES

 In the current implementation, scalar constants are actually

-inlinable subroutines. As of version 5.004 of Perl, the appropriate

+inlinable subroutines.  As of version 5.004 of Perl, the appropriate

 scalar constant is inserted directly in place of some subroutine

-calls, thereby saving the overhead of a subroutine call. See

+calls, thereby saving the overhead of a subroutine call.  See

 L<perlsub/"Constant Functions"> for details about how and when this

 happens.

 In the rare case in which you need to discover at run time whether a

 particular constant has been declared via this module, you may use

-this function to examine the hash C<%constant::declared>. If the given

+this function to examine the hash C<%constant::declared>.  If the given

 constant name does not include a package name, the current package is

 used.

@@ -335,11 +386,12 @@ used.

 =head1 CAVEATS

-In the current version of Perl, list constants are not inlined

-and some symbols may be redefined without generating a warning.

+List constants are not inlined unless you are using Perl v5.20 or higher.

+In v5.20 or higher, they are still not read-only, but that may change in

+future versions.

 It is not possible to have a subroutine or a keyword with the same

-name as a constant in the same package. This is probably a Good Thing.

+name as a constant in the same package.  This is probably a Good Thing.

 A constant with a name in the list C

 ENV INC SIG> is not allowed anywhere but in package C<main::>, for

diff -up constant-1.27/t/constant.t.127 constant-1.27/t/constant.t

--- constant-1.27/t/constant.t.127	2013-03-21 01:48:49.000000000 +0100

+++ constant-1.27/t/constant.t	2015-01-24 16:02:08.000000000 +0100

@@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n

 use strict;

-use Test::More tests => 96;

+use Test::More tests => 109;

 my $TB = Test::More->builder;

 BEGIN { use_ok('constant'); }

@@ -122,7 +122,7 @@ print $output CCODE->($curr_test+4);

 $TB->current_test($curr_test+4);

 eval q{ CCODE->{foo} };

-ok scalar($@ =~ /^Constant is not a HASH/);

+ok scalar($@ =~ /^Constant is not a HASH|Not a HASH reference/);

 # Allow leading underscore

@@ -346,3 +346,78 @@ $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;

+	if ($Config::Config{useithreads}) {

+	    skip "fails under threads", 1 if $] < 5.019003;

+	}

+	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: {

+    if ($Config::Config{useithreads}) {

+	skip "fails under threads", 1 if $] < 5.019003;

+    }

+    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.3 and later.

+SKIP: {

+    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) {

+	my $num = $_;

+	eval { $_++ };

+	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';

+}

+

+use constant { "tahi" => 1, "rua::rua" => 2, "toru'toru" => 3 };

+use constant "wha::wha" => 4;

+is tahi, 1, 'unqualified constant declared with constants in other pkgs';

+is rua::rua, 2, 'constant declared with ::';

+is toru::toru, 3, "constant declared with '";

+is wha::wha, 4, 'constant declared by itself with ::';

diff -up constant-1.27/t/utf8.t.127 constant-1.27/t/utf8.t