From: Rafael Garcia-Suarez Date: Sun, 25 Feb 2007 15:29:20 +0000 (+0000) Subject: - Use the same regexp as in change #30395 to parse subroutine X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5e1aa25cd135297c28ecf395d4efa30e3d85d375;p=p5sagit%2Fp5-mst-13.2.git - Use the same regexp as in change #30395 to parse subroutine declarations - Make SelfLoader strict-compliant - Constant fold debug code out p4raw-link: @30395 on //depot/perl: 91798d18643cb4539dc3cf0a83f879bbe84d17c2 p4raw-id: //depot/perl@30396 --- diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm index a71c68c..34283b2 100644 --- a/lib/SelfLoader.pm +++ b/lib/SelfLoader.pm @@ -1,20 +1,31 @@ package SelfLoader; -require Exporter; -@ISA = qw(Exporter); -@EXPORT = qw(AUTOLOAD); -$VERSION = "1.10"; + +use 5.009005; # due to new regexp features +use strict; + +use Exporter; +our @ISA = qw(Exporter); +our @EXPORT = qw(AUTOLOAD); +our $VERSION = "1.11"; sub Version {$VERSION} -$DEBUG = 0; +sub DEBUG () { 0 } my %Cache; # private cache for all SelfLoader's client packages # allow checking for valid ': attrlist' attachments -# (we use 'our' rather than 'my' here, due to the rather complex and buggy -# behaviour of lexicals with qr// and (??{$lex}) ) -our $nested; -$nested = qr{ \( (?: (?> [^()]+ ) | (??{ $nested }) )* \) }x; -our $one_attr = qr{ (?> (?! \d) \w+ (?:$nested)? ) (?:\s*\:\s*|\s+(?!\:)) }x; -our $attr_list = qr{ \s* : \s* (?: $one_attr )* }x; +# see also AutoSplit + +my $attr_list = qr{ + \s* : \s* + (?: + # one attribute + (?> # no backtrack + (?! \d) \w+ + (? \( (?: [^()]++ | (?&nested)++ )*+ \) ) ? + ) + (?: \s* : \s* | \s+ (?! :) ) + )* +}x; # in croak and carp, protect $@ from "require Carp;" RT #40216 @@ -22,7 +33,8 @@ sub croak { { local $@; require Carp; } goto &Carp::croak } sub carp { { local $@; require Carp; } goto &Carp::carp } AUTOLOAD { - print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if $DEBUG; + our $AUTOLOAD; + print STDERR "SelfLoader::AUTOLOAD for $AUTOLOAD\n" if DEBUG; my $SL_code = $Cache{$AUTOLOAD}; my $save = $@; # evals in both AUTOLOAD and _load_stubs can corrupt $@ unless ($SL_code) { @@ -35,7 +47,7 @@ AUTOLOAD { if (!$SL_code and $AUTOLOAD =~ m/::DESTROY$/); croak "Undefined subroutine $AUTOLOAD" unless $SL_code; } - print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if $DEBUG; + print STDERR "SelfLoader::AUTOLOAD eval: $SL_code\n" if DEBUG; eval $SL_code; if ($@) { @@ -53,11 +65,13 @@ sub load_stubs { shift->_load_stubs((caller)[0]) } sub _load_stubs { # $endlines is used by Devel::SelfStubber to capture lines after __END__ my($self, $callpack, $endlines) = @_; + no strict "refs"; my $fh = \*{"${callpack}::DATA"}; + use strict; my $currpack = $callpack; my($line,$name,@lines, @stubs, $protoype); - print STDERR "SelfLoader::load_stubs($callpack)\n" if $DEBUG; + print STDERR "SelfLoader::load_stubs($callpack)\n" if DEBUG; croak("$callpack doesn't contain an __DATA__ token") unless defined fileno($fh); # Protect: fork() shares the file pointer between the parent and the kid @@ -127,7 +141,7 @@ sub _add_to_cache { carp("Redefining sub $fullname") if exists $Cache{$fullname}; $Cache{$fullname} = join('', "package $pack; ",@$lines); - print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if $DEBUG; + print STDERR "SelfLoader cached $fullname: $Cache{$fullname}" if DEBUG; # return stub to be eval'd defined($protoype) ? "sub $fullname $protoype;" : "sub $fullname;" }