B::CC::pp_rv2cv problem

To: perl5-porters@perl.org
Message-ID: <MLIST_19990108101557.4481.qmail@hotmail.com>

p4raw-id: //depot/cfgperl@2600

diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index e4f8877..1197be4 100644 (file)
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -66,6 +66,7 @@ my %skip_stack;               # Hash of PP names which don't need write_back_stack
 my %skip_lexicals;     # Hash of PP names which don't need write_back_lexicals
 my %skip_invalidate;   # Hash of PP names which don't need invalidate_lexicals
 my %ignore_op;         # Hash of ops which do nothing except returning op_next
+my %need_curcop;       # Hash of ops which need PL_curcop
 
 BEGIN {
     foreach (qw(pp_scalar pp_regcmaybe pp_lineseq pp_scope pp_null)) {
@@ -106,6 +107,7 @@ sub init_hash { map { $_ => 1 } @_ }
 #
 %skip_lexicals = init_hash qw(pp_enter pp_enterloop);
 %skip_invalidate = init_hash qw(pp_enter pp_enterloop);
+%need_curcop = init_hash qw(pp_rv2gv  pp_bless pp_repeat pp_sort pp_caller pp_reset pp_rv2cv pp_entereval pp_require pp_dofile pp_entertry pp_enterloop pp_enteriter );
 
 sub debug {
     if ($debug_runtime) {
@@ -580,14 +582,15 @@ sub pp_dbstate {
     return default_pp($op);
 }
 
-sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
-sub pp_bless { $curcop->write_back; default_pp(@_) }
-sub pp_repeat { $curcop->write_back; default_pp(@_) }
+#default_pp will handle this:
+#sub pp_rv2gv { $curcop->write_back; default_pp(@_) }
+#sub pp_bless { $curcop->write_back; default_pp(@_) }
+#sub pp_repeat { $curcop->write_back; default_pp(@_) }
 # The following subs need $curcop->write_back if we decide to support arybase:
 # pp_pos, pp_substr, pp_index, pp_rindex, pp_aslice, pp_lslice, pp_splice
-sub pp_sort { $curcop->write_back; default_pp(@_) }
-sub pp_caller { $curcop->write_back; default_pp(@_) }
-sub pp_reset { $curcop->write_back; default_pp(@_) }
+#sub pp_sort { $curcop->write_back; default_pp(@_) }
+#sub pp_caller { $curcop->write_back; default_pp(@_) }
+#sub pp_reset { $curcop->write_back; default_pp(@_) }
 
 sub pp_gv {
     my $op = shift;
@@ -1278,6 +1281,9 @@ sub pp_substcont {
 sub default_pp {
     my $op = shift;
     my $ppname = $op->ppaddr;
+    if ($curcop and $need_curcop{$ppname}){
+       $curcop->write_back;
+    }
     write_back_lexicals() unless $skip_lexicals{$ppname};
     write_back_stack() unless $skip_stack{$ppname};
     doop($op);