# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.41';
+ $B::VERSION = '1.42';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
STR_WITH_LEN("first"), OPp, offsetof(struct unop, op_first), /* 5*/
STR_WITH_LEN("last"), OPp, offsetof(struct binop, op_last), /* 6*/
STR_WITH_LEN("other"), OPp, offsetof(struct logop, op_other), /* 7*/
- STR_WITH_LEN("pmreplstart"), OPp,
- offsetof(struct pmop, op_pmstashstartu.op_pmreplstart), /* 8*/
+ STR_WITH_LEN("pmreplstart"), 0, -1, /* 8*/
STR_WITH_LEN("redoop"), OPp, offsetof(struct loop, op_redoop), /* 9*/
STR_WITH_LEN("nextop"), OPp, offsetof(struct loop, op_nextop), /*10*/
STR_WITH_LEN("lastop"), OPp, offsetof(struct loop, op_lastop), /*11*/
offset = op_methods[ix].offset;
if (offset < 0) {
switch (ix) {
+ case 8: /* pmreplstart */
+ ret = make_op_object(aTHX_
+ cPMOPo->op_type == OP_SUBST
+ ? cPMOPo->op_pmstashstartu.op_pmreplstart
+ : NULL
+ );
+ break;
#ifdef USE_ITHREADS
case 21: /* filegv */
ret = make_sv_object(aTHX_ (SV *)CopFILEGV((COP*)o));
use Exporter (); # use #5
-our $VERSION = "0.94";
+our $VERSION = "0.95";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
$h{arg} = "";
$h{svclass} = $h{svaddr} = $h{svval} = "";
if ($h{class} eq "PMOP") {
+ my $extra = '';
my $precomp = $op->precomp;
if (defined $precomp) {
$precomp = cstring($precomp); # Escape literal control sequences
} else {
$precomp = "";
}
- my $pmreplroot = $op->pmreplroot;
- my $pmreplstart;
- if (ref($pmreplroot) eq "B::GV") {
+ if ($op->name eq 'subst') {
+ if (class($op->pmreplstart) ne "NULL") {
+ undef $lastnext;
+ $extra = " replstart->" . seq($op->pmreplstart);
+ }
+ }
+ elsif ($op->name eq 'pushre') {
# with C<@stash_array = split(/pat/, str);>,
# *stash_array is stored in /pat/'s pmreplroot.
- $h{arg} = "($precomp => \@" . $pmreplroot->NAME . ")";
- } elsif (!ref($pmreplroot) and $pmreplroot) {
- # same as the last case, except the value is actually a
- # pad offset for where the GV is kept (this happens under
- # ithreads)
- my $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$pmreplroot];
- $h{arg} = "($precomp => \@" . $gv->NAME . ")";
- } elsif ($ {$op->pmreplstart}) {
- undef $lastnext;
- $pmreplstart = "replstart->" . seq($op->pmreplstart);
- $h{arg} = "(" . join(" ", $precomp, $pmreplstart) . ")";
- } else {
- $h{arg} = "($precomp)";
+ my $gv = $op->pmreplroot;
+ if (!ref($gv)) {
+ # threaded: the value is actually a pad offset for where
+ # the GV is kept (op_pmtargetoff)
+ if ($gv) {
+ $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME;
+ }
+ }
+ else {
+ # unthreaded: its a GV (if it exists)
+ $gv = (ref($gv) eq "B::GV") ? $gv->NAME : undef;
+ }
+ $extra = " => \@$gv" if $gv;
}
+ $h{arg} = "($precomp$extra)";
} elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') {
$h{arg} = '("' . $op->pv . '")';
$h{svval} = '"' . $op->pv . '"';
}
use OptreeCheck;
use Config;
-plan tests => 16;
+plan tests => 18;
SKIP: {
skip "no perlio in this build", 4 unless $Config::Config{useperlio};
EONT_EONT
+checkOptree ( name => 'm?x?',
+ code => sub { m?x?; },
+ strip_open_hints => 1,
+ expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
+# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->3
+# 1 <;> nextstate(main 914 optree_misc.t:434) v:{ ->2
+# 2 </> match(/"x"/) /RTIME ->3
+EOT_EOT
+# 3 <1> leavesub[1 ref] K/REFC,1 ->(end)
+# - <@> lineseq KP ->3
+# 1 <;> nextstate(main 914 optree_misc.t:434) v:{ ->2
+# 2 </> match(/"x"/) /RTIME ->3
+EONT_EONT
+
+
unlink $tmpfile;