develooper Front page | perl.perl5.porters | Postings from November 2000

[PATCH] Tokeniser debugging

Thread Next
From:
Simon Cozens
Date:
November 29, 2000 06:15
Subject:
[PATCH] Tokeniser debugging
Message ID:
20001129141545.A30864@pembro33.pmb.ox.ac.uk
There isn't very much in the way of debugging code in toke.c, so if people
think it's a good idea, I'm planning on adding some; I believe it'll be
especially useful for the Perl6 people since more and more people need to
understand how Perl gets tokenised and parsed. Anyway, here's the
infrastructure and a couple of debugging breadcrumbs:


--- pod/perlrun.pod~	Wed Nov 29 13:29:18 2000
+++ pod/perlrun.pod	Wed Nov 29 13:30:32 2000
@@ -322,6 +322,7 @@
     16384  X  Scratchpad allocation
     32768  D  Cleaning up
     65536  S  Thread synchronization
+   131072  T  Tokenising
 
 All these flags require B<-DDEBUGGING> when you compile the Perl
 executable.  See the F<INSTALL> file in the Perl source distribution 
--- perl.c~	Wed Nov 29 13:27:01 2000
+++ perl.c	Wed Nov 29 13:27:21 2000
@@ -2106,7 +2106,7 @@
 #ifdef DEBUGGING
 	forbid_setid("-D");
 	if (isALPHA(s[1])) {
-	    static char debopts[] = "psltocPmfrxuLHXDS";
+	    static char debopts[] = "psltocPmfrxuLHXDST";
 	    char *d;
 
 	    for (s++; *s && (d = strchr(debopts,*s)); s++)
--- perl.h~	Wed Nov 29 13:33:03 2000
+++ perl.h	Wed Nov 29 13:32:47 2000
@@ -2149,6 +2149,7 @@
 #  else
 #    define DEBUG_S(a)
 #  endif
+#define DEBUG_T(a) if (PL_debug & (1<<17))	a
 #else
 #define DEB(a)
 #define DEBUG(a)
@@ -2169,6 +2170,7 @@
 #define DEBUG_X(a)
 #define DEBUG_D(a)
 #define DEBUG_S(a)
+#define DEBUG_T(a)
 #endif
 #define YYMAXDEPTH 300
 
--- toke.c~	Wed Nov 29 13:36:16 2000
+++ toke.c	Wed Nov 29 14:05:28 2000
@@ -2115,6 +2115,9 @@
 	char pit = PL_pending_ident;
 	PL_pending_ident = 0;
 
+	DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Tokener saw identifier '%s'\n", PL_tokenbuf); })
+
 	/* if we're in a my(), we can't allow dynamics here.
 	   $foo'bar has already been turned into $foo::bar, so
 	   just check for colons.
@@ -2252,6 +2255,10 @@
 	    PL_expect = PL_lex_expect;
 	    PL_lex_defer = LEX_NORMAL;
 	}
+	DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Next token after '%s' was known, type %i\n", PL_bufptr,
+              PL_nexttype[PL_nexttoke]); })
+
 	return(PL_nexttype[PL_nexttoke]);
 
     /* interpolated case modifiers like \L \U, including \Q and \E.
@@ -2283,6 +2290,8 @@
 	    return yylex();
 	}
 	else {
+	    DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Saw case modifier at '%s'\n", PL_bufptr); })
 	    s = PL_bufptr + 1;
 	    if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
 		tmp = *s, *s = s[2], s[2] = tmp;	/* misordered... */
@@ -2333,6 +2342,8 @@
     case LEX_INTERPSTART:
 	if (PL_bufptr == PL_bufend)
 	    return sublex_done();
+	DEBUG_T({ PerlIO_printf(Perl_debug_log,
+              "### Interpolated variable at '%s'\n", PL_bufptr); })
 	PL_expect = XTERM;
 	PL_lex_dojoin = (*PL_bufptr == '@');
 	PL_lex_state = LEX_INTERPNORMAL;
@@ -2429,7 +2440,7 @@
     s = PL_bufptr;
     PL_oldoldbufptr = PL_oldbufptr;
     PL_oldbufptr = s;
-    DEBUG_p( {
+    DEBUG_T( {
 	PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
 		      exp_name[PL_expect], s);
     } )
@@ -2449,6 +2460,9 @@
 	    PL_last_lop = 0;
 	    if (PL_lex_brackets)
 		yyerror("Missing right curly or square bracket");
+            DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                        "### Tokener got EOF\n");
+            } )
 	    TOKEN(0);
 	}
 	if (s++ < PL_bufend)
@@ -2797,10 +2811,16 @@
 
 	    if (strnEQ(s,"=>",2)) {
 		s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
+                DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                            "### Saw unary minus before =>, forcing word '%s'\n", s);
+                } )
 		OPERATOR('-');		/* unary minus */
 	    }
 	    PL_last_uni = PL_oldbufptr;
 	    PL_last_lop_op = OP_FTEREAD;	/* good enough */
+            DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                        "### Saw file test %c\n", (int)tmp);
+            } )
 	    switch (tmp) {
 	    case 'r': FTST(OP_FTEREAD);
 	    case 'w': FTST(OP_FTEWRITE);
@@ -3576,12 +3596,18 @@
     case '0': case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9':
 	s = scan_num(s, &yylval);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                    "### Saw number in '%s'\n", s);
+        } )
 	if (PL_expect == XOPERATOR)
 	    no_op("Number",s);
 	TERM(THING);
 
     case '\'':
 	s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                    "### Saw string in '%s'\n", s);
+        } )
 	if (PL_expect == XOPERATOR) {
 	    if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
 		PL_expect = XTERM;
@@ -3598,6 +3624,9 @@
 
     case '"':
 	s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                    "### Saw string in '%s'\n", s);
+        } )
 	if (PL_expect == XOPERATOR) {
 	    if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
 		PL_expect = XTERM;
@@ -3620,6 +3649,9 @@
 
     case '`':
 	s = scan_str(s,FALSE,FALSE);
+        DEBUG_T( { PerlIO_printf(Perl_debug_log, 
+                    "### Saw backtick string in '%s'\n", s);
+        } )
 	if (PL_expect == XOPERATOR)
 	    no_op("Backticks",s);
 	if (!s)

-- 
Rule 3: If the character is comprised of a container without another radical, 
then Rule 3 will not apply.

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About