applied suggested patch for tracking line numbers correctly in

optimized blocks with a single statement; changed setcop to
setstate and added code for -Dx dumps
	Message-Id: <199906231627.RAA24033@crypt.compulink.co.uk>
	Subject: [PATCH 5.005_57] Line number error in optimised else()

p4raw-id: //depot/perl@3728

diff --git a/dump.c b/dump.c
index f506de8..328ce8d 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -391,7 +391,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     else
        PerlIO_printf(file, "DONE\n");
     if (o->op_targ) {
-       if (o->op_type == OP_NULL)
+       if (o->op_type == OP_NULL || o->op_type == OP_SETSTATE)
            Perl_dump_indent(aTHX_ level, file, "  (was %s)\n", PL_op_name[o->op_targ]);
        else
            Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ);
@@ -524,6 +524,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
     case OP_CONST:
        Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv));
        break;
+    case OP_SETSTATE:
     case OP_NEXTSTATE:
     case OP_DBSTATE:
        if (cCOPo->cop_line)

diff --git a/embed.h b/embed.h
index c90f50d..7d229ba 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1274,6 +1274,7 @@
 #define pp_seq                 Perl_pp_seq
 #define pp_setpgrp             Perl_pp_setpgrp
 #define pp_setpriority         Perl_pp_setpriority
+#define pp_setstate            Perl_pp_setstate
 #define pp_sge                 Perl_pp_sge
 #define pp_sgrent              Perl_pp_sgrent
 #define pp_sgt                 Perl_pp_sgt
@@ -2584,6 +2585,7 @@
 #define pp_seq()               Perl_pp_seq(aTHX)
 #define pp_setpgrp()           Perl_pp_setpgrp(aTHX)
 #define pp_setpriority()       Perl_pp_setpriority(aTHX)
+#define pp_setstate()          Perl_pp_setstate(aTHX)
 #define pp_sge()               Perl_pp_sge(aTHX)
 #define pp_sgrent()            Perl_pp_sgrent(aTHX)
 #define pp_sgt()               Perl_pp_sgt(aTHX)
@@ -5081,6 +5083,8 @@
 #define pp_setpgrp             Perl_pp_setpgrp
 #define Perl_pp_setpriority    CPerlObj::Perl_pp_setpriority
 #define pp_setpriority         Perl_pp_setpriority
+#define Perl_pp_setstate       CPerlObj::Perl_pp_setstate
+#define pp_setstate            Perl_pp_setstate
 #define Perl_pp_sge            CPerlObj::Perl_pp_sge
 #define pp_sge                 Perl_pp_sge
 #define Perl_pp_sgrent         CPerlObj::Perl_pp_sgrent

diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 07212d3..62ad464 100644 (file)
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -11,8 +11,8 @@
 #  define dTHR int dummy_thr
 #endif /* dTHR */ 
 
-/*#define DBG_SUB 1     /* */
-/*#define DBG_TIMER 1   /* */
+/*#define DBG_SUB 1      */
+/*#define DBG_TIMER 1    */
 
 #ifdef DBG_SUB
 #  define DBG_SUB_NOTIFY(A,B) warn( A, B )

diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index ac91b78..ac6abc7 100644 (file)
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -332,7 +332,7 @@ invert_opset function.
 
     cond_expr flip flop andassign orassign and or xor
 
-    warn die lineseq nextstate scope enter leave
+    warn die lineseq nextstate scope enter leave setstate
 
     rv2cv anoncode prototype
 

diff --git a/objXSUB.h b/objXSUB.h
index 8134c17..abd3b0c 100644 (file)
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -4782,6 +4782,10 @@
 #define Perl_pp_setpriority    pPerl->Perl_pp_setpriority
 #undef  pp_setpriority
 #define pp_setpriority         Perl_pp_setpriority
+#undef  Perl_pp_setstate
+#define Perl_pp_setstate       pPerl->Perl_pp_setstate
+#undef  pp_setstate
+#define pp_setstate            Perl_pp_setstate
 #undef  Perl_pp_sge
 #define Perl_pp_sge            pPerl->Perl_pp_sge
 #undef  pp_sge

diff --git a/op.c b/op.c
index e284d4b..21df282 100644 (file)
--- a/op.c
+++ b/op.c
@@ -685,6 +685,9 @@ Perl_op_free(pTHX_ OP *o)
     case OP_AELEMFAST:
        SvREFCNT_dec(cGVOPo->op_gv);
        break;
+    case OP_SETSTATE:
+       o->op_targ = 0; /* Was holding old type. */
+       /* FALL THROUGH */
     case OP_NEXTSTATE:
     case OP_DBSTATE:
        cop_free((COP*)o);
@@ -739,6 +742,8 @@ S_cop_free(pTHX_ COP* cop)
 STATIC void
 S_null(pTHX_ OP *o)
 {
+    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE)
+       cop_free((COP*)o);
     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
        pad_free(o->op_targ);
     o->op_targ = o->op_type;
@@ -1685,8 +1690,11 @@ Perl_scope(pTHX_ OP *o)
                o->op_ppaddr = PL_ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
                if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
-                   cop_free((COP*)kid);
-                   null(kid);
+                   if (kid->op_targ > 0)
+                       pad_free(kid->op_targ);
+                   kid->op_targ = kid->op_type;
+                   kid->op_type = OP_SETSTATE;
+                   kid->op_ppaddr = PL_ppaddr[OP_SETSTATE];
                }
            }
            else

diff --git a/opcode.h b/opcode.h
index 629eef4..da4a8fe 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -357,10 +357,11 @@ typedef enum {
        OP_SYSCALL,     /* 345 */
        OP_LOCK,        /* 346 */
        OP_THREADSV,    /* 347 */
+       OP_SETSTATE,    /* 348 */
        OP_max          
 } opcode;
 
-#define MAXO 348
+#define MAXO 349
 
 
 START_EXTERN_C
@@ -717,6 +718,7 @@ EXT char *PL_op_name[] = {
        "syscall",
        "lock",
        "threadsv",
+       "setstate",
 };
 #endif
 
@@ -1072,6 +1074,7 @@ EXT char *PL_op_desc[] = {
        "syscall",
        "lock",
        "per-thread variable",
+       "set statement info",
 };
 #endif
 
@@ -1432,6 +1435,7 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
        Perl_pp_syscall,
        Perl_pp_lock,
        Perl_pp_threadsv,
+       Perl_pp_setstate,
 };
 #endif
 
@@ -1787,6 +1791,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
        Perl_ck_fun,    /* syscall */
        Perl_ck_rfun,   /* lock */
        Perl_ck_null,   /* threadsv */
+       Perl_ck_null,   /* setstate */
 };
 #endif
 
@@ -2142,6 +2147,7 @@ EXT U32 PL_opargs[] = {
        0x0004281d,     /* syscall */
        0x00003604,     /* lock */
        0x00000044,     /* threadsv */
+       0x00000000,     /* setstate */
 };
 #endif
 

diff --git a/opcode.pl b/opcode.pl
index 8f480d6..4804554 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -301,6 +301,8 @@ sub tab {
 
 __END__
 
+# New ops always go at the very end
+
 # Nothing.
 
 null           null operation          ck_null         0       
@@ -559,6 +561,7 @@ redo                redo                    ck_null         ds}
 dump           dump                    ck_null         ds}     
 goto           goto                    ck_null         ds}     
 exit           exit                    ck_fun          ds%     S?
+# continued below
 
 #nswitch               numeric switch          ck_null         d       
 #cswitch               character switch        ck_null         d       
@@ -775,3 +778,6 @@ syscall             syscall                 ck_fun          imst@   S L
 # For multi-threading
 lock           lock                    ck_rfun         s%      S
 threadsv       per-thread variable     ck_null         ds0
+
+# Control (contd.)
+setstate       set statement info      ck_null         0

diff --git a/perlapi.c b/perlapi.c
index fb078f3..a7934fb 100755 (executable)
--- a/perlapi.c
+++ b/perlapi.c
@@ -6981,6 +6981,13 @@ Perl_pp_setpriority(pTHXo)
     return ((CPerlObj*)pPerl)->Perl_pp_setpriority();
 }
 
+#undef  Perl_pp_setstate
+OP *
+Perl_pp_setstate(pTHXo)
+{
+    return ((CPerlObj*)pPerl)->Perl_pp_setstate();
+}
+
 #undef  Perl_pp_sge
 OP *
 Perl_pp_sge(pTHXo)

diff --git a/pp.sym b/pp.sym
index a678388..00e4b4e 100644 (file)
--- a/pp.sym
+++ b/pp.sym
@@ -382,3 +382,4 @@ Perl_pp_getlogin
 Perl_pp_syscall
 Perl_pp_lock
 Perl_pp_threadsv
+Perl_pp_setstate

diff --git a/pp_hot.c b/pp_hot.c
index 81a4f56..30b4406 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -69,6 +69,12 @@ PP(pp_null)
     return NORMAL;
 }
 
+PP(pp_setstate)
+{
+    PL_curcop = (COP*)PL_op;
+    return NORMAL;
+}
+
 PP(pp_pushmark)
 {
     PUSHMARK(PL_stack_sp);

diff --git a/pp_proto.h b/pp_proto.h
index efac700..300637c 100644 (file)
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -383,3 +383,4 @@ PERL_PPDEF(Perl_pp_getlogin)
 PERL_PPDEF(Perl_pp_syscall)
 PERL_PPDEF(Perl_pp_lock)
 PERL_PPDEF(Perl_pp_threadsv)
+PERL_PPDEF(Perl_pp_setstate)

diff --git a/t/op/misc.t b/t/op/misc.t
index 8281bf0..926c7f3 100755 (executable)
--- a/t/op/misc.t
+++ b/t/op/misc.t
@@ -497,3 +497,11 @@ END { print $foo }
 ';
 EXPECT
 ZZZ
+########
+-w
+if (@ARGV) { print "" }
+else {
+  if ($x == 0) { print "" } else { print $x }
+}
+EXPECT
+Use of uninitialized value at - line 4.