From: Gerard Goossen <gerard@tty.nl>
Date: Thu, 17 Jan 2008 18:36:52 +0000 (+0100)
Subject: also report forced tokens when using -DT
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=704d42154dde262d860a2d38dee033b3ee03f906;p=p5sagit%2Fp5-mst-13.2.git

also report forced tokens when using -DT
Message-ID: <20080117173652.GB4969@ostwald>

p4raw-id: //depot/perl@33089
---

diff --git a/embed.fnc b/embed.fnc
index 5dbf474..45bf8ec 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1584,7 +1584,7 @@ s	|I32	|cr_textfilter	|int idx|NULLOK SV *sv|int maxlen
 s	|void	|strip_return	|NN SV *sv
 #  endif
 #  if defined(DEBUGGING)
-s	|int	|tokereport	|I32 rv
+s	|int	|tokereport	|I32 rv|NN const YYSTYPE* lvalp
 s	|void	|printbuf	|NN const char* fmt|NN const char* s
 #  endif
 #endif
diff --git a/embed.h b/embed.h
index 8d2d11e..8d4b365 100644
--- a/embed.h
+++ b/embed.h
@@ -3878,7 +3878,7 @@
 #  endif
 #  if defined(DEBUGGING)
 #ifdef PERL_CORE
-#define tokereport(a)		S_tokereport(aTHX_ a)
+#define tokereport(a,b)		S_tokereport(aTHX_ a,b)
 #define printbuf(a,b)		S_printbuf(aTHX_ a,b)
 #endif
 #  endif
diff --git a/proto.h b/proto.h
index 95e67f1..79a369b 100644
--- a/proto.h
+++ b/proto.h
@@ -4168,7 +4168,9 @@ STATIC void	S_strip_return(pTHX_ SV *sv)
 
 #  endif
 #  if defined(DEBUGGING)
-STATIC int	S_tokereport(pTHX_ I32 rv);
+STATIC int	S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
+			__attribute__nonnull__(pTHX_2);
+
 STATIC void	S_printbuf(pTHX_ const char* fmt, const char* s)
 			__attribute__nonnull__(pTHX_1)
 			__attribute__nonnull__(pTHX_2);
diff --git a/toke.c b/toke.c
index 32ef3e5..afcc1dd 100644
--- a/toke.c
+++ b/toke.c
@@ -227,7 +227,7 @@ static const char* const lex_state_names[] = {
  */
 
 #ifdef DEBUGGING /* Serve -DT. */
-#   define REPORT(retval) tokereport((I32)retval)
+#   define REPORT(retval) tokereport((I32)retval, &pl_yylval)
 #else
 #   define REPORT(retval) (retval)
 #endif
@@ -374,7 +374,7 @@ static struct debug_tokens {
 /* dump the returned token in rv, plus any optional arg in pl_yylval */
 
 STATIC int
-S_tokereport(pTHX_ I32 rv)
+S_tokereport(pTHX_ I32 rv, const YYSTYPE* lvalp)
 {
     dVAR;
     if (DEBUG_T_TEST) {
@@ -403,22 +403,22 @@ S_tokereport(pTHX_ I32 rv)
 	case TOKENTYPE_GVVAL: /* doesn't appear to be used */
 	    break;
 	case TOKENTYPE_IVAL:
-	    Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)pl_yylval.ival);
+	    Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", (IV)lvalp->ival);
 	    break;
 	case TOKENTYPE_OPNUM:
 	    Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
-				    PL_op_name[pl_yylval.ival]);
+				    PL_op_name[lvalp->ival]);
 	    break;
 	case TOKENTYPE_PVAL:
-	    Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", pl_yylval.pval);
+	    Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", lvalp->pval);
 	    break;
 	case TOKENTYPE_OPVAL:
-	    if (pl_yylval.opval) {
+	    if (lvalp->opval) {
 		Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
-				    PL_op_name[pl_yylval.opval->op_type]);
-		if (pl_yylval.opval->op_type == OP_CONST) {
+				    PL_op_name[lvalp->opval->op_type]);
+		if (lvalp->opval->op_type == OP_CONST) {
 		    Perl_sv_catpvf(aTHX_ report, " %s",
-			SvPEEK(cSVOPx_sv(pl_yylval.opval)));
+			SvPEEK(cSVOPx_sv(lvalp->opval)));
 		}
 
 	    }
@@ -1321,6 +1321,12 @@ STATIC void
 S_force_next(pTHX_ I32 type)
 {
     dVAR;
+#ifdef DEBUGGING
+    if (DEBUG_T_TEST) {
+        PerlIO_printf(Perl_debug_log, "### forced token:\n");
+	tokereport(THING, &NEXTVAL_NEXTTOKE);
+    }
+#endif
 #ifdef PERL_MAD
     if (PL_curforce < 0)
 	start_force(PL_lasttoke);