newer version of constant.pm from Tom Phoenix; added Tom's notes to
Gurusamy Sarathy [Tue, 28 Dec 1999 02:59:16 +0000 (02:59 +0000)]
perldelta; added STOP, DESTROY and AUTOLOAD to specials list

p4raw-id: //depot/perl@4718

lib/constant.pm
pod/perldelta.pod
pod/perlvar.pod
t/pragma/constant.t

index 5d3dd91..31f47fb 100644 (file)
@@ -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;
index 8d4fef8..c5f3a30 100644 (file)
@@ -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
 
index d38bc49..5e70531 100644 (file)
@@ -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.
 
index a56e081..5904a4f 100755 (executable)
@@ -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'};