@@ -1,24 +0,0 @@
-use 5.005;
-use strict;
-use Module::Build;
-
-my %prereq = (
- "Test::More" => 0,
-);
-
-$prereq{"warnings::compat"} = 0 if $] < 5.006;
-
-my $builder = Module::Build->new(
- module_name => 'constant',
- license => 'perl',
- dist_author => 'Sébastien Aperghis-Tramoni <sebastien@aperghis.net>',
- dist_version_from => 'lib/constant.pm',
- installdirs => 'core',
- build_requires => \%prereq,
- configure_requires => {
- 'Module::Build' => '0.2808',
- },
- add_to_cleanup => [ 'constant-*' ],
-);
-
-$builder->create_build_script();
@@ -1,5 +1,12 @@
Revision history for constant
+1.33 2015.04.30 RJBS (Ricardo SIGNES)
+ [CODE] Updated from bleadperl:
+ - Stop using vars.pm
+ - Allow package name in ‘use constant’ constants
+ - Remove bug-inducing compile-time checking of constant values
+ - Make elements of list consts read-only
+
1.27 2013.03.21 SAPER (Sébastien Aperghis-Tramoni)
[CODE] Updated from bleadperl:
- Remove a reference to a non-existent module (Karl Williamson)
@@ -1,15 +1,9 @@
-MANIFEST
-META.yml
-Makefile.PL
-Build.PL
Changes
-README
lib/constant.pm
-eg/synopsis.pl
-t/00-load.t
+Makefile.PL
+MANIFEST This list of files
+README
t/constant.t
-t/more-tests.t
-t/pod-coverage.t
-t/pod.t
t/utf8.t
-META.json
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -1,10 +1,10 @@
{
"abstract" : "Perl pragma to declare constants",
"author" : [
- "Sébastien Aperghis-Tramoni <sebastien@aperghis.net>"
+ "Sebastien Aperghis-Tramoni <sebastien@aperghis.net>"
],
"dynamic_config" : 1,
- "generated_by" : "Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921",
+ "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001",
"license" : [
"perl_5"
],
@@ -13,29 +13,43 @@
"version" : "2"
},
"name" : "constant",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
"prereqs" : {
"build" : {
"requires" : {
- "Test::More" : "0"
+ "ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
- "Module::Build" : "0.2808"
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "Test::More" : "0"
}
- }
- },
- "provides" : {
- "constant" : {
- "file" : "lib/constant.pm",
- "version" : "1.27"
}
},
"release_status" : "stable",
"resources" : {
+ "bugtracker" : {
+ "web" : "https://rt.perl.org/rt3/Search/Results.html?Query=Queue='perl5' AND Content LIKE 'module=constant' AND (Status='open' OR Status='new' OR Status='stalled')"
+ },
+ "homepage" : "https://metacpan.org/module/constant",
"license" : [
"http://dev.perl.org/licenses/"
- ]
+ ],
+ "repository" : {
+ "url" : "git://perl5.git.perl.org/perl.git"
+ },
+ "x_Irc" : "irc://irc.perl.org/#p5p",
+ "x_Mailinglist" : "http://lists.perl.org/list/perl5-porters.html"
},
- "version" : "1.27"
+ "version" : "1.33"
}
@@ -1,22 +1,29 @@
---
abstract: 'Perl pragma to declare constants'
author:
- - 'Sébastien Aperghis-Tramoni <sebastien@aperghis.net>'
+ - 'Sebastien Aperghis-Tramoni <sebastien@aperghis.net>'
build_requires:
- Test::More: 0
+ ExtUtils::MakeMaker: '0'
configure_requires:
- Module::Build: 0.2808
+ ExtUtils::MakeMaker: '0'
dynamic_config: 1
-generated_by: 'Module::Build version 0.4003, CPAN::Meta::Converter version 2.120921'
+generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: constant
-provides:
- constant:
- file: lib/constant.pm
- version: 1.27
+no_index:
+ directory:
+ - t
+ - inc
+requires:
+ Test::More: '0'
resources:
+ Irc: irc://irc.perl.org/#p5p
+ Mailinglist: http://lists.perl.org/list/perl5-porters.html
+ bugtracker: "https://rt.perl.org/rt3/Search/Results.html?Query=Queue='perl5' AND Content LIKE 'module=constant' AND (Status='open' OR Status='new' OR Status='stalled')"
+ homepage: https://metacpan.org/module/constant
license: http://dev.perl.org/licenses/
-version: 1.27
+ repository: git://perl5.git.perl.org/perl.git
+version: '1.33'
@@ -6,15 +6,13 @@ my %prereq = (
"Test::More" => 0,
);
-$prereq{"warnings::compat"} = 0 if $] < 5.006;
-
WriteMakefile(
NAME => 'constant',
LICENSE => 'perl',
AUTHOR => 'Sebastien Aperghis-Tramoni <sebastien@aperghis.net>',
VERSION_FROM => 'lib/constant.pm',
ABSTRACT_FROM => 'lib/constant.pm',
- INSTALLDIRS => 'perl',
+ INSTALLDIRS => ($] >= 5.012 ? 'site' : 'perl'),
PL_FILES => {},
PREREQ_PM => \%prereq,
META_MERGE => {
@@ -1,28 +0,0 @@
-#!/usr/bin/perl
-#
-# Straight from the synopsis.
-#
-use strict;
-
-use constant PI => 4 * atan2(1, 1);
-use constant DEBUG => 0;
-
-print "Pi equals ", PI, "...\n" if DEBUG;
-
-use constant {
- SEC => 0,
- MIN => 1,
- HOUR => 2,
- MDAY => 3,
- MON => 4,
- YEAR => 5,
- WDAY => 6,
- YDAY => 7,
- ISDST => 8,
-};
-
-use constant WEEKDAYS => qw(
- Sunday Monday Tuesday Wednesday Thursday Friday Saturday
-);
-
-print "Today is ", (WEEKDAYS)[ (localtime)[WDAY] ], ".\n";
@@ -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 constants at compile-time.
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<if ($foo)
{ use constant ... }>).
@@ -221,10 +269,6 @@ point to data which may be changed, as this code shows.
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->CONSTANT >> where
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<STDIN STDOUT STDERR ARGV ARGVOUT
ENV INC SIG> is not allowed anywhere but in package C<main::>, for
@@ -1,9 +0,0 @@
-#!perl -T
-
-use Test::More tests => 1;
-
-BEGIN {
- use_ok( 'constant' );
-}
-
-diag( "Testing constant $constant::VERSION, Perl $], $^X" );
@@ -9,7 +9,7 @@ END { @warnings && print STDERR join "\n- ", "accumulated warnings:", @warnings
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 ::';
@@ -1,55 +0,0 @@
-#!perl -T
-use strict;
-use warnings;
-use vars qw{ @warnings };
-use Test::More;
-
-
-BEGIN {
- plan skip_all => "Author tests" unless $ENV{AUTHOR_MODE};
- plan tests => 4;
-}
-
-BEGIN { # ...and save 'em for later
- $SIG{'__WARN__'} = sub { push @warnings, @_ }
-}
-END { @warnings && print STDERR join "\n- ", "unexpected warnings:", @warnings }
-
-
-my $TB = Test::More->builder;
-
-BEGIN { use_ok('constant'); }
-
-
-# The original test code was:
-#
-# use constant TRAILING => '12 cats';
-# {
-# no warnings "numeric";
-# cmp_ok TRAILING, '==', 12;
-# }
-#
-# It worked fine during a long time (at least for some value of "work"),
-# until the combination of two independant modifications. First, Sebastien
-# Aperghis-Tramoni replaced the C< no warnings "numeric" > with a
-# C< local $^W > when constant.pm was dual-lifed and ported back to 5.005
-# (see change 31963).
-#
-# It still worked fine, but then Michael Schwern improved Test::Builder in
-# version 0.82 by turning warnings on. This broke this test by generating
-# a warning. The test was fixed, but Michael wondered if the test was
-# really appropriate, given it was more testing Perl itself than constant.pm.
-# Sebastien asked P5P for advice: Nicholas Clark and Andy Dougherty were
-# in favour of removing it. So it was moved from t/constant.t to this file,
-# in order to keep it while preventing it from being a problem.
-#
-use constant TRAILING => '12 cats';
-{
- no warnings "numeric";
- ok( TRAILING == 12 ) or diag sprintf "'%s' == 12", TRAILING;
- @warnings = () if $] <= 5.006; # we can't hide this warning under 5.005
-}
-is TRAILING, '12 cats';
-
-
-is @warnings, 0 or diag join "\n- ", "unexpected warning", @warnings;
@@ -1,6 +0,0 @@
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
-all_pod_coverage_ok();
@@ -1,6 +0,0 @@
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod 1.14";
-plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
-all_pod_files_ok();