Change 14159 by jhi@alpha on 2002/01/09 21:28:13
Subject: [PATCH] B::Deparse : support for \[...] prototypes
From: Rafael Garcia-Suarez <[EMAIL PROTECTED]>
Date: Wed, 9 Jan 2002 23:24:32 +0100
Message-ID: <20020109232432.A692@rafael>
Affected files ...
.... //depot/perl/ext/B/B/Deparse.pm#102 edit
Differences ...
==== //depot/perl/ext/B/B/Deparse.pm#102 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm.~1~ Wed Jan 9 14:45:06 2002
+++ perl/ext/B/B/Deparse.pm Wed Jan 9 14:45:06 2002
@@ -21,6 +21,7 @@
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED);
$VERSION = 0.62;
use strict;
+use vars qw/$AUTOLOAD/;
use warnings ();
# Changes between 0.50 and 0.51:
@@ -951,91 +952,15 @@
# pp_padany -- does not exist after parsing
-sub pp_enter { # see also leave
- carp "unexpected OP_ENTER";
- return "XXX";
-}
-
-sub pp_pushmark { # see also list
- carp "unexpected OP_PUSHMARK";
- return "XXX";
-}
-
-sub pp_leavesub { # see also deparse_sub
- carp "unexpected OP_LEAVESUB";
- return "XXX";
+sub AUTOLOAD {
+ if ($AUTOLOAD =~ s/^.*::pp_//) {
+ warn "unexpected OP_".uc $AUTOLOAD;
+ return "XXX";
+ } else {
+ die "Undefined subroutine $AUTOLOAD called";
+ }
}
-sub pp_leavewrite { # see also deparse_format
- carp "unexpected OP_LEAVEWRITE";
- return "XXX";
-}
-
-sub pp_method { # see also entersub
- carp "unexpected OP_METHOD";
- return "XXX";
-}
-
-sub pp_regcmaybe { # see also regcomp
- carp "unexpected OP_REGCMAYBE";
- return "XXX";
-}
-
-sub pp_regcreset { # see also regcomp
- carp "unexpected OP_REGCRESET";
- return "XXX";
-}
-
-sub pp_substcont { # see also subst
- carp "unexpected OP_SUBSTCONT";
- return "XXX";
-}
-
-sub pp_grepstart { # see also grepwhile
- carp "unexpected OP_GREPSTART";
- return "XXX";
-}
-
-sub pp_mapstart { # see also mapwhile
- carp "unexpected OP_MAPSTART";
- return "XXX";
-}
-
-sub pp_method_named {
- carp "unexpected OP_METHOD_NAMED";
- return "XXX";
-}
-
-sub pp_flip { # see also flop
- carp "unexpected OP_FLIP";
- return "XXX";
-}
-
-sub pp_iter { # see also leaveloop
- carp "unexpected OP_ITER";
- return "XXX";
-}
-
-sub pp_enteriter { # see also leaveloop
- carp "unexpected OP_ENTERITER";
- return "XXX";
-}
-
-sub pp_enterloop { # see also leaveloop
- carp "unexpected OP_ENTERLOOP";
- return "XXX";
-}
-
-sub pp_leaveeval { # see also entereval
- carp "unexpected OP_LEAVEEVAL";
- return "XXX";
-}
-
-sub pp_entertry { # see also leavetry
- carp "unexpected OP_ENTERTRY";
- return "XXX";
-}
-
# $root should be the op which represents the root of whatever
# we're sequencing here. If it's undefined, then we don't append
# any subroutine declarations to the deparsed ops, otherwise we
@@ -2859,9 +2784,9 @@
my $doneok = 0;
my @reals;
# An unbackslashed @ or % gobbles up the rest of the args
- $proto =~ s/([^\\]|^)([@%])(.*)$/$1$2/;
+ 1 while $proto =~ s/(?<!\\)([@%])[^\]]+$/$1/;
while ($proto) {
- $proto =~ s/^ *([\\]?[\$\@&%*]|;)//;
+ $proto =~ s/^(\\?[\$\@&%*]|\\\[[\$\@&%*]+\]|;)//;
my $chr = $1;
if ($chr eq "") {
return "&" if @args;
@@ -2899,19 +2824,21 @@
return "&";
}
} elsif (substr($chr, 0, 1) eq "\\") {
- $chr = substr($chr, 1);
+ $chr =~ tr/\\[]//d;
if ($arg->name =~ /^s?refgen$/ and
!null($real = $arg->first) and
- ($chr eq "\$" && is_scalar($real->first)
- or ($chr eq "\@"
+ ($chr =~ /\$/ && is_scalar($real->first)
+ or ($chr =~ /@/
+ && class($real->first->sibling) ne 'NULL'
&& $real->first->sibling->name
=~ /^(rv2|pad)av$/)
- or ($chr eq "%"
+ or ($chr =~ /%/
+ && class($real->first->sibling) ne 'NULL'
&& $real->first->sibling->name
=~ /^(rv2|pad)hv$/)
- #or ($chr eq "&" # This doesn't work
+ #or ($chr =~ /&/ # This doesn't work
# && $real->first->name eq "rv2cv")
- or ($chr eq "*"
+ or ($chr =~ /\*/
&& $real->first->name eq "rv2gv")))
{
push @reals, $self->deparse($real, 6);
End of Patch.
