From patchwork Sat May 19 15:42:35 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 916868 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-478000-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="vN1/JkE9"; 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 40p8SV2Ryhz9s4V for ; Sun, 20 May 2018 01:42:48 +1000 (AEST) 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=ObiW2urX6oIWqHtgT/naIp15T8R3EcKAm8AqYPr6A9X5Ve gPDemNSDinDJy8h/ipdf8wGJQSEg/t/zqzJ1RZt0XmNm1smQH4Ah1viSXtcDVweM w8rlc1IgJJMo9zQVnGce3a9vYbrSfaQppHAf3PBT62NVnby6jTjT+5Fjnb3mY= 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=FPICccRJ8Doe36JQCh3cAOdZKy4=; b=vN1/JkE9R0u7pm1fYfOf V4TadRYRcFQu+6SsvA2x9q9f5KZzaK1ig03SPNtd6RVShwm2+KjDsqUHqZCN/yWi DshnI3T1HouY7hkmvaUN8PCyyh/vL48FJmT5WYZ+qMxIYyglZJx8QDMPI9AWtaa8 GRLxbCemilj2zFm+deZv2Vc= Received: (qmail 94505 invoked by alias); 19 May 2018 15:42:40 -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 93068 invoked by uid 89); 19 May 2018 15:42:40 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-5.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=fred, Fred, sk:associa, parm X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-yw0-f169.google.com Received: from mail-yw0-f169.google.com (HELO mail-yw0-f169.google.com) (209.85.161.169) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sat, 19 May 2018 15:42:38 +0000 Received: by mail-yw0-f169.google.com with SMTP id i17-v6so3324514ywg.13; Sat, 19 May 2018 08:42:38 -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=mNv1NffxteKJi4lsXE5gvrgmuL5uz9xIWZz6Jgsp/uM=; b=WW//AvoJ9RZFuJ1YM2K7zbmIHdQKz1aZuWgN/vD9J8v/w3dBtSHvxgyd9M/+cwcXIm X1T6FJK1dq/rNxuG4bSL19mN71YIQDMx9HQgnGxkTMeHc64NtKOUYVwmrv6be9ZN8W1l IB6a9YS3crtoo/hEy80VaUgGFqQoL17bKIEx4t12Xgt/xLWUluaHQhx8bXF+HESQByCi QKPMtZm7pCibXBNVahupf70SST1sXnjbkhjG9Aw0MW44lhlIC1bmjYYaNBJzt9q99rBs 29a6ClMgmkG9PnBGFCpJ4DvUlC5buMvXWcA0cVaza9Gv26NuxEjAuC/ICvMNBnmcoU0G owtw== X-Gm-Message-State: ALKqPwcnszqKRZ8naEPXsYEb0kQDDSwpFqQXuhw1wEHeggK8qA45s8YR KK2HQlWygaCkIxvkEKmCUXp5cgfhgb/YwRDv1pwwVg== X-Google-Smtp-Source: AB8JxZpf47O85N85qUDvEh1uWxrdrNhVqyPpsF34Lw3mxTt7KQ3btBUlaFfElNmWr1dEUra+Fhk61dmukXvI4MG5K6g= X-Received: by 2002:a0d:cf84:: with SMTP id r126-v6mr7135906ywd.195.1526744556454; Sat, 19 May 2018 08:42:36 -0700 (PDT) MIME-Version: 1.0 Received: by 10.13.215.196 with HTTP; Sat, 19 May 2018 08:42:35 -0700 (PDT) From: Paul Richard Thomas Date: Sat, 19 May 2018 16:42:35 +0100 Message-ID: Subject: [Patch, fortran] PR 49636 - [F03] ASSOCIATE construct confused with slightly complicated case To: "fortran@gcc.gnu.org" , gcc-patches This patch is a straightforward recycling of existing code to replace an incomplete copy elsewhere. Bootstraps and regtests on FC27/x86_64 - OK for trunk down to 7-branch? Paul 2018-05-19 Paul Thomas PR fortran/49636 * trans-array.c (gfc_get_array_span): Renamed from 'get_array_span'. (gfc_conv_expr_descriptor): Change references to above. * trans-array.h : Add prototype for 'gfc_get_array_span'. * trans-stmt.c (trans_associate_var): If the associate name is a subref array pointer, use gfc_get_array_span for the span. 2018-05-19 Paul Thomas PR fortran/49636 * gfortran.dg/associate_38.f90: New test. Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 260392) --- gcc/fortran/trans-array.c (working copy) *************** is_pointer_array (tree expr) *** 817,824 **** /* Return the span of an array. */ ! static tree ! get_array_span (tree desc, gfc_expr *expr) { tree tmp; --- 817,824 ---- /* Return the span of an array. */ ! tree ! gfc_get_array_span (tree desc, gfc_expr *expr) { tree tmp; *************** gfc_conv_expr_descriptor (gfc_se *se, gf *** 7061,7067 **** subref_array_target, expr); /* ....and set the span field. */ ! tmp = get_array_span (desc, expr); gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) --- 7061,7067 ---- subref_array_target, expr); /* ....and set the span field. */ ! tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp); } else if (se->want_pointer) *************** gfc_conv_expr_descriptor (gfc_se *se, gf *** 7334,7340 **** parmtype = TREE_TYPE (parm); /* ....and set the span field. */ ! tmp = get_array_span (desc, expr); gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); } else --- 7334,7340 ---- parmtype = TREE_TYPE (parm); /* ....and set the span field. */ ! tmp = gfc_get_array_span (desc, expr); gfc_conv_descriptor_span_set (&loop.pre, parm, tmp); } else Index: gcc/fortran/trans-array.h =================================================================== *** gcc/fortran/trans-array.h (revision 260391) --- gcc/fortran/trans-array.h (working copy) *************** void gfc_conv_tmp_array_ref (gfc_se * se *** 136,141 **** --- 136,143 ---- /* Translate a reference to an array temporary. */ void gfc_conv_tmp_ref (gfc_se *); + /* Obtain the span of an array. */ + tree gfc_get_array_span (tree, gfc_expr *); /* Evaluate an array expression. */ void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *); /* Convert an array for passing as an actual function parameter. */ Index: gcc/fortran/trans-stmt.c =================================================================== *** gcc/fortran/trans-stmt.c (revision 260391) --- gcc/fortran/trans-stmt.c (working copy) *************** trans_associate_var (gfc_symbol *sym, gf *** 1735,1745 **** if (sym->attr.subref_array_pointer) { gcc_assert (e->expr_type == EXPR_VARIABLE); ! tmp = e->symtree->n.sym->ts.type == BT_CLASS ! ? gfc_class_data_get (e->symtree->n.sym->backend_decl) ! : e->symtree->n.sym->backend_decl; ! tmp = gfc_get_element_type (TREE_TYPE (tmp)); ! tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp)); gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } --- 1735,1742 ---- if (sym->attr.subref_array_pointer) { gcc_assert (e->expr_type == EXPR_VARIABLE); ! tmp = gfc_get_array_span (se.expr, e); ! gfc_conv_descriptor_span_set (&se.pre, desc, tmp); } Index: gcc/testsuite/gfortran.dg/associate_38.f90 =================================================================== *** gcc/testsuite/gfortran.dg/associate_38.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/associate_38.f90 (working copy) *************** *** 0 **** --- 1,22 ---- + ! { dg-do run } + ! + ! Test the fix for PR49636 in which the 'span' of 'ty1' was not used + ! in the descriptor of 'i'. + ! + ! Contributed by Fred Krogh + ! + program test + type ty1 + integer :: k + integer :: i + end type ty1 + type ty2 + type(ty1) :: j(3) + end type ty2 + + type(ty2) t2 + t2%j(1:3)%i = [ 1, 3, 5 ] + associate (i=>t2%j%i) + if (any (t2%j(1:3)%i .ne. i(1:3))) stop 1 + end associate + end program test