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

13 files changed, 59 insertions, 7 deletions

diff --git a/dump.c b/dump.c
index f506de8492..328ce8d458 100644
--- 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 c90f50dced..7d229baec8 100644
--- 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 07212d3f96..62ad464070 100644
--- 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 ac91b780ec..ac6abc7e54 100644
--- 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 8134c177a5..abd3b0c9fd 100644
--- 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 e284d4b2f3..21df282994 100644
--- 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 629eef45f1..da4a8fe39e 100644
--- 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 8f480d6ee0..4804554c7e 100755
--- 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 fb078f3ce9..a7934fb8a0 100755
--- 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 a67838898d..00e4b4e6d2 100644
--- 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 81a4f5699f..30b44064ef 100644
--- 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 efac700dd8..300637c129 100644
--- 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 8281bf0e77..926c7f38d0 100755
--- 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.