Change 33089 by [EMAIL PROTECTED] on 2008/01/28 13:32:40
Subject: [PATCH] also report forced tokens when using -DT
From: Gerard Goossen <[EMAIL PROTECTED]>
Date: Thu, 17 Jan 2008 18:36:52 +0100
Message-ID: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/embed.fnc#564 edit
... //depot/perl/embed.h#747 edit
... //depot/perl/proto.h#898 edit
... //depot/perl/toke.c#814 edit
Differences ...
==== //depot/perl/embed.fnc#564 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#563~33083~ 2008-01-28 02:02:24.000000000 -0800
+++ perl/embed.fnc 2008-01-28 05:32:40.000000000 -0800
@@ -1584,7 +1584,7 @@
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
==== //depot/perl/embed.h#747 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#746~33080~ 2008-01-26 09:54:29.000000000 -0800
+++ perl/embed.h 2008-01-28 05:32:40.000000000 -0800
@@ -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
==== //depot/perl/proto.h#898 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#897~33083~ 2008-01-28 02:02:24.000000000 -0800
+++ perl/proto.h 2008-01-28 05:32:40.000000000 -0800
@@ -4168,7 +4168,9 @@
# 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);
==== //depot/perl/toke.c#814 (text) ====
Index: perl/toke.c
--- perl/toke.c#813~32954~ 2008-01-11 05:55:07.000000000 -0800
+++ perl/toke.c 2008-01-28 05:32:40.000000000 -0800
@@ -227,7 +227,7 @@
*/
#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 @@
/* 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 @@
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 @@
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);
End of Patch.
