From patchwork Wed Jun 7 16:10:48 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 104608 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:994d:0:b0:3d9:f83d:47d9 with SMTP id k13csp313736vqr; Wed, 7 Jun 2023 09:12:10 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ7QKfsRpcdvbh4dlm5IH7O5Pa10qcI1AlizsRQeT+gaJJy8XB39bLQqqT0CUVLzllQmadZy X-Received: by 2002:a17:906:974d:b0:978:6a96:a35c with SMTP id o13-20020a170906974d00b009786a96a35cmr6745943ejy.21.1686154330290; Wed, 07 Jun 2023 09:12:10 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1686154330; cv=none; d=google.com; s=arc-20160816; b=DAs5/fPJPF5c7Rm2ningI1A17yV6bK8zIJiinkxrvwEK1CVuM58qo0Ia+Bi1eD+HOw ZuYOe01I1emUg1gTXKRZi+7TOaCCOykZTwhwb21BtGJTFqVDIZiu5H6z8JV6pQFycz/h K2dz5fetEjEEJIQOGXWXpGqSxoO13tRDC8S8XomnMtTz6RT0OSbXH5lqMd5/B3+lIESL c0+STawG+//bpl93JwDJ3YSUU2ALuo1sU71BKNICA4C30PMkZi4qfOaFrGtnLcyWrhR2 9BpFVYt/gR+VMS7hoCBe6T18FP5TWokY0xnWqaMsNULRhHp1xaz8ifJ6aDfuZCRds94m 32pw== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:to:subject :message-id:date:mime-version:dmarc-filter:delivered-to :dkim-signature:dkim-filter; bh=rY852OCugkyWGNDUF9/G0ifq/K4T+N58sV+4q27lzq4=; b=x3hkbiieuVBJHh/ackEK+Bdc7SuUWu4Zel1A3foJGJyJ2uTK1gAffL5SJrF9jISQkF t08j2qCRArUCE6XAS5S+x8vwAip1xcqKbzvB08hm7bHZ5ZRTazYc9ootDGNjF/TzJFph bQo0xp589lAUGXHCLuaCTpGghYeNfEj9lylPRpVNvh2zZub4RN9tYxPD+Nodj3n8zKl7 a6bzvi+tV1x+AivB7g5/mif7k2CetVyGrr3iUwD+jbkUHfclhp9tmMoigNB6hjV9SkwG ZHY7aac9VvNngwJaKIgZbFcs0H5be72UlyyfJgC9/O5Mw0rb6MT67z0/wSGeFLzXoBhV Cr1Q== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=eXPpvlAr; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (ip-8-43-85-97.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id 26-20020a170906301a00b0096f54871652si8005778ejz.915.2023.06.07.09.12.09 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 07 Jun 2023 09:12:10 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=eXPpvlAr; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id C951E3857724 for ; Wed, 7 Jun 2023 16:11:51 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org C951E3857724 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1686154311; bh=rY852OCugkyWGNDUF9/G0ifq/K4T+N58sV+4q27lzq4=; h=Date:Subject:To:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=eXPpvlAre7A4DmsBXnYovbMMZE80vtPz4bQOXxzTo0y3EwGWS4B/d0CcYoW0z6gTs yF8wuVJUYBf3g4Tar5eZgrOW6tYycxDn7VbYavQjvfWl3fD/2HRUx13TjRGmQARrJn Jwy+Ci9yUughqkTGQQjahjRGOWrFjl7dh9FTgrnU= X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mail-pg1-x529.google.com (mail-pg1-x529.google.com [IPv6:2607:f8b0:4864:20::529]) by sourceware.org (Postfix) with ESMTPS id 10FF53858C54; Wed, 7 Jun 2023 16:11:02 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 10FF53858C54 Received: by mail-pg1-x529.google.com with SMTP id 41be03b00d2f7-543d90cc675so1425671a12.3; Wed, 07 Jun 2023 09:11:02 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1686154260; x=1688746260; h=to:subject:message-id:date:from:mime-version:x-gm-message-state :from:to:cc:subject:date:message-id:reply-to; bh=rY852OCugkyWGNDUF9/G0ifq/K4T+N58sV+4q27lzq4=; b=Et1d1NjTe7gQCCXRRBvh5v1F6SBBfUcnNOA5mSA3pjz+CQbG5zomVC2pM1ApMEp9+3 YcRX7hijM7PvGn1vE/2hJWzC68vvy3AgJGaOhuinUTIHSCrOvMfvdslB1SchImtI81s0 O11/uDmXsuANaZ3kc6F9+XT3JH4MA4ziVIecpZ0YTSd/Qe9fGPR1fLCi2fpzvAi1ynIA mj+PJZDm1QCnMevor2DkpA4+gEfdiYO2wbl+D0ZKKQNHWCa8kChswaNZHYUwQe7214rx g4GwZHKUawWj6Li/Xorl+w0XiX7xe0C8/SPZNDlienvLqkbCuPOi2g1dIDzWn1x72Sgq gcnA== X-Gm-Message-State: AC+VfDwM/wBWzsqCXonGwIFV4ensLn2HFIY3jpxo3spPuYbkrrFH9OdG SHyH6LBsagKfPeacMBY3FnoTUROUk1BSTLPXesUyJ/7u7CY= X-Received: by 2002:a17:90a:fa42:b0:259:e35f:ab2e with SMTP id dt2-20020a17090afa4200b00259e35fab2emr183955pjb.4.1686154260027; Wed, 07 Jun 2023 09:11:00 -0700 (PDT) MIME-Version: 1.0 Date: Wed, 7 Jun 2023 17:10:48 +0100 Message-ID: Subject: [Patch, fortran] PR87477 - (associate) - [meta-bug] [F03] issues concerning the ASSOCIATE statement To: "fortran@gcc.gnu.org" , gcc-patches X-Spam-Status: No, score=-7.5 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_NONE, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-Patchwork-Original-From: Paul Richard Thomas via Gcc-patches From: Paul Richard Thomas Reply-To: Paul Richard Thomas Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1768060963216006355?= X-GMAIL-MSGID: =?utf-8?q?1768060963216006355?= Hi All, Three more fixes for PR87477. Please note that PR99350 was a blocker but, as pointed out in comment #5 of the PR, this has nothing to do with the associate construct. All three fixes are straight forward and the .diff + ChangeLog suffice to explain them. 'rankguessed' was made redundant by the last PR87477 fix. Regtests on x86_64 - good for mainline? Paul Fortran: Fix some more blockers in associate meta-bug [PR87477] 2023-06-07 Paul Thomas gcc/fortran PR fortran/99350 * decl.cc (char_len_param_value): Simplify a copy of the expr and replace the original if there is no error. * gfortran.h : Remove the redundant field 'rankguessed' from 'gfc_association_list'. * resolve.cc (resolve_assoc_var): Remove refs to 'rankguessed'. PR fortran/107281 * resolve.cc (resolve_variable): Associate names with constant or structure constructor targets cannot have array refs. PR fortran/109451 * trans-array.cc (gfc_conv_expr_descriptor): Guard expression character length backend decl before using it. Suppress the assignment if lhs equals rhs. * trans-io.cc (gfc_trans_transfer): Scalarize transfer of associate variables pointing to a variable. Add comment. * trans-stmt.cc (trans_associate_var): Remove requirement that the character length be deferred before assigning the value returned by gfc_conv_expr_descriptor. Also, guard the backend decl before testing with VAR_P. gcc/testsuite/ PR fortran/99350 * gfortran.dg/pr99350.f90 : New test. PR fortran/107281 * gfortran.dg/associate_5.f03 : Changed error message. * gfortran.dg/pr107281.f90 : New test. PR fortran/109451 * gfortran.dg/associate_61.f90 : New test diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc index f5d39e2a3d8..d09c8bc97d9 100644 --- a/gcc/fortran/decl.cc +++ b/gcc/fortran/decl.cc @@ -1056,6 +1056,7 @@ static match char_len_param_value (gfc_expr **expr, bool *deferred) { match m; + gfc_expr *p; *expr = NULL; *deferred = false; @@ -1081,10 +1082,10 @@ char_len_param_value (gfc_expr **expr, bool *deferred) if (!gfc_expr_check_typed (*expr, gfc_current_ns, false)) return MATCH_ERROR; - /* If gfortran gets an EXPR_OP, try to simplify it. This catches things - like CHARACTER(([1])). */ - if ((*expr)->expr_type == EXPR_OP) - gfc_simplify_expr (*expr, 1); + /* Try to simplify the expression to catch things like CHARACTER(([1])). */ + p = gfc_copy_expr (*expr); + if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1)) + gfc_replace_expr (*expr, p); if ((*expr)->expr_type == EXPR_FUNCTION) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 3e5f942d7fd..a65dd571591 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2914,9 +2914,6 @@ typedef struct gfc_association_list for memory handling. */ unsigned dangling:1; - /* True when the rank of the target expression is guessed during parsing. */ - unsigned rankguessed:1; - char name[GFC_MAX_SYMBOL_LEN + 1]; gfc_symtree *st; /* Symtree corresponding to name. */ locus where; diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 2ba3101f1fe..f2604314570 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -5872,7 +5872,15 @@ resolve_variable (gfc_expr *e) if (sym->ts.type == BT_CLASS) gfc_fix_class_refs (e); if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY) - return false; + { + /* Unambiguously scalar! */ + if (sym->assoc->target + && (sym->assoc->target->expr_type == EXPR_CONSTANT + || sym->assoc->target->expr_type == EXPR_STRUCTURE)) + gfc_error ("Scalar variable %qs has an array reference at %L", + sym->name, &e->where); + return false; + } else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY)) { /* This can happen because the parser did not detect that the @@ -9279,7 +9287,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) gfc_array_spec *as; /* The rank may be incorrectly guessed at parsing, therefore make sure it is corrected now. */ - if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed)) + if (sym->ts.type != BT_CLASS && !sym->as) { if (!sym->as) sym->as = gfc_get_array_spec (); @@ -9292,8 +9300,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) sym->attr.codimension = 1; } else if (sym->ts.type == BT_CLASS - && CLASS_DATA (sym) - && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed)) + && CLASS_DATA (sym) && !CLASS_DATA (sym)->as) { if (!CLASS_DATA (sym)->as) CLASS_DATA (sym)->as = gfc_get_array_spec (); diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 1c7ea900ea1..e1c75e9fe02 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -7934,7 +7934,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) else tmp = se->string_length; - if (expr->ts.deferred && VAR_P (expr->ts.u.cl->backend_decl)) + if (expr->ts.deferred && expr->ts.u.cl->backend_decl + && VAR_P (expr->ts.u.cl->backend_decl)) gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp); else expr->ts.u.cl->backend_decl = tmp; @@ -7999,6 +8000,15 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) } } + if (expr->ts.type == BT_CHARACTER + && VAR_P (TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm))))) + { + tree elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm))); + gfc_add_modify (&loop.pre, elem_len, + fold_convert (TREE_TYPE (elem_len), + gfc_get_array_span (desc, expr))); + } + /* Set the span field. */ tmp = NULL_TREE; if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc index 0c0e3332778..e36ad0e3db4 100644 --- a/gcc/fortran/trans-io.cc +++ b/gcc/fortran/trans-io.cc @@ -2620,9 +2620,13 @@ gfc_trans_transfer (gfc_code * code) gcc_assert (ref && ref->type == REF_ARRAY); } + /* These expressions don't always have the dtype element length set + correctly, rendering them useless for array transfer. */ if (expr->ts.type != BT_CLASS && expr->expr_type == EXPR_VARIABLE && ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred) + || (expr->symtree->n.sym->assoc + && expr->symtree->n.sym->assoc->variable) || gfc_expr_attr (expr).pointer)) goto scalarize; diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index b5b82941b41..dcabeca0078 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -1930,15 +1930,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_conv_expr_descriptor (&se, e); if (sym->ts.type == BT_CHARACTER - && sym->ts.deferred && !sym->attr.select_type_temporary + && sym->ts.u.cl->backend_decl && VAR_P (sym->ts.u.cl->backend_decl) && se.string_length != sym->ts.u.cl->backend_decl) - { - gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, + gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl, fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl), se.string_length)); - } /* If we didn't already do the pointer assignment, set associate-name descriptor to the one generated for the temporary. */ diff --git a/gcc/testsuite/gfortran.dg/associate_5.f03 b/gcc/testsuite/gfortran.dg/associate_5.f03 index 64345d323f3..c91f88f4e12 100644 --- a/gcc/testsuite/gfortran.dg/associate_5.f03 +++ b/gcc/testsuite/gfortran.dg/associate_5.f03 @@ -11,7 +11,7 @@ PROGRAM main INTEGER, POINTER :: ptr ASSOCIATE (a => 5) ! { dg-error "is used as array" } - PRINT *, a(3) + PRINT *, a(3) ! { dg-error "has an array reference" } END ASSOCIATE ASSOCIATE (a => nontarget)