diff options
author | Nicholas Clark <nick@ccl4.org> | 2005-12-26 12:31:01 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2005-12-26 12:31:01 +0000 |
commit | e040ff70dcd06e4474844e2dcba49bc8e2dc9682 (patch) | |
tree | 416bb4b84609ef552d7a11699466ff97245562e1 /lib/constant.pm | |
parent | 331b57bcdc85be353c262edb0595869ccbf0c8b5 (diff) | |
download | perl-e040ff70dcd06e4474844e2dcba49bc8e2dc9682.tar.gz |
Rework constant.pm to take advantage of the space savings of proxy
constant subroutines whenever it can.
p4raw-id: //depot/perl@26487
Diffstat (limited to 'lib/constant.pm')
-rw-r--r-- | lib/constant.pm | 37 |
1 files changed, 25 insertions, 12 deletions
diff --git a/lib/constant.pm b/lib/constant.pm index 0a866aa0ac..d6c8a090d6 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -5,7 +5,7 @@ use 5.006_00; use warnings::register; our($VERSION, %declared); -$VERSION = '1.06'; +$VERSION = '1.07'; #======================================================================= @@ -31,6 +31,12 @@ sub import { 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') { @@ -94,19 +100,26 @@ sub import { 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; } else { - *$full_name = sub () { }; + if(!exists $symtab->{$name}) { + print STDERR "$name $scalar\n"; + } + *$full_name = sub () { $scalar }; } + } elsif (@_) { + my @list = @_; + *$full_name = sub () { @list }; + } else { + *$full_name = sub () { }; } } } |