B::Concise was failing an assertion on index "foo", "foo";
Nicholas Clark [Mon, 22 Oct 2007 11:33:23 +0000 (11:33 +0000)]
p4raw-id: //depot/perl@32164

ext/B/B.xs
ext/B/B/Concise.pm
ext/B/t/optree_misc.t

index 14af877..380e4ed 100644 (file)
@@ -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
index 85da4e5..e458727 100644 (file)
@@ -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 . "::";
index 31213cd..bd8b272 100644 (file)
@@ -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__