Upgrade to Test::Simple 0.80, but keep locally modified More.t

[perl5.git] / lib / constant.pm

diff --git a/lib/constant.pm b/lib/constant.pm
index 159c299..2c83553 100644 (file)
--- a/lib/constant.pm
+++ b/lib/constant.pm
@@ -1,16 +1,16 @@
 package constant;
-
+use 5.005;
 use strict;
-use 5.006_00;
 use warnings::register;
 
-our($VERSION, %declared);
-$VERSION = '1.05';
+use vars qw($VERSION %declared);
+$VERSION = '1.15';
 
 #=======================================================================
 
 # Some names are evil choices.
 my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
+$keywords{UNITCHECK}++ if $] > 5.009;
 
 my %forced_into_main = map +($_, 1),
     qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
@@ -28,28 +28,35 @@ my %forbidden = (%keywords, %forced_into_main);
 sub import {
     my $class = shift;
     return unless @_;                  # Ignore 'use constant;'
-    my %constants = ();
+    my $constants;
     my $multiple  = ref $_[0];
+    my $pkg = caller;
+    my $symtab;
+    my $str_end = $] >= 5.006 ? "\\z" : "\\Z";
+
+    if ($] > 5.009002) {
+       no strict 'refs';
+       $symtab = \%{$pkg . '::'};
+    };
 
     if ( $multiple ) {
        if (ref $_[0] ne 'HASH') {
            require Carp;
            Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
        }
-       %constants = %{+shift};
+       $constants = shift;
     } else {
-       $constants{+shift} = undef;
+       $constants->{+shift} = undef;
     }
 
-    foreach my $name ( keys %constants ) {
+    foreach my $name ( keys %$constants ) {
        unless (defined $name) {
            require Carp;
            Carp::croak("Can't use undef as constant name");
        }
-       my $pkg = caller;
 
        # Normal constant name
-       if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) {
+       if ($name =~ /^_?[^\W_0-9]\w*$str_end/ and !$forbidden{$name}) {
            # Everything is okay
 
        # Name forced into main, but we're not in main. Fatal.
@@ -63,7 +70,7 @@ sub import {
            Carp::croak("Constant name '$name' begins with '__'");
 
        # Maybe the name is tolerable
-       } elsif ($name =~ /^[A-Za-z_]\w*\z/) {
+       } elsif ($name =~ /^[A-Za-z_]\w*$str_end/) {
            # Then we'll warn only if you've asked for warnings
            if (warnings::enabled()) {
                if ($keywords{$name}) {
@@ -76,7 +83,7 @@ sub import {
 
        # Looks like a boolean
        # use constant FRED == fred;
-       } elsif ($name =~ /^[01]?\z/) {
+       } elsif ($name =~ /^[01]?$str_end/) {
             require Carp;
            if (@_) {
                Carp::croak("Constant name '$name' is invalid");
@@ -94,19 +101,24 @@ sub import {
            no strict 'refs';
            my $full_name = "${pkg}::$name";
            $declared{$full_name}++;
-           if ($multiple) {
-               my $scalar = $constants{$name};
-               *$full_name = sub () { $scalar };
-           } else {
-               if (@_ == 1) {
-                   my $scalar = $_[0];
-                   *$full_name = sub () { $scalar };
-               } elsif (@_) {
-                   my @list = @_;
-                   *$full_name = sub () { @list };
+           if ($multiple || @_ == 1) {
+               my $scalar = $multiple ? $constants->{$name} : $_[0];
+               if ($symtab && !exists $symtab->{$name}) {
+                   # No typeglob yet, so we can use a reference as space-
+                   # efficient proxy for a constant subroutine
+                   # 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;
+                   mro::method_changed_in($pkg);
                } else {
-                   *$full_name = sub () { };
+                   *$full_name = sub () { $scalar };
                }
+           } elsif (@_) {
+               my @list = @_;
+               *$full_name = sub () { @list };
+           } else {
+               *$full_name = sub () { };
            }
        }
     }
@@ -147,7 +159,7 @@ constant - Perl pragma to declare constants
 
 =head1 DESCRIPTION
 
-This will declare a symbol to be a constant with the given value.
+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
@@ -218,8 +230,8 @@ constant is evaluated in list context.  This may produce surprises:
     use constant TIMESTAMP => scalar localtime;         # right
 
 The first line above defines C<TIMESTAMP> as a 9-element list, as
-returned by localtime() in list context.  To set it to the string
-returned by localtime() in scalar context, an explicit C<scalar>
+returned by C<localtime()> in list context.  To set it to the string
+returned by C<localtime()> in scalar context, an explicit C<scalar>
 keyword is required.
 
 List constants are lists, not arrays.  To index or slice them, they
@@ -294,7 +306,7 @@ used.
         $constant::declared{$full_name};
     }
 
-=head1 BUGS
+=head1 CAVEATS
 
 In the current version of Perl, list constants are not inlined
 and some symbols may be redefined without generating a warning.
@@ -319,7 +331,11 @@ immediately to its left, you have to say C<< CONSTANT() => 'value' >>
 (or simply use a comma in place of the big arrow) instead of
 C<< CONSTANT => 'value' >>.
 
-=head1 AUTHOR
+=head1 BUGS
+
+Please report any bugs or feature requests via the perlbug(1) utility.
+
+=head1 AUTHORS
 
 Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from
 many other folks.
@@ -330,6 +346,10 @@ E<lt>F<casey@geeknest.com>E<gt>.
 Documentation mostly rewritten by Ilmari Karonen,
 E<lt>F<perl@itz.pp.sci.fi>E<gt>.
 
+This program is maintained by the Perl 5 Porters. 
+The CPAN distribution is maintained by SE<eacute>bastien Aperghis-Tramoni
+E<lt>F<sebastien@aperghis.net>E<gt>.
+
 =head1 COPYRIGHT
 
 Copyright (C) 1997, 1999 Tom Phoenix