From patchwork Thu Jun 20 09:11:59 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 252826 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 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id B3E1B2C1422 for ; Thu, 20 Jun 2013 19:12:24 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:to:subject:content-type; q= dns; s=default; b=t763G7thNvaGCIWTw1EXXJBPEO7ZEtpVgEZoK02ymxZBRz FWt+Pbg+0zr5GX6JNZV4JHn7UegioBCR3GJ9WDpKHjeYTPFu8S8dAucee01F2ttr vXv0ALbQD8ebdI4fLjQP5Hs7I7rz03zXZdMgtOhuLIb1IbhySZV5VtnOYdV4Q= 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 :message-id:date:from:mime-version:to:subject:content-type; s= default; bh=YjkD7mC6zicu74sVR6OH5kPT1T0=; b=pCzsR9cNsFLkr4cWT4/g angk8X2DJTK7gFjas+YQQ2PbRws37jW+m+do3QpCH5yxFNaVBxlkQ92DbXFhRX0p xBySQnpmN9B6ILka26NQT7EaX76udpr/jL/t4KM5+Itn2GZJ+92z5PcbrT12ZVDo QyQzMeBdM6hhNddmUyK49TU= Received: (qmail 16829 invoked by alias); 20 Jun 2013 09:12:13 -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 16773 invoked by uid 89); 20 Jun 2013 09:12:06 -0000 X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Thu, 20 Jun 2013 09:12:04 +0000 Received: from archimedes.net-b.de (port-92-195-31-211.dynamic.qsc.de [92.195.31.211]) by mx02.qsc.de (Postfix) with ESMTP id 8B75327677; Thu, 20 Jun 2013 11:11:59 +0200 (CEST) Message-ID: <51C2C75F.70707@net-b.de> Date: Thu, 20 Jun 2013 11:11:59 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR57633 - Fix EOL handling with \r in list-directed I/O X-Virus-Found: No gfortran failed to correctly read the file line1,1, line2 with DOS (\r\n) line endings. As the code already set EOL for "\r", finish_list_read didn't call eat_line. Result: The attempt to read "line2" actually accessed the last byte of line one, namely "\n", which it regarded as zero-sized string. That's fixed by the patch to next_char. eat_separator is a separate issue and unrelated to the PR. I also failed to create a test case for it. In any case, I regard the following as wrong: case '\r': dtp->u.p.at_eol = 1; ... if (n != '\n') { unget_char (dtp, n); break; As the code explicitly does not regard "\r" as EOL in this case, I believe EOL shouldn't be set here. (Recall, Unix (MacOS X, Linux, ...) have '\n' while DOS/Windows has "\r\n". While '\r' as line break exists (old Macs, pre MacOS X), gfortran does not support formatted I/O with "\r" record markers.) Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-06-20 Tobias Burnus PR fortran/57633 * io/list_read.c (next_char, eat_separator): Don't set EOL for \r. 2013-06-20 Tobias Burnus PR fortran/57633 * gfortran.dg/list_read_11.f90: New. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index c8a1bdfc..82a98a5 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -235,21 +235,21 @@ next_char (st_parameter_dt *dtp) } } } else { c = fbuf_getc (dtp->u.p.current_unit); if (c != EOF && is_stream_io (dtp)) dtp->u.p.current_unit->strm_pos++; } done: - dtp->u.p.at_eol = (c == '\n' || c == '\r' || c == EOF); + dtp->u.p.at_eol = (c == '\n' || c == EOF); return c; } /* Push a character back onto the input. */ static void unget_char (st_parameter_dt *dtp, int c) { dtp->u.p.last_char = c; @@ -327,21 +327,20 @@ eat_separator (st_parameter_dt *dtp) case ';': dtp->u.p.comma_flag = 1; eat_spaces (dtp); break; case '/': dtp->u.p.input_complete = 1; break; case '\r': - dtp->u.p.at_eol = 1; if ((n = next_char(dtp)) == EOF) return LIBERROR_END; if (n != '\n') { unget_char (dtp, n); break; } /* Fall through. */ case '\n': dtp->u.p.at_eol = 1; --- /dev/null 2013-06-20 10:08:42.876937873 +0200 +++ gcc/gcc/testsuite/gfortran.dg/list_read_11.f90 2013-06-20 10:55:13.329549458 +0200 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-options "-fbackslash" } +! +! PR fortran/57633 +! +program teststuff + implicit none + integer::a + character(len=10)::s1,s2 + + open(11,file="testcase.txt",form='unformatted',access='stream',status='new') + write(11) 'line1,1,\r\nline2' + close(11) + + open(11,file="testcase.txt",form='formatted') + s1 = repeat('x', len(s1)) + a = 99 + read(11,*)s1,a + if (s1 /= "line1" .or. a /= 1) call abort() + + s1 = repeat('x', len(s1)) + read(11,"(a)")s1 + close(11,status="delete") + if (s1 /= "line2") call abort() + + + open(11,file="testcase.txt",form='unformatted',access='stream',status='new') + write(11) 'word1\rword2,\n' + close(11) + + open(11,file="testcase.txt",form='formatted') + s1 = repeat('x', len(s1)) + s2 = repeat('x', len(s1)) + read(11,*)s1,s2 + close(11,status="delete") + if (s1 /= "word1") call abort() + if (s2 /= "word2") call abort() +end program teststuff