mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 08:38:23 +00:00
parser debugging output: strip token name prefixes
Some of the names of parser (perly.y) tokens have a common prefix, such
as
PERLY_SEMICOLON
PERLY_AMPERSAND
KW_PACKAGE
KW_CLASS
Perl's -Dpv switch produces debugging output that also displays the top
few items on the parse stack. The token names are truncated for
compactness' sake. This currently leads to a display where its mostly
just the token name's prefix that is displayed, e.g.
$ perl -Dpv -e'package Foo'
...
index: 1 2 3 4 5 6 7 8
state: 1 9 17 149 91 263 412 503
token: GRAMPROG @1 remember stmtseq KW_PACKA BAREWORD BAREWORD PERLY_SE
value: 0 0 63 (Nullop) 0 (Nullop) const 735909768
After this commit, PERLY_, KW_ etc prefixes are stripped, allowing more
of the actual token name is displayed:
index: 1 2 3 4 5 6 7 8
state: 1 9 17 149 91 263 412 503
token: GRAMPROG @1 remember stmtseq PACKAGE BAREWORD BAREWORD SEMICOLO
value: 0 0 63 (Nullop) 0 (Nullop) const 227539304
This commit is contained in:
parent
7bcccf4b49
commit
f49cfe1d0f
26
perly.c
26
perly.c
@ -128,6 +128,15 @@ yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyva
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* common prefixes of token names to strip when displaying in compact form
|
||||||
|
*/
|
||||||
|
static const char *name_prefixes[] = {
|
||||||
|
"PERLY_",
|
||||||
|
"KW_",
|
||||||
|
"bare_statement_",
|
||||||
|
NULL,
|
||||||
|
};
|
||||||
|
|
||||||
/* yy_stack_print()
|
/* yy_stack_print()
|
||||||
* print the top 8 items on the parse stack.
|
* print the top 8 items on the parse stack.
|
||||||
*/
|
*/
|
||||||
@ -150,8 +159,21 @@ yy_stack_print (pTHX_ const yy_parser *parser)
|
|||||||
PerlIO_printf(Perl_debug_log, " %8d", ps->state);
|
PerlIO_printf(Perl_debug_log, " %8d", ps->state);
|
||||||
|
|
||||||
PerlIO_printf(Perl_debug_log, "\ntoken:");
|
PerlIO_printf(Perl_debug_log, "\ntoken:");
|
||||||
for (ps = min; ps <= parser->ps; ps++)
|
for (ps = min; ps <= parser->ps; ps++) {
|
||||||
PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
|
const char *name = ps->name;
|
||||||
|
const char **p = name_prefixes;
|
||||||
|
/* strip some common prefixes off the name to better display
|
||||||
|
* truncated names */
|
||||||
|
for (; *p; p++) {
|
||||||
|
const char *prefix = *p;
|
||||||
|
STRLEN l = strlen(prefix);
|
||||||
|
if (strnEQ(name, prefix, l)) {
|
||||||
|
name += l;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
PerlIO_printf(Perl_debug_log, " %8.8s", name);
|
||||||
|
}
|
||||||
|
|
||||||
PerlIO_printf(Perl_debug_log, "\nvalue:");
|
PerlIO_printf(Perl_debug_log, "\nvalue:");
|
||||||
for (ps = min; ps <= parser->ps; ps++) {
|
for (ps = min; ps <= parser->ps; ps++) {
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user