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
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 ];
print CARRAY->[$i];
print CPSEUDOHASH->{foo};
print CCODE->("me");
- print CHASH->[10]; # compile-time error
+ print CHASH->[10]; # compile-time error
=head1 DESCRIPTION
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
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
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.
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;
######################### 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";
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'};
projects / p5sagit/p5-mst-13.2.git / commitdiff