From patchwork Mon Feb 22 21:45:09 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Jerry DeLisle X-Patchwork-Id: 586565 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id F2B521409B7 for ; Tue, 23 Feb 2016 08:45:25 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=vvoRiOzn; dkim-atps=neutral DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=nrs+dUg705Y/AIUE62Jh6NDoUhYfaq9psWMJTAm5YHFIWwb/5A B/vG76RVMTia2WShFI6T6PLop8Clsn8FXM0f7+xB5Kd1EUMoLMgL9eAdkrBhCglA fOhqNuPbkJ/FdlXG8bAsUUBF5t0QqGOOwnjid//+G5bgBm6oFeMPdWxPE= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to:cc :from:subject:message-id:date:mime-version:content-type; s= default; bh=DBDQLxTTcXoDVhrBDnpFfHlf4EM=; b=vvoRiOznXOi4gG1l80K5 h2FZvuM7EtNTUbgYVW9fqtDiU6FC7wa3XFytK5IHo00ogD6RT5XyuD0KaJxbb+/M YkqxRkfpD7gZ/LNx0zjCbXszUJkHOP1f3RVZhoGXDBpJx59nTD9qptMjzhCui7s3 /9rbZ+MzdqKO4b5KxTKf8dE= Received: (qmail 119950 invoked by alias); 22 Feb 2016 21:45:15 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 119828 invoked by uid 89); 22 Feb 2016 21:45:15 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, RP_MATCHES_RCVD, SPF_PASS autolearn=ham version=3.3.2 spammy=exp2, nl, HX-Envelope-From:sk:jvdelis, jvdelislegccgnuorg X-Spam-User: qpsmtpd, 2 recipients X-HELO: mtaout001-public.msg.strl.va.charter.net Received: from mtaout001-public.msg.strl.va.charter.net (HELO mtaout001-public.msg.strl.va.charter.net) (68.114.190.26) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 22 Feb 2016 21:45:13 +0000 Received: from impout006 ([68.114.189.21]) by mtaout001.msg.strl.va.charter.net (InterMail vM.9.00.021.00 201-2473-182) with ESMTP id <20160222214511.HUIE11980.mtaout001.msg.strl.va.charter.net@impout006>; Mon, 22 Feb 2016 15:45:11 -0600 Received: from quattro.localdomain ([96.41.215.23]) by impout006 with charter.net id MZlA1s0020Wrkg001ZlAc8; Mon, 22 Feb 2016 15:45:11 -0600 X-Authority-Analysis: v=2.1 cv=WaaCaiRX c=1 sm=1 tr=0 a=salB9WdMPIDduBH7JsZfrA==:117 a=salB9WdMPIDduBH7JsZfrA==:17 a=L9H7d07YOLsA:10 a=9cW_t1CCXrUA:10 a=s5jvgZ67dGcA:10 a=r77TgQKjGQsHNAKrUKIA:9 a=mDV3o1hIAAAA:8 a=rBIv8bP2Z98H8kuvBpcA:9 a=JTqCU1xBH9CbCIKV:21 a=WycEtMjvVNkfjCFo:21 a=QEXdDO2ut3YA:10 a=l_bWQaNckqbzurdoZEcA:9 a=6saLGen4GTsM9g1y:21 a=_c0R_nZ5dBU_SLEp:21 X-Auth-id: anZkZWxpc2xlQGNoYXJ0ZXIubmV0 To: gfortran Cc: gcc patches From: Jerry DeLisle Subject: [patch, libgfortran] PR69456 Namelist value with trailing sign is ignored without error X-Enigmail-Draft-Status: N1110 Message-ID: <56CB8165.7070002@charter.net> Date: Mon, 22 Feb 2016 13:45:09 -0800 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:38.0) Gecko/20100101 Thunderbird/38.5.0 MIME-Version: 1.0 Hi all, The problem here is we were treating a bad exponent as if it was a bad read. On bad reads we take a soft error path and go back to see if we are reading a new namelist name. It is done this way because short reads, for example, part of an array, are permitted. To get to the code where the error occurs, we have to have read an exponent sign or a valid number with an exponent letter. In this case it is not likely that we are reading a namelist name. So, the patch takes the hard error path for a bad exponent so that we get a real error. I also noticed the error messages were not giving the correct item number (always zero) so I realized the item_count was not being incremented for each object. So fixed this as well. Regression tested on x86-64-Linux. One new test case and one modified. OK for trunk? Not strictly a regression, but simple enough. Jerry 2016-02-22 Jerry DeLisle PR libgfortran/69456 * io/list_read.c (read_real): If digit is missing from exponent issue an error. (parse_real): Likewise and adjusted error message to clarify it is part of a complex number. (nml_read_obj): Bump item count and add comment that this is used to identify which item in a namelist read has a problem. diff --git a/gcc/testsuite/gfortran.dg/namelist_89.f90 b/gcc/testsuite/gfortran.dg/namelist_89.f90 new file mode 100644 index 0000000..aa086ee --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_89.f90 @@ -0,0 +1,47 @@ +! { dg-do run } +! PR69456 Namelist value with trailing sign is ignored without error +implicit none +integer :: ios +character(256) :: errormsg +real :: r1 = -1 +real :: r2 = -1 +real :: r3 = -1 +real :: r4 = -1 +complex :: c1 = (-1,-1) +namelist /nml/ r1, r2, r3, r4, c1 + +open (99, status="scratch") + +write(99,*) "&nml" +write(99,*) " r1=1+1" ! Treated as 1e+1?! +write(99,*) " r2=1-1" ! Treated as 1e-1?! +write(99,*) " r3=1+1" ! Treated as 1e+1?! +write(99,*) " r4=1-1" ! Treated as 1e-1?! +write(99,*) " c1=(1-,1+1)" ! Should give error on item number 5 +write(99,*) "/" + +rewind(99) + +read (99, nml=nml, iostat=ios, iomsg=errormsg) +if (ios.ne.5010) call abort +if (scan(errormsg, "5").ne.44) call abort + +rewind(99) + +write(99,*) "&nml" +write(99,*) " r1=1+1" ! Treated as 1e+1?! +write(99,*) " r2=1-" ! Should give error on item number 2 +write(99,*) " r3=1+1" ! Treated as 1e+1?! +write(99,*) " r4=1-1" ! Treated as 1e-1?! +write(99,*) " c1=(1-,1+1)" ! Treated as 1e-1?! +write(99,*) "/" + +rewind(99) + +read (99, nml=nml, iostat=ios, iomsg=errormsg) +if (ios.ne.5010) call abort +if (scan(errormsg, "2").ne.25) call abort + +close (99) + +end diff --git a/gcc/testsuite/gfortran.dg/pr59700.f90 b/gcc/testsuite/gfortran.dg/pr59700.f90 index 579d8a4..15bf261 100644 --- a/gcc/testsuite/gfortran.dg/pr59700.f90 +++ b/gcc/testsuite/gfortran.dg/pr59700.f90 @@ -35,6 +35,6 @@ program foo rewind(fd) msg = 'ok' read(fd, *, err=40, iomsg=msg) c1, c2 -40 if (msg /= 'Bad floating point number for item 2') call abort +40 if (msg /= 'Bad complex floating point number for item 2') call abort close(fd) end program foo diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index bebdd8c..e24b392 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1374,7 +1374,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) exp2: if (!isdigit (c)) - goto bad; + goto bad_exponent; push_char (dtp, c); @@ -1472,6 +1472,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) if (nml_bad_return (dtp, c)) return 0; + bad_exponent: + free_saved (dtp); if (c == EOF) { @@ -1482,8 +1484,8 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length) else if (c != '\n') eat_line (dtp); - snprintf (message, MSGLEN, "Bad floating point number for item %d", - dtp->u.p.item_count); + snprintf (message, MSGLEN, "Bad complex floating point " + "number for item %d", dtp->u.p.item_count); free_line (dtp); generate_error (&dtp->common, LIBERROR_READ_VALUE, message); @@ -1814,7 +1816,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length) exp2: if (!isdigit (c)) - goto bad_real; + goto bad_exponent; + push_char (dtp, c); for (;;) @@ -1983,6 +1986,8 @@ read_real (st_parameter_dt *dtp, void * dest, int length) if (nml_bad_return (dtp, c)) return; + bad_exponent: + free_saved (dtp); if (c == EOF) { @@ -2810,6 +2815,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info * nl, index_type offset, if (dtp->u.p.nml_read_error || !nl->touched) return true; + dtp->u.p.item_count++; /* Used in error messages. */ dtp->u.p.repeat_count = 0; eat_spaces (dtp);