summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2005-12-26 12:31:01 +0000
committerNicholas Clark <nick@ccl4.org>2005-12-26 12:31:01 +0000
commite040ff70dcd06e4474844e2dcba49bc8e2dc9682 (patch)
tree416bb4b84609ef552d7a11699466ff97245562e1 /lib
parent331b57bcdc85be353c262edb0595869ccbf0c8b5 (diff)
downloadperl-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')
-rw-r--r--lib/constant.pm37
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 () { };
}
}
}