develooper Front page | perl.perl5.porters | Postings from January 2004

Re: [perl #24774] eval + format - \n = pp_ctl.c assertion

Thread Next
From:
LAUN Wolfgang
Date:
January 2, 2004 02:32
Subject:
Re: [perl #24774] eval + format - \n = pp_ctl.c assertion
Message ID:
DF27CDCBD2581D4B88431901094E4B4D02B0C4B3@attmsx1
On Tue, 30 Dec 2003 15:30:37 +0000 davem@fdisolutions.com wrote:
> On Tue, Dec 30, 2003 at 01:26:59AM -0000, rob@exitexchange.com (via RT) wrote:
> > created a format with eval, that does NOT include a trailing \n,
> > gives the following error when write() is called:
> > 
> > Assertion fpc <= fops + maxops failed: file "pp_ctl.c", line 3731 at (eval 1) line 5.
> 
> Ah, mea cupla!
> 
> Fixed by patch #22005
> (Nick, this is a good candidate for 5.8.3)

Festina lente ;-)

Yes, it fixes the assertion failure and all that may come from an
insufficient allocation. But note that the eval does not return an 
error, so the format can be run. Observe:

  bash$ cat fmtbug.pl
  my @v = ('k');
  eval "format STDOUT = \n@\n\@v";
  print "eval error = [[$@]]\n";
  write;
  bash$ ./perl fmtbug.pl
  eval error = [[]]
  k
  ;bash$ # Arrgh!

The lone semicolon is sneaked into the string to be eval'ed, and no check
for the closing "\n.\n" catches (as is done when parsing from a file, including
a require/do). In short: eval must not accept a format that is not explicitly
terminated.

A patch against toke.c (5.8.2) appears to fix this:

  bash$ ./perl fmtbug.pl
  eval error = [[Format not terminated at (eval 1) line 5, at end of line
  syntax error at (eval 1) line 5, at EOF
  ]]
  Undefined format "STDOUT" called at ../fmtbug.pl line 7.

This breaks the new test 14 in t/op/write.t, so this is patched again.

Finally I'd like to draw your attention to the fact that some NULL
character *embedded* in the eval'ed string terminates format parsing
prematurely (possibly because strchr is used in toke.c in scan_formline),
resulting in an error ("Missing right curly or square bracket"). Any 
need to fix this, accepting embedded NULLs?

Regards
Wolfgang

--- toke.c.old	Fri Jan  2 08:50:37 2004
+++ toke.c	Fri Jan  2 10:11:31 2004
@@ -2424,8 +2424,12 @@
 	if (!PL_rsfp) {
 	    PL_last_uni = 0;
 	    PL_last_lop = 0;
-	    if (PL_lex_brackets)
-		yyerror("Missing right curly or square bracket");
+	    if (PL_lex_brackets) {
+ 	        if (PL_lex_formbrack)
+		    yyerror("Format not terminated");
+                else
+		    yyerror("Missing right curly or square bracket");
+	    }
             DEBUG_T( { PerlIO_printf(Perl_debug_log,
                         "### Tokener got EOF\n");
             } );
@@ -7577,6 +7581,7 @@
     register char *t;
     SV *stuff = newSVpvn("",0);
     bool needargs = FALSE;
+    bool eofmt = FALSE;
 
     while (!needargs) {
 	if (*s == '.' || *s == /*{*/'}') {
@@ -7586,8 +7591,10 @@
 #else
 	    for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
 #endif
-	    if (*t == '\n' || t == PL_bufend)
+	    if (*t == '\n' || t == PL_bufend) {
+	        eofmt = TRUE;
 		break;
+            }
 	}
 	if (PL_in_eval && !PL_rsfp) {
 	    eol = strchr(s,'\n');
@@ -7627,7 +7634,6 @@
 	    PL_last_lop = PL_last_uni = Nullch;
 	    if (!s) {
 		s = PL_bufptr;
-		yyerror("Format not terminated");
 		break;
 	    }
 	}
@@ -7656,7 +7662,8 @@
     }
     else {
 	SvREFCNT_dec(stuff);
-	PL_lex_formbrack = 0;
+	if (eofmt)
+	    PL_lex_formbrack = 0;
 	PL_bufptr = s;
     }
     return s;
--- t/op/write.t.old	Fri Jan  2 11:11:28 2004
+++ t/op/write.t	Fri Jan  2 10:53:50 2004
@@ -302,12 +302,10 @@
 
 {
     # Bug #24774 format without trailing \n failed assertion
+    # but this must not compile because we'd get a ';' into the format
     my @v = ('k');
     eval "format OUT14 = \n@\n\@v";
-    open(OUT14, '&gt;Op_write.tmp') || die "Can't create Op_write.tmp";
-    write(OUT14);
-    close OUT14 or die "Could not close: $!";
-    print "ok 14\n";
+    print $@ ? "ok 14\n" : "not ok 14\n";
 }
 
 #######################################

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