From: Sébastien Aperghis-Tramoni Date: Tue, 25 Sep 2007 11:55:48 +0000 (+0200) Subject: Trans.: CPAN Upload: S/SA/SAPER/constant-1.11.tar.gz X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6515510feccb8a3e58c1cc3bdc4ed4e4bc03984a;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 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 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 +returned by C in list context. To set it to the string +returned by C in scalar context, an explicit C 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, EFE, with help from many other folks. @@ -341,6 +345,10 @@ EFE. Documentation mostly rewritten by Ilmari Karonen, EFE. +This program is maintained by the Perl 5 Porters. +The CPAN distribution is maintained by SEbastien Aperghis-Tramoni +EFE. + =head1 COPYRIGHT Copyright (C) 1997, 1999 Tom Phoenix diff --git a/lib/constant.t b/lib/constant.t index b97c688..f5bb2e6 100644 --- 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';