diff options
| -rw-r--r-- | cv.h | 12 | ||||
| -rw-r--r-- | dump.c | 4 | ||||
| -rw-r--r-- | ext/B/B.xs | 6 | ||||
| -rw-r--r-- | ext/Devel/Peek/t/Peek.t | 12 | ||||
| -rw-r--r-- | sv.h | 6 |
5 files changed, 28 insertions, 12 deletions
@@ -1,7 +1,7 @@ /* cv.h * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -23,10 +23,12 @@ struct xpvcv { HV* xmg_stash; /* class package */ HV * xcv_stash; - OP * xcv_start; + union { + OP * xcv_start; + ANY xcv_xsubany; + } xcv_start_u; OP * xcv_root; void (*xcv_xsub) (pTHX_ CV*); - ANY xcv_xsubany; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ @@ -55,10 +57,10 @@ Returns the stash of the CV. #define Nullcv Null(CV*) #define CvSTASH(sv) ((XPVCV*)SvANY(sv))->xcv_stash -#define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start +#define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start_u.xcv_start #define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root #define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub -#define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_xsubany +#define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_start_u.xcv_xsubany #define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv #define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file #ifdef USE_ITHREADS @@ -1486,13 +1486,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo /* FALL THROUGH */ case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); - if (CvSTART(sv)) + if (!CvISXSUB(sv) && CvSTART(sv)) Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(CvSTART(sv))); Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); if (CvROOT(sv) && dumpops) do_op_dump(level+1, file, CvROOT(sv)); Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); - { + if (CvISXSUB(sv)) { SV *constant = cv_const_sv((CV *)sv); diff --git a/ext/B/B.xs b/ext/B/B.xs index 86dd9d9d67..8271d0425d 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1636,6 +1636,10 @@ CvSTASH(cv) B::OP CvSTART(cv) B::CV cv + CODE: + RETVAL = CvISXSUB(cv) ? NULL : CvSTART(cv); + OUTPUT: + RETVAL B::OP CvROOT(cv) @@ -1678,7 +1682,7 @@ CvXSUBANY(cv) CODE: ST(0) = CvCONST(cv) ? make_sv_object(aTHX_ sv_newmortal(),(SV *)CvXSUBANY(cv).any_ptr) : - sv_2mortal(newSViv(CvXSUBANY(cv).any_iv)); + sv_2mortal(newSViv(CvISXSUB(cv) ? CvXSUBANY(cv).any_iv : 0)); MODULE = B PACKAGE = B::CV diff --git a/ext/Devel/Peek/t/Peek.t b/ext/Devel/Peek/t/Peek.t index d7b51ee721..6984571af5 100644 --- a/ext/Devel/Peek/t/Peek.t +++ b/ext/Devel/Peek/t/Peek.t @@ -17,6 +17,7 @@ print "1..23\n"; our $DEBUG = 0; open(SAVERR, ">&STDERR") or die "Can't dup STDERR: $!"; + sub do_test { my $pattern = pop; if (open(OUT,">peek$$")) { @@ -30,6 +31,12 @@ sub do_test { $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g; # handle DEBUG_LEAKING_SCALARS prefix $pattern =~ s/^(\s*)(SV =.* at )/(?:$1ALLOCATED at .*?\n)?$1$2/mg; + + $pattern =~ s/^ *\$XSUBANY *\n/ + ($] < 5.009) ? " XSUBANY = 0\n" : ''; + /mge; + + print $pattern, "\n" if $DEBUG; my $dump = <IN>; print $dump, "\n" if $DEBUG; @@ -51,6 +58,7 @@ our $b; my $c; local $d = 0; + do_test( 1, $a = "foo", 'SV = PV\\($ADDR\\) at $ADDR @@ -213,7 +221,7 @@ do_test(13, START = $ADDR ===> \\d+ ROOT = $ADDR XSUB = 0x0 - XSUBANY = 0 + $XSUBANY GVGV::GV = $ADDR\\t"main" :: "__ANON__[^"]*" FILE = ".*\\b(?i:peek\\.t)" DEPTH = 0 @@ -240,7 +248,7 @@ do_test(14, START = $ADDR ===> \\d+ ROOT = $ADDR XSUB = 0x0 - XSUBANY = 0 + $XSUBANY GVGV::GV = $ADDR\\t"main" :: "do_test" FILE = ".*\\b(?i:peek\\.t)" DEPTH = 1 @@ -430,10 +430,12 @@ struct xpvfm { HV* xmg_stash; /* class package */ HV * xcv_stash; - OP * xcv_start; + union { + OP * xcv_start; + ANY xcv_xsubany; + } xcv_start_u; OP * xcv_root; void (*xcv_xsub)(pTHX_ CV*); - ANY xcv_xsubany; GV * xcv_gv; char * xcv_file; long xcv_depth; /* >= 2 indicates recursive call */ |