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 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 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). @@ -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. Constants may be exported by modules, @@ -233,11 +277,18 @@ as C<< Some::Package->CONSTANT >> or as C<$obj> is an instance of C. 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 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 is not allowed anywhere but in package C, 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