Trans.: CPAN Upload: S/SA/SAPER/constant-1.11.tar.gz

Message-ID: <1190714148.46f8db2431f0c@imp.free.fr>

p4raw-id: //depot/perl@31963

diff --git a/lib/constant.pm b/lib/constant.pm
index 05692d5..4b6c98b 100644 (file)
--- a/lib/constant.pm
+++ b/lib/constant.pm
@@ -1,11 +1,10 @@
 package constant;
-
+use 5.005;
 use strict;
-use 5.006_00;
 use warnings::register;
 
-our($VERSION, %declared);
-$VERSION = '1.10';
+use vars qw($VERSION %declared);
+$VERSION = '1.11';
 
 #=======================================================================
 
@@ -32,6 +31,7 @@ sub import {
     my $multiple  = ref $_[0];
     my $pkg = caller;
     my $symtab;
+    my $str_end = $] >= 5.006 ? "\\z" : "\\Z";
 
     if ($] > 5.009002) {
        no strict 'refs';
@@ -55,7 +55,7 @@ sub import {
        }
 
        # 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.
@@ -69,7 +69,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}) {
@@ -82,7 +82,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");
@@ -158,7 +158,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
@@ -229,8 +229,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
@@ -305,7 +305,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.
@@ -330,7 +330,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.
@@ -341,6 +345,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

diff --git a/lib/constant.t b/lib/constant.t
index b97c688..f5bb2e6 100644 (file)
--- a/lib/constant.t
+++ b/lib/constant.t
@@ -1,8 +1,10 @@
-#!./perl
+#!./perl -T
 
 BEGIN {
-    chdir 't' if -d 't';
-    @INC = '../lib';
+    if ($ENV{PERL_CORE}) {
+        chdir 't' if -d 't';
+        @INC = '../lib';
+    }
 }
 
 use warnings;
@@ -14,7 +16,7 @@ END { print STDERR @warnings }
 
 
 use strict;
-use Test::More tests => 96;
+use Test::More tests => 97;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -80,7 +82,7 @@ is length(MESS), 8;
 
 use constant TRAILING  => '12 cats';
 {
-    no warnings 'numeric';
+    local $^W;
     cmp_ok TRAILING, '==', 12;
 }
 is TRAILING, '12 cats';
@@ -125,10 +127,11 @@ use constant CHASH        => { foo => "ok 38\n" };
 use constant CARRAY    => [ undef, "ok 39\n" ];
 use constant CCODE     => sub { "ok $_[0]\n" };
 
-print ${+CSCALAR};
-print CHASH->{foo};
-print CARRAY->[1];
-print CCODE->($curr_test+4);
+my $output = $TB->output ;
+print $output ${+CSCALAR};
+print $output CHASH->{foo};
+print $output CARRAY->[1];
+print $output CCODE->($curr_test+4);
 
 $TB->current_test($curr_test+4);
 
@@ -178,6 +181,7 @@ ok $constant::declared{'Other::IN_OTHER_PACK'};
 @warnings = ();
 eval q{
     no warnings;
+    #local $^W if $] < 5.006;
     use warnings 'constant';
     use constant 'BEGIN' => 1 ;
     use constant 'INIT' => 1 ;
@@ -196,7 +200,6 @@ eval q{
     use constant 'SIG' => 1 ;
 };
 
-is @warnings, 16 ;
 my @Expected_Warnings = 
   (
    qr/^Constant name 'BEGIN' is a Perl keyword at/,
@@ -216,9 +219,36 @@ my @Expected_Warnings =
    qr/^Constant name 'INC' is forced into package main:: at/,
    qr/^Constant name 'SIG' is forced into package main:: at/,
 );
+
+# when run under "make test"
+if (@warnings == 16) {
+    push @warnings, "";
+    push @Expected_Warnings, qr/^$/;
+}
+# when run directly: perl -wT -Ilib t/constant.t
+elsif (@warnings == 17) {
+    splice @Expected_Warnings, 1, 0, 
+        qr/^Prototype mismatch: sub main::BEGIN \(\) vs none at/;
+}
+# when run directly under 5.6.2: perl -wT -Ilib t/constant.t
+elsif (@warnings == 15) {
+    splice @Expected_Warnings, 1, 1;
+    push @warnings, "", "";
+    push @Expected_Warnings, qr/^$/, qr/^$/;
+}
+else {
+    my $rule = " -" x 20;
+    diag "/!\\ unexpected case: ", scalar @warnings, " warnings\n$rule\n";
+    diag map { "  $_" } @warnings;
+    diag $rule, $/;
+}
+
+is @warnings, 17;
+
 for my $idx (0..$#warnings) {
     like $warnings[$idx], $Expected_Warnings[$idx];
 }
+
 @warnings = ();
 
 
@@ -266,8 +296,11 @@ sub zit;
     local $SIG{'__WARN__'} = sub { push @warnings, @_ };
     eval 'use constant zit => 4; 1' or die $@;
 
+    # empty prototypes are reported differently in different versions
+    my $no_proto = $] < 5.008 ? "" : ": none";
+
     is(scalar @warnings, 1, "1 warning");
-    like ($warnings[0], qr/^Prototype mismatch: sub main::zit: none vs \(\)/,
+    like ($warnings[0], qr/^Prototype mismatch: sub main::zit$no_proto vs \(\)/,
          "about the prototype mismatch");
 
     my $value = eval 'zit';