develooper Front page | perl.perl5.porters | Postings from May 2004

constant.pm patch - resubmission

Thread Next
From:
Lukas Mai
Date:
May 8, 2004 03:14
Subject:
constant.pm patch - resubmission
Message ID:
iss.bb8178fe.a98.409bddee.b2fa2.ea@mailout.lrz-muenchen.de
Greetings!

This is my constant.{pm,t} patch against 5.9.2, as requested.

HTH, Lukas
PS: perlhack says to get the latest changes via rsync from
ftp.linux.activestate.com/perl-current/. Are there any mirrors?

--- lib/orig.constant.pm	Fri May  7 18:32:44 2004
+++ lib/constant.pm	Fri May  7 20:54:55 2004
@@ -1,22 +1,31 @@
 package constant;
 
-use strict;
 use 5.006_00;
+use strict;
+use warnings;
 use warnings::register;
 
 our($VERSION, %declared);
-$VERSION = '1.04';
+$VERSION = '1.05';
 
 #=======================================================================
 
 # Some names are evil choices.
-my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD };
+my %keywords = map +($_, 1), qw{ BEGIN INIT CHECK END DESTROY AUTOLOAD import };
 
 my %forced_into_main = map +($_, 1),
     qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG };
 
 my %forbidden = (%keywords, %forced_into_main);
 
+# Load Carp::croak on demand.
+sub _croak {
+    require Carp;
+    no warnings 'redefine';
+    *_croak = \&Carp::croak;
+    goto &Carp::croak;
+}
+
 #=======================================================================
 # import() - import symbols into user's namespace
 #
@@ -28,71 +37,58 @@
 sub import {
     my $class = shift;
     return unless @_;			# Ignore 'use constant;'
+    my $pkg = caller;
     my %constants = ();
     my $multiple  = ref $_[0];
 
     if ( $multiple ) {
 	if (ref $_[0] ne 'HASH') {
-	    require Carp;
-	    Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
+	    _croak("Invalid reference type '".ref($_[0])."' not 'HASH'");
 	}
 	%constants = %{+shift};
+	if (@_) {
+	    _croak("Too many arguments for multiple constant declaration");
+	}
     } else {
+	unless (defined $_[0]) {
+	    _croak("Can't use undef as constant name");
+	}
 	$constants{+shift} = undef;
     }
 
     foreach my $name ( keys %constants ) {
-	unless (defined $name) {
-	    require Carp;
-	    Carp::croak("Can't use undef as constant name");
-	}
-	my $pkg = caller;
 
-	# Normal constant name
-	if ($name =~ /^_?[^\W_0-9]\w*\z/ and !$forbidden{$name}) {
-	    # Everything is okay
+	if ($name !~ /^[^\W\d]\w*\z/) {
+	    # Must have bad characters
+	    _croak("Constant name '$name' has invalid characters");
 
 	# 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::");
+	    _croak("Constant name '$name' is forced into main::");
 
 	# Starts with double underscore. Fatal.
 	} elsif ($name =~ /^__/) {
-	    require Carp;
-	    Carp::croak("Constant name '$name' begins with '__'");
+	    _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 (warnings::enabled()) {
-		if ($keywords{$name}) {
-		    warnings::warn("Constant name '$name' is a Perl keyword");
-		} elsif ($forced_into_main{$name}) {
-		    warnings::warn("Constant name '$name' is " .
-			"forced into package main::");
-		} else {
-		    # Catch-all - what did I miss? If you get this error,
-		    # please let me know what your constant's name was.
-		    # Write to . Thanks!
-		    warnings::warn("Constant name '$name' has unknown problems");
-		}
+	# Then we'll warn only if you've asked for warnings
+	} elsif (warnings::enabled()) {
+	    if ($keywords{$name}) {
+		warnings::warn("Constant name '$name' is a Perl keyword");
+	    } elsif ($forced_into_main{$name}) {
+		warnings::warn("Constant name '$name' is " .
+		    "forced into package main::");
 	    }
 
 	# Looks like a boolean
 	# use constant FRED == fred;
 	} elsif ($name =~ /^[01]?\z/) {
-            require Carp;
 	    if (@_) {
-		Carp::croak("Constant name '$name' is invalid");
+		_croak("Constant name '$name' is invalid");
 	    } else {
-		Carp::croak("Constant name looks like boolean value");
+		_croak("Constant name looks like boolean value");
 	    }
 
-	} else {
-	   # Must have bad characters
-            require Carp;
-	    Carp::croak("Constant name '$name' has invalid characters");
 	}
 
 	{
--- lib/orig.constant.t	Fri May  7 20:07:09 2004
+++ lib/constant.t	Fri May  7 20:29:33 2004
@@ -14,7 +14,7 @@
 
 
 use strict;
-use Test::More tests => 74;
+use Test::More tests => 78;
 my $TB = Test::More->builder;
 
 BEGIN { use_ok('constant'); }
@@ -197,6 +197,7 @@
     use constant 'END' => 1 ;
     use constant 'DESTROY' => 1 ;
     use constant 'AUTOLOAD' => 1 ;
+    use constant 'import' => 1 ;
     use constant 'STDIN' => 1 ;
     use constant 'STDOUT' => 1 ;
     use constant 'STDERR' => 1 ;
@@ -207,7 +208,7 @@
     use constant 'SIG' => 1 ;
 };
 
-is @warnings, 15 ;
+is @warnings, 16 ;
 my @Expected_Warnings = 
   (
    qr/^Constant name 'BEGIN' is a Perl keyword at/,
@@ -217,6 +218,7 @@
    qr/^Constant name 'END' is a Perl keyword at/,
    qr/^Constant name 'DESTROY' is a Perl keyword at/,
    qr/^Constant name 'AUTOLOAD' is a Perl keyword at/,
+   qr/^Constant name 'import' is a Perl keyword at/,
    qr/^Constant name 'STDIN' is forced into package main:: a/,
    qr/^Constant name 'STDOUT' is forced into package main:: at/,
    qr/^Constant name 'STDERR' is forced into package main:: at/,
@@ -245,3 +247,12 @@
 is FAMILY->[2], RFAM->[0]->[2];
 is AGES->{FAMILY->[1]}, 28;
 is THREE**3, SPIT->(@{+FAMILY}**3);
+
+eval { constant->import( _2 => 42 ) };
+ok !$@;
+
+eval { constant->import( undef ) };
+ok $@ && $@ =~ /^Can't use undef as constant name at/;
+
+eval { constant->import( {}, undef ) };
+ok $@ && $@ =~ /[Tt]oo many arguments /;

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About