Change 30259 by [EMAIL PROTECTED] on 2007/02/13 16:04:12
Integrate:
[ 26483]
Using a hash reference rather than a hash can save a hash copy.
[ 26484]
Tests for creating constants where prototypes or other symbols of the
same name already exist.
[ 26485]
The value from caller doesn't change, so my $pkg = caller;
should be moved out of the loop.
[ 26487]
Rework constant.pm to take advantage of the space savings of proxy
constant subroutines whenever it can.
[ 26502]
As what we're doing is generating subroutines, which are methods, we
need to invalidate cached methods. For constant.pm we need to create
&Internals::inc_sub_generation
[ 30255]
Change 26487 left some debugging code in, and through the wonders of
autovivification, that code actually introduced a bug, most easily
visible for the for the non-5.9.x case.
Affected files ...
... //depot/maint-5.8/perl/lib/constant.pm#3 integrate
... //depot/maint-5.8/perl/lib/constant.t#6 integrate
... //depot/maint-5.8/perl/universal.c#62 integrate
Differences ...
==== //depot/maint-5.8/perl/lib/constant.pm#3 (text) ====
Index: perl/lib/constant.pm
--- perl/lib/constant.pm#2~23593~ 2004-12-01 11:11:22.000000000 -0800
+++ perl/lib/constant.pm 2007-02-13 08:04:12.000000000 -0800
@@ -5,7 +5,7 @@
use warnings::register;
our($VERSION, %declared);
-$VERSION = '1.05';
+$VERSION = '1.08';
#=======================================================================
@@ -28,25 +28,31 @@
sub import {
my $class = shift;
return unless @_; # Ignore 'use constant;'
- my %constants = ();
+ my $constants;
my $multiple = ref $_[0];
+ my $pkg = caller;
+ my $symtab;
+
+ if ($] > 5.009002) {
+ no strict 'refs';
+ $symtab = \%{$pkg . '::'};
+ };
if ( $multiple ) {
if (ref $_[0] ne 'HASH') {
require Carp;
Carp::croak("Invalid reference type '".ref(shift)."' not 'HASH'");
}
- %constants = %{+shift};
+ $constants = shift;
} else {
- $constants{+shift} = undef;
+ $constants->{+shift} = undef;
}
- foreach my $name ( keys %constants ) {
+ 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}) {
@@ -94,19 +100,24 @@
no strict 'refs';
my $full_name = "${pkg}::$name";
$declared{$full_name}++;
- if ($multiple) {
- my $scalar = $constants{$name};
- *$full_name = sub () { $scalar };
- } else {
- if (@_ == 1) {
- my $scalar = $_[0];
- *$full_name = sub () { $scalar };
- } elsif (@_) {
- my @list = @_;
- *$full_name = sub () { @list };
+ if ($multiple || @_ == 1) {
+ my $scalar = $multiple ? $constants->{$name} : $_[0];
+ if ($symtab && !exists $symtab->{$name}) {
+ # No typeglob yet, so we can use a reference as space-
+ # efficient proxy for a constant subroutine
+ # The check in Perl_ck_rvconst knows that inlinable
+ # constants from cv_const_sv are read only. So we have to:
+ Internals::SvREADONLY($scalar, 1);
+ $symtab->{$name} = \$scalar;
+ Internals::inc_sub_generation;
} else {
- *$full_name = sub () { };
+ *$full_name = sub () { $scalar };
}
+ } elsif (@_) {
+ my @list = @_;
+ *$full_name = sub () { @list };
+ } else {
+ *$full_name = sub () { };
}
}
}
==== //depot/maint-5.8/perl/lib/constant.t#6 (text) ====
Index: perl/lib/constant.t
--- perl/lib/constant.t#5~23593~ 2004-12-01 11:11:22.000000000 -0800
+++ perl/lib/constant.t 2007-02-13 08:04:12.000000000 -0800
@@ -6,7 +6,7 @@
}
use warnings;
-use vars qw{ @warnings };
+use vars qw{ @warnings $fagwoosh $putt $kloong};
BEGIN { # ...and save 'em for later
$SIG{'__WARN__'} = sub { push @warnings, @_ }
}
@@ -14,7 +14,7 @@
use strict;
-use Test::More tests => 81;
+use Test::More tests => 101;
my $TB = Test::More->builder;
BEGIN { use_ok('constant'); }
@@ -252,3 +252,73 @@
};
ok( $@ eq '' );
}
+
+sub slotch ();
+
+{
+ my @warnings;
+ local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+ eval 'use constant slotch => 3; 1' or die $@;
+
+ is ("@warnings", "", "No warnings if a prototype exists");
+
+ my $value = eval 'slotch';
+ is ($@, '');
+ is ($value, 3);
+}
+
+sub zit;
+
+{
+ my @warnings;
+ local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+ eval 'use constant zit => 4; 1' or die $@;
+
+ is(scalar @warnings, 1, "1 warning");
+ like ($warnings[0], qr/^Prototype mismatch: sub main::zit: none vs \(\)/,
+ "about the prototype mismatch");
+
+ my $value = eval 'zit';
+ is ($@, '');
+ is ($value, 4);
+}
+
+$fagwoosh = 'geronimo';
+$putt = 'leutwein';
+$kloong = 'schlozhauer';
+
+{
+ my @warnings;
+ local $SIG{'__WARN__'} = sub { push @warnings, @_ };
+ eval 'use constant fagwoosh => 5; 1' or die $@;
+
+ is ("@warnings", "", "No warnings if the typeglob exists already");
+
+ my $value = eval 'fagwoosh';
+ is ($@, '');
+ is ($value, 5);
+
+ my @value = eval 'fagwoosh';
+ is ($@, '');
+ is_deeply ([EMAIL PROTECTED], [5]);
+
+ eval 'use constant putt => 6, 7; 1' or die $@;
+
+ is ("@warnings", "", "No warnings if the typeglob exists already");
+
+ @value = eval 'putt';
+ is ($@, '');
+ is_deeply ([EMAIL PROTECTED], [6, 7]);
+
+ eval 'use constant "klong"; 1' or die $@;
+
+ is ("@warnings", "", "No warnings if the typeglob exists already");
+
+ $value = eval 'klong';
+ is ($@, '');
+ is ($value, undef);
+
+ @value = eval 'klong';
+ is ($@, '');
+ is_deeply ([EMAIL PROTECTED], []);
+}
==== //depot/maint-5.8/perl/universal.c#62 (text) ====
Index: perl/universal.c
--- perl/universal.c#61~30006~ 2007-01-26 04:19:35.000000000 -0800
+++ perl/universal.c 2007-02-13 08:04:12.000000000 -0800
@@ -188,6 +188,7 @@
XS(XS_Internals_hash_seed);
XS(XS_Internals_rehash_seed);
XS(XS_Internals_HvREHASH);
+XS(XS_Internals_inc_sub_generation);
void
Perl_boot_core_UNIVERSAL(pTHX)
@@ -215,6 +216,8 @@
newXSproto("Internals::hash_seed",XS_Internals_hash_seed, (char *)file,
"");
newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, (char
*)file, "");
newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, (char *)file,
"\\%");
+ newXSproto("Internals::inc_sub_generation",XS_Internals_inc_sub_generation,
+ file, "");
}
@@ -705,6 +708,17 @@
Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
}
+XS(XS_Internals_inc_sub_generation)
+{
+ /* Using dXSARGS would also have dITEM and dSP,
+ * which define 2 unused local variables. */
+ dAXMARK;
+ PERL_UNUSED_ARG(cv);
+ PERL_UNUSED_VAR(mark);
+ ++PL_sub_generation;
+ XSRETURN_EMPTY;
+}
+
/*
* Local variables:
* c-indentation-style: bsd
End of Patch.
