mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

parser debugging output: strip token name prefixes

Browse Source 
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:
David Mitchell 2025-11-04 15:13:01 +00:00
parent 7bcccf4b49
commit f49cfe1d0f
1 changed files with 24 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
perly.c
View File

@ -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()
* 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, "\ntoken:");
for (ps = min; ps <= parser->ps; ps++)
PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
for (ps = min; ps <= parser->ps; ps++) {
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:");
for (ps = min; ps <= parser->ps; ps++) {