From patchwork Tue Apr 2 17:19:50 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 233114 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 873EE2C0150 for ; Wed, 3 Apr 2013 05:48:47 +1100 (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=TJpMyMNOyQ10NUvnoy1Wn4ylBfxT0FewAPcHwS6XNbSNWA AwP8J9R9hzidO354KZ75OLQd5KwaXAnRaxfMLcYka14oQ8vPndaWHCQwP5Fe6t42 ZqTnvKwzANMHJqohlN0D7Ip0xBTtNMhm7v3e9ULRxJqv/r9pL8mw6wmSU/iPY= 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=XTBzOfHhYo4imyVx3cW6ljQthUA=; b=Ch9qS/xRbvr1XZXPuJuD Utoz9uWPGvku0owQW1FdUzW9n+cNGX54ZS8fP0YBg1uCKlSKEmvGOiiALc52gIML lgfCRYgPhMpD56R/fLLQg9XYHMffmK2xU5DI078L3tFe8Gcspxddt3ekm9Hz3/qm UTnz+lJhhgdxPfvu76CZNpg= Received: (qmail 30523 invoked by alias); 2 Apr 2013 18:48:25 -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 30483 invoked by uid 89); 2 Apr 2013 18:48:18 -0000 X-Spam-SWARE-Status: No, score=-2.2 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_PL autolearn=ham version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Tue, 02 Apr 2013 18:48:15 +0000 Received: from archimedes.net-b.de (port-92-195-88-1.dynamic.qsc.de [92.195.88.1]) by mx01.qsc.de (Postfix) with ESMTP id 7D0CC1852C; Tue, 2 Apr 2013 19:19:50 +0200 (CEST) Message-ID: <515B1336.2070800@net-b.de> Date: Tue, 02 Apr 2013 19:19:50 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130307 Thunderbird/17.0.4 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR56810 - fix I/O READ of COMPLEX with repeat count X-Virus-Found: No Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-04-02 Tobias Burnus PR fortran/56810 * io/list_read.c (check_type): Fix kind checking for COMPLEX. 2013-04-02 Tobias Burnus PR fortran/56810 * gfortran.dg/read_repeat_2.f90: New. diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0693e50..da92ad3 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -1784,7 +1784,7 @@ read_real (st_parameter_dt *dtp, void * dest, int length) compatible. Returns nonzero if incompatible. */ static int -check_type (st_parameter_dt *dtp, bt type, int len) +check_type (st_parameter_dt *dtp, bt type, int kind) { char message[MSGLEN]; @@ -1801,11 +1801,14 @@ check_type (st_parameter_dt *dtp, bt type, int len) if (dtp->u.p.saved_type == BT_UNKNOWN || dtp->u.p.saved_type == BT_CHARACTER) return 0; - if (dtp->u.p.saved_length != len) + if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind) + || (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2)) { snprintf (message, MSGLEN, "Read kind %d %s where kind %d is required for item %d", - dtp->u.p.saved_length, type_name (dtp->u.p.saved_type), len, + type == BT_COMPLEX ? dtp->u.p.saved_length / 2 + : type == BT_COMPLEX, + type_name (dtp->u.p.saved_type), kind, dtp->u.p.item_count); generate_error (&dtp->common, LIBERROR_READ_VALUE, message); return 1; --- /dev/null 2013-04-02 09:26:12.399063163 +0200 +++ gcc/gcc/testsuite/gfortran.dg/read_repeat_2.f90 2013-04-02 19:01:36.254797196 +0200 @@ -0,0 +1,19 @@ +! { dg-do run } +! +! PR fortran/56810 +! +! Contributed by Jonathan Hogg +! +program test + implicit none + + integer :: i + complex :: a(4) + + open (99, status='scratch') + write (99, *) '4*(1.0,2.0)' + rewind (99) + read (99,*) a(:) + close (99) + if (any (a /= cmplx (1.0,2.0))) call abort() +end program test