diff options
| -rw-r--r-- | lib/constant.pm | 201 | ||||
| -rw-r--r-- | pod/perldelta.pod | 12 | ||||
| -rw-r--r-- | pod/perlvar.pod | 2 | ||||
| -rwxr-xr-x | t/pragma/constant.t | 43 |
4 files changed, 202 insertions, 56 deletions
diff --git a/lib/constant.pm b/lib/constant.pm index 5d3dd91b46..31f47fbf54 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -1,6 +1,112 @@ package constant; -$VERSION = '1.00'; +use strict; +use vars qw( $VERSION %declared ); +$VERSION = '1.01'; + +#======================================================================= + +require 5.005_62; + +# Some names are evil choices. +my %keywords = map +($_, 1), qw{ BEGIN INIT STOP END DESTROY AUTOLOAD }; + +my %forced_into_main = map +($_, 1), + qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; + +my %forbidden = (%keywords, %forced_into_main); + +#======================================================================= +# import() - import symbols into user's namespace +# +# What we actually do is define a function in the caller's namespace +# which returns the value. The function we create will normally +# be inlined as a constant, thereby avoiding further sub calling +# overhead. +#======================================================================= +sub import { + my $class = shift; + return unless @_; # Ignore 'use constant;' + my $name = shift; + unless (defined $name) { + require Carp; + Carp::croak("Can't use undef as constant name"); + } + my $pkg = caller; + + # Normal constant name + if ($name =~ /^(?:[A-Z]\w|_[A-Z])\w*\z/ and !$forbidden{$name}) { + # Everything is okay + + # Name forced into main, but we're not in main. Fatal. + } elsif ($forced_into_main{$name} and $pkg ne 'main') { + require Carp; + Carp::croak("Constant name '$name' is forced into main::"); + + # Starts with double underscore. Fatal. + } elsif ($name =~ /^__/) { + require Carp; + Carp::croak("Constant name '$name' begins with '__'"); + + # Maybe the name is tolerable + } elsif ($name =~ /^[A-Za-z_]\w*\z/) { + # Then we'll warn only if you've asked for warnings + if ($^W) { + require Carp; + if ($keywords{$name}) { + Carp::carp("Constant name '$name' is a Perl keyword"); + } elsif ($forced_into_main{$name}) { + Carp::carp("Constant name '$name' is " . + "forced into package main::"); + } elsif (1 == length $name) { + Carp::carp("Constant name '$name' is too short"); + } elsif ($name =~ /^_?[a-z\d]/) { + Carp::carp("Constant name '$name' should " . + "have an initial capital letter"); + } else { + # Catch-all - what did I miss? If you get this error, + # please let me know what your constant's name was. + # Write to <rootbeer@redcat.com>. Thanks! + Carp::carp("Constant name '$name' has unknown problems"); + } + } + + # Looks like a boolean + # use constant FRED == fred; + } elsif ($name =~ /^[01]?\z/) { + require Carp; + if (@_) { + Carp::croak("Constant name '$name' is invalid"); + } else { + Carp::croak("Constant name looks like boolean value"); + } + + } else { + # Must have bad characters + require Carp; + Carp::croak("Constant name '$name' has invalid characters"); + } + + { + no strict 'refs'; + my $full_name = "${pkg}::$name"; + $declared{$full_name}++; + if (@_ == 1) { + my $scalar = $_[0]; + *$full_name = sub () { $scalar }; + } elsif (@_) { + my @list = @_; + *$full_name = sub () { @list }; + } else { + *$full_name = sub () { }; + } + } + +} + +1; + +__END__ =head1 NAME @@ -20,7 +126,7 @@ constant - Perl pragma to declare constants print "This line does nothing" unless DEBUGGING; - # references can be declared constant + # references can be constants use constant CHASH => { foo => 42 }; use constant CARRAY => [ 1,2,3,4 ]; use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; @@ -30,7 +136,7 @@ constant - Perl pragma to declare constants print CARRAY->[$i]; print CPSEUDOHASH->{foo}; print CCODE->("me"); - print CHASH->[10]; # compile-time error + print CHASH->[10]; # compile-time error =head1 DESCRIPTION @@ -63,7 +169,10 @@ List constants are returned as lists, not as arrays. 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. +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. Constant symbols are package scoped (rather than block scoped, as C<use strict> is). That is, you can refer to a constant from package @@ -98,7 +207,24 @@ constants at compile time, allowing for way cool stuff like this. print E2BIG, "\n"; # something like "Arg list too long" print 0+E2BIG, "\n"; # "7" -Errors in dereferencing constant references are trapped at compile-time. +Dereferencing constant references incorrectly (such as using an array +subscript on a constant hash reference, or vice versa) will be trapped at +compile time. + +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 +constant name does not include a package name, the current package is +used. + + sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; + } =head1 TECHNICAL NOTE @@ -115,7 +241,19 @@ In the current version of Perl, list constants are not inlined and some symbols may be redefined without generating a warning. It is not possible to have a subroutine or keyword with the same -name as a constant. 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 +technical reasons. + +Even though a reference may be declared as a constant, the reference may +point to data which may be changed, as this code shows. + + use constant CARRAY => [ 1,2,3,4 ]; + print CARRAY->[1]; + CARRAY->[1] = " be changed"; + print CARRAY->[1]; Unlike constants in some languages, these cannot be overridden on the command line or via environment variables. @@ -126,61 +264,20 @@ For example, you can't say C<$hash{CONSTANT}> because C<CONSTANT> will be interpreted as a string. Use C<$hash{CONSTANT()}> or C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from kicking in. Similarly, since the C<=E<gt>> operator quotes a bareword -immediately to its left you have to say C<CONSTANT() =E<gt> 'value'> -instead of C<CONSTANT =E<gt> 'value'>. +immediately to its left, you have to say C<CONSTANT() =E<gt> 'value'> +(or simply use a comma in place of the big arrow) instead of +C<CONSTANT =E<gt> 'value'>. =head1 AUTHOR -Tom Phoenix, E<lt>F<rootbeer@teleport.com>E<gt>, with help from +Tom Phoenix, E<lt>F<rootbeer@redcat.com>E<gt>, with help from many other folks. =head1 COPYRIGHT -Copyright (C) 1997, Tom Phoenix +Copyright (C) 1997, 1999 Tom Phoenix This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut - -use strict; -use Carp; -use vars qw($VERSION); - -#======================================================================= - -# Some of this stuff didn't work in version 5.003, alas. -require 5.003_96; - -#======================================================================= -# import() - import symbols into user's namespace -# -# What we actually do is define a function in the caller's namespace -# which returns the value. The function we create will normally -# be inlined as a constant, thereby avoiding further sub calling -# overhead. -#======================================================================= -sub import { - my $class = shift; - my $name = shift or return; # Ignore 'use constant;' - croak qq{Can't define "$name" as constant} . - qq{ (name contains invalid characters or is empty)} - unless $name =~ /^[^\W_0-9]\w*$/; - - my $pkg = caller; - { - no strict 'refs'; - if (@_ == 1) { - my $scalar = $_[0]; - *{"${pkg}::$name"} = sub () { $scalar }; - } elsif (@_) { - my @list = @_; - *{"${pkg}::$name"} = sub () { @list }; - } else { - *{"${pkg}::$name"} = sub () { }; - } - } - -} - -1; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 8d4fef80a8..c5f3a30edd 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1108,7 +1108,17 @@ Perl bytecode. See L<ByteLoader>. =item constant -References can now be used. See L<constant>. +References can now be used. + +The new version also allows a leading underscore in constant names, but +disallows a double leading underscore (as in "__LINE__"). Some other names +are disallowed or warned against, including BEGIN, END, etc. Some names +which were forced into main:: used to fail silently in some cases; now they're +fatal (outside of main::) and an optional warning (inside of main::). +The ability to detect whether a constant had been set with a given name has +been added. + +See L<constant>. =item charnames diff --git a/pod/perlvar.pod b/pod/perlvar.pod index d38bc4937d..5e705313d5 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -270,7 +270,7 @@ set, you'll get the record back in pieces. On VMS, record reads are done with the equivalent of C<sysread>, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd -want to read in record mode is probably usable in line mode.) +want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. diff --git a/t/pragma/constant.t b/t/pragma/constant.t index a56e081083..5904a4f2b6 100755 --- a/t/pragma/constant.t +++ b/t/pragma/constant.t @@ -14,9 +14,9 @@ END { print @warnings } ######################### We start with some black magic to print on failure. -BEGIN { $| = 1; print "1..46\n"; } +BEGIN { $| = 1; print "1..58\n"; } END {print "not ok 1\n" unless $loaded;} -use constant; +use constant 1.01; $loaded = 1; #print "# Version: $constant::VERSION\n"; print "ok 1\n"; @@ -155,3 +155,42 @@ test 44, scalar($@ =~ /^No such pseudo-hash field/); print CCODE->(45); eval q{ CCODE->{foo} }; test 46, scalar($@ =~ /^Constant is not a HASH/); + +# Allow leading underscore +use constant _PRIVATE => 47; +test 47, _PRIVATE == 47; + +# Disallow doubled leading underscore +eval q{ + use constant __DISALLOWED => "Oops"; +}; +test 48, $@ =~ /begins with '__'/; + +# Check on declared() and %declared. This sub should be EXACTLY the +# same as the one quoted in the docs! +sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; +} + +test 49, declared 'PI'; +test 50, $constant::declared{'main::PI'}; + +test 51, !declared 'PIE'; +test 52, !$constant::declared{'main::PIE'}; + +{ + package Other; + use constant IN_OTHER_PACK => 42; + ::test 53, ::declared 'IN_OTHER_PACK'; + ::test 54, $constant::declared{'Other::IN_OTHER_PACK'}; + ::test 55, ::declared 'main::PI'; + ::test 56, $constant::declared{'main::PI'}; +} + +test 57, declared 'Other::IN_OTHER_PACK'; +test 58, $constant::declared{'Other::IN_OTHER_PACK'}; |