diff options
| author | Nicholas Clark <nick@ccl4.org> | 2007-10-22 11:33:23 +0000 |
|---|---|---|
| committer | Nicholas Clark <nick@ccl4.org> | 2007-10-22 11:33:23 +0000 |
| commit | 50786ba82909a0386df116b3a3881805219d1abf (patch) | |
| tree | 8587b792e7fbbbc5bc34cab1d1fe36ab1bbabbdb /ext | |
| parent | 4e9b6328625a5360eb2f43579c8e8bb3b3fd2e7c (diff) | |
| download | perl-50786ba82909a0386df116b3a3881805219d1abf.tar.gz | |
B::Concise was failing an assertion on index "foo", "foo";
p4raw-id: //depot/perl@32164
Diffstat (limited to 'ext')
| -rw-r--r-- | ext/B/B.xs | 12 | ||||
| -rw-r--r-- | ext/B/B/Concise.pm | 5 | ||||
| -rw-r--r-- | ext/B/t/optree_misc.t | 36 |
3 files changed, 49 insertions, 4 deletions
diff --git a/ext/B/B.xs b/ext/B/B.xs index 14af877628..380e4edb19 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1620,6 +1620,18 @@ is_empty(gv) OUTPUT: RETVAL +bool +isGV_with_GP(gv) + B::GV gv + CODE: +#if PERL_VERSION >= 9 + RETVAL = isGV_with_GP(gv) ? TRUE : FALSE; +#else + RETVAL = TRUE; /* In 5.8 and earlier they all are. */ +#endif + OUTPUT: + RETVAL + void* GvGP(gv) B::GV gv diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 85da4e5c26..e458727318 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -688,10 +688,9 @@ sub concise_sv { if $hr->{svclass} eq "IV" and $sv->FLAGS & SVf_IVisUV; Carp::cluck("bad concise_sv: $sv") unless $sv and $$sv; $hr->{svaddr} = sprintf("%#x", $$sv); - if ($hr->{svclass} eq "GV") { + if ($hr->{svclass} eq "GV" && $sv->isGV_with_GP()) { my $gv = $sv; - my $stash = $gv->STASH->NAME; - if ($stash eq "main") { + my $stash = $gv->STASH->NAME; if ($stash eq "main") { $stash = ""; } else { $stash = $stash . "::"; diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t index 31213cd41e..bd8b272bcb 100644 --- a/ext/B/t/optree_misc.t +++ b/ext/B/t/optree_misc.t @@ -16,7 +16,7 @@ BEGIN { } use OptreeCheck; use Config; -plan tests => 1; +plan tests => 2; SKIP: { skip "no perlio in this build", 1 unless $Config::Config{useperlio}; @@ -69,5 +69,39 @@ EONT_EONT } #skip +my $t = <<'EOT_EOT'; +# 8 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 1 -e:1) v:{ ->3 +# 7 <2> sassign vKS/2 ->8 +# 5 <@> index[t2] sK/2 ->6 +# - <0> ex-pushmark s ->3 +# 3 <$> const[PV "foo"] s ->4 +# 4 <$> const[GV "foo"] s ->5 +# - <1> ex-rv2sv sKRM*/1 ->7 +# 6 <#> gvsv[*_] s ->7 +EOT_EOT +my $nt = <<'EONT_EONT'; +# 8 <@> leave[1 ref] vKP/REFC ->(end) +# 1 <0> enter ->2 +# 2 <;> nextstate(main 1 -e:1) v:{ ->3 +# 7 <2> sassign vKS/2 ->8 +# 5 <@> index[t1] sK/2 ->6 +# - <0> ex-pushmark s ->3 +# 3 <$> const(PV "foo") s ->4 +# 4 <$> const(GV "foo") s ->5 +# - <1> ex-rv2sv sKRM*/1 ->7 +# 6 <$> gvsv(*_) s ->7 +EONT_EONT + +if ($] < 5.009) { + $t =~ s/GV /BM /; + $nt =~ s/GV /BM /; +} + +checkOptree ( name => 'index and PVBM', + prog => '$_ = index "foo", "foo"', + expect => $t, expect_nt => $nt); + __END__ |