From patchwork Mon Oct 16 17:48:56 2017 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Fritz Reese X-Patchwork-Id: 826444 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-464282-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="UqHr5edH"; dkim-atps=neutral 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 3yG5Rv4tmxz9sRm for ; Tue, 17 Oct 2017 04:49:30 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=VJRjZREjOQQXg5hId06z9d5x0B3DKO1HvcPnlHIU9Gsoa9 vSCImhRi4hKKTB1icqyIptnPTub/wBiy8YhK2lXnpnPeT14Gq8g9owBacpdgcwAX yG5u9gatcr1X4iiYBmUzoTXbDt5AzRZ6YwwMCNZjZwghuCmVuWZSiknnimHs8= 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 :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=C8hMi+/2mIQXSHlaN7PjahZYhZk=; b=UqHr5edHRTEOnunoQSIm 1V9NuQUlbiNTiyjKDkSJFg2nPFGTeWuajrBeoeweT+Q+gzszevQt4TwGFciKjRbC p6hqJ9/8XTRHreMfq4ktr2f/cx24iC+M+PX8gRuq/PEuVZwWm0eU7bkyX7bubOFU BdpW+5xZqUn2eoT5A4qrIho= Received: (qmail 5633 invoked by alias); 16 Oct 2017 17:49:20 -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 5339 invoked by uid 89); 16 Oct 2017 17:49:20 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-26.4 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_0, GIT_PATCH_1, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_NONE, RCVD_IN_SORBS_SPAM, SPF_PASS autolearn=ham version=3.3.2 spammy=2122 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-it0-f44.google.com Received: from mail-it0-f44.google.com (HELO mail-it0-f44.google.com) (209.85.214.44) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 16 Oct 2017 17:49:18 +0000 Received: by mail-it0-f44.google.com with SMTP id 72so2118964itk.3; Mon, 16 Oct 2017 10:49:18 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=FJFU4j8OSm+1fmJ73gpo0JUsmKWOoxqn9GkqdSfedxc=; b=sj24e0s94ZTdanTgVbEqSG3AAr/4pXjdEkiIfzgvY+HAOO3e0kLZXwq1p/+MtMNJKV BHBDAir3VX7qF0zKeiF5pUYc9lWzHZ77C/MmhBc4cjgXPs7S890GEGIh36ipnKEOGNHs bYZ6g6Nnmfk5h2750M2VGimPKdVkHfnVZRbQ6O7BNcnZWVLXE03YYPfegiVL4WJxEfLq sgCmJSYlqBKF75zx5InYJ1c/XW9pTY0jaD8XKHX4/6nPlPIlzUM34hOv2j4Q8WFrTT+T fRhpRWjYj/u4h8bQhFJK7GS29CDPJQMCMgUZrRQdrlgdwHrOyuoIrtpg4MvqXfStQ5dp LK9g== X-Gm-Message-State: AMCzsaXDdSQsAmWfktjKCDWa0tXZZ9MeDK6+lGaNS/3r4pH9k48kGHIB oaUijwcjSSS+YtJ4yljCZdPtbPEe75NR5U+GAIG6bA== X-Google-Smtp-Source: ABhQp+Q8Uh+bx8sxn51yhlBVlusT2nvXAB+lR6ruB0AVKnSL5ANaqN64X7YQ5VgvALvoZhYiI22/nCafFCn5NRa0xvg= X-Received: by 10.36.82.1 with SMTP id d1mr660030itb.115.1508176156515; Mon, 16 Oct 2017 10:49:16 -0700 (PDT) MIME-Version: 1.0 Received: by 10.2.153.130 with HTTP; Mon, 16 Oct 2017 10:48:56 -0700 (PDT) From: Fritz Reese Date: Mon, 16 Oct 2017 13:48:56 -0400 Message-ID: Subject: [PATCH, Fortran, committed] PR82511: ICE Bad IO basetype (12) on attempted read or write of entire DEC structure To: fortran , gcc-patches All, The simple attached patch which fixes PR 82511 has been committed to trunk as r253791. It regtests on x86_64-redhat-linux-gnu. The issue was an ICE when a variable containing a BT_UNION (basetype 12) component was given in a I/O list. The patch treats the BT_UNION component as a derived type variable, thus recursing into its final components (across all of its MAPs). --- Fritz Reese From 89ed92f0127b61bc802e43c8f3125f48540d7c27 Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Mon, 16 Oct 2017 13:27:28 -0400 Subject: [PATCH] Treat UNION components as DT comp. in I/O lists. PR fortran/82511 gcc/fortran/ * trans-io.c (transfer_expr): Treat BT_UNION as BT_DERIVED. PR fortran/82511 gcc/testsuite/gfortran.dg/ * dec_structure_22.f90: New testcase. --- gcc/fortran/trans-io.c | 4 +-- gcc/testsuite/gfortran.dg/dec_structure_22.f90 | 38 ++++++++++++++++++++++++++ 2 files changed, 40 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_structure_22.f90 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 026f9a993d2..f3e1f3e4d09 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -2404,7 +2404,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, case BT_CLASS: if (ts->u.derived->components == NULL) return; - if (ts->type == BT_DERIVED || ts->type == BT_CLASS) + if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS) { gfc_symbol *derived; gfc_symbol *dtio_sub = NULL; @@ -2438,7 +2438,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, function = iocall[IOCALL_X_DERIVED]; break; } - else if (ts->type == BT_DERIVED) + else if (gfc_bt_struct (ts->type)) { /* Recurse into the elements of the derived type. */ expr = gfc_evaluate_now (addr_expr, &se->pre); diff --git a/gcc/testsuite/gfortran.dg/dec_structure_22.f90 b/gcc/testsuite/gfortran.dg/dec_structure_22.f90 new file mode 100644 index 00000000000..ddbee02602a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_structure_22.f90 @@ -0,0 +1,38 @@ + ! { dg-do run } + ! { dg-options "-fdec-structure" } + ! + ! PR fortran/82511 + ! + ! Verify that structure variables with UNION components + ! are accepted in an I/O-list READ. + ! + implicit none + + structure /s/ + union + map + character(16) :: c16_1 + end map + map + character(16) :: c16_2 + end map + end union + end structure + + record /s/ r + character(32) :: instr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^" + + r.c16_1 = ' ' + r.c16_2 = ' ' + ! The record r shall be treated as if its components are listed: + ! read(...) r.c16_1, r.c16_2 + ! This shall correspond to the formatted read of A16,A16 + read(instr, '(A16,A16)') r + + ! r.c16_1 and r.c16_2 are in a union, thus share the same memory + ! and the first 16 bytes of instr are overwritten + if ( r.c16_1 .ne. instr(17:32) .or. r.c16_2 .ne. instr(17:32) ) then + call abort() + endif + + end -- 2.12.2