develooper Front page | perl.perl5.porters | Postings from June 2008

Re: [perl #55668] 'eval'ing a certain format string segfaults perl

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
June 28, 2008 03:42
Subject:
Re: [perl #55668] 'eval'ing a certain format string segfaults perl
Message ID:
20080628104205.GT94237@plum.flirble.org
On Thu, Jun 12, 2008 at 08:03:56PM +0300, Alexandr Ciornii wrote:
> This program does not segfault on 5.10.0 (Strawberry Perl on Win32)
> and segfaults on 5.8.8 (ActiveState and Vanilla).
> On 5.10.0 error is "Runaway format at (eval 1) line 5.".

It still seems to be a real bug. On blead, with all the assertions enabled:

(gdb) r
Starting program: /Volumes/Stuff/p4perl/perl/perl -Ilib /Users/nick/p4perl/perl/55668
Reading symbols for shared libraries +++. done
Options:
format STDOUT =
  ^<<<<<<<<<<<
\$oSpec
               ^*  ~~
\$oDesc
.
Assertion failed: (SvTYPE(sv) >= SVt_PV), function Perl_pp_formline, file pp_ctl.c, line 801.

Program received signal SIGABRT, Aborted.
0x00007fff81917dd6 in __kill ()
(gdb) up
#1  0x00007fff81990c99 in abort ()
(gdb) up
#2  0x00007fff81983bdd in __assert_rtn ()
(gdb) up
#3  0x000000010024dd62 in Perl_pp_formline (my_perl=0x100800000) at pp_ctl.c:801
warning: Source file is more recent than executable.
801                             SvCUR_set(sv, chophere - item);
(gdb) call Perl_sv_dump(my_perl, sv)
SV = IV(0x100823dc0) at 0x100823dc8
  REFCNT = 1
  FLAGS = (TEMP,ROK)
  RV = 0x1008170e8
    SV = PV(0x100802040) at 0x1008170e8
      REFCNT = 4
      FLAGS = (PADMY,POK,pPOK)
      PV = 0x100511288 "print this help message"\0
      CUR = 23
      LEN = 24
(gdb) p chophere
$1 = 0x100511cf2 ""
(gdb) p item
$2 = 0x100511cdf "SCALAR(0x1008170e8)"
(gdb) p itemsize
$3 = 19


So it seems that the format code is assuming that it can set the length of
something that is not really a string, and coming unstuck. I'm not familiar
with the code, but it looks like the logic here with "oneline" could be
improved:

	case FF_LINESNGL:
	    chopspace = 0;
	    oneline = TRUE;
	    goto ff_line;
	case FF_LINEGLOB:
	    oneline = FALSE;
	ff_line:
	    {
		const char *s = item = SvPV_const(sv, len);
		itemsize = len;
		if ((item_is_utf8 = DO_UTF8(sv)))
		    itemsize = sv_len_utf8(sv);
		if (itemsize) {
		    bool chopped = FALSE;
		    const char *const send = s + len;
		    gotsome = TRUE;
		    chophere = s + itemsize;
		    while (s < send) {
			if (*s++ == '\n') {
			    if (oneline) {
				chopped = TRUE;
				chophere = s;
				break;
			    } else {
				if (s == send) {
				    itemsize--;
				    chopped = TRUE;
				} else
				    lines++;
			    }
			}
		    }
		    SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget));
		    if (targ_is_utf8)
			SvUTF8_on(PL_formtarget);
		    if (oneline) {
			SvCUR_set(sv, chophere - item);
			sv_catsv(PL_formtarget, sv);
			SvCUR_set(sv, itemsize);
		    } else
			sv_catsv(PL_formtarget, sv);
		    if (chopped)
			SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) - 1);
		    SvGROW(PL_formtarget, SvCUR(PL_formtarget) + fudge + 1);
		    t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget);
		    if (item_is_utf8)
			targ_is_utf8 = TRUE;
		}
		break;
	    }

specifically to avoid entering this if unless a '\n' was found:

		    if (oneline) {
			SvCUR_set(sv, chophere - item);
			sv_catsv(PL_formtarget, sv);
			SvCUR_set(sv, itemsize);
		    } else


Nicholas Clark

Thread Previous | 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