From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-qk1-x72b.google.com (mail-qk1-x72b.google.com [IPv6:2607:f8b0:4864:20::72b]) by sourceware.org (Postfix) with ESMTPS id A66F53858CDB; Fri, 14 Jul 2023 05:55:19 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org A66F53858CDB Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmail.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmail.com Received: by mail-qk1-x72b.google.com with SMTP id af79cd13be357-76714d3c3a7so150693985a.3; Thu, 13 Jul 2023 22:55:19 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20221208; t=1689314118; x=1691906118; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:from:to:cc:subject:date:message-id:reply-to; bh=6gekw84peyO0il1kSzCY3j8ffbltg2001W+jbU6wHuw=; b=jCAQQtWhCvL6KWpiDpB1mpEE1j7bTf0LkwtluhNyD7nQaB0ti40ajy1a9WfnoPhXb4 eBwzMsPYBUu7q4L7PFaeox+WzCz/pAM2vKw4dTJwszlQQo2h6tO9onHh7nGaZzxbUKyW mXARqTVjCY/jenrUoI7iv/qYPvXAHyLE6KKgGq9NeepH8H4/tRdyb/m3bnJ+ybGhzzTX UEgjGv5mWRyA6+xNrbNQGVsBJ9QF9iM4HkM83lzN/bZ/IJZmHZuQtNsZRmCnxBnBWjGZ ktBtXtZykcahR+/04Py4HSKBu9a1vO7fCZ6W1WQRBVgzROTVZGnK5ntKKDUwPZVXKSo6 BIlQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1689314118; x=1691906118; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=6gekw84peyO0il1kSzCY3j8ffbltg2001W+jbU6wHuw=; b=jn6WUhGZj8Rk5CCEHsc6XGKAcJT2RAKnDRFfW96uUrq7huQ9nfabG20WfaUlWISZOK Y5d8exq0JUaw9zDcdOVw9C7wfU0QGJUNQeIrEmpeVx8PTSERaUtN1/r2PXWZIbR5j00V FHy2ZuEdm1+roJUYyAcneHdWPpgaxYoD67Ud9mQw+ZTpfkRYJmtDFb+b4/Yy90xC+Rbe YVaSX7Tv8mHHqWExl5JuwaHAk24Hz08ljqbz6UkFKa5sJUKwrrQ7Mrsarz78b8DGpapk llxOPC1tcedo6OcrMkElpxlVuB/Oqb9riM3ZBjsKpkhSVe8wn07BOy/PokrhcZom9amn uPkA== X-Gm-Message-State: ABy/qLb17ztMIHaIVWyhJnYUtj2pqbD8onC0qzjy8UZEzIVWtx3LJdWG 6/b9ti1T4uQX/TPmYXH21hfGduXMgLZRidu9gfldypi+ X-Google-Smtp-Source: APBJJlHhUymrRzv9GMBFgnTWo+/SNuIAZax9kirKG1upDC+skmpT84sF7Udf86URvEm6stLh8FFKiYDCHk5FrJQVacA= X-Received: by 2002:a05:620a:2055:b0:767:4d85:2670 with SMTP id d21-20020a05620a205500b007674d852670mr3037222qka.37.1689314118193; Thu, 13 Jul 2023 22:55:18 -0700 (PDT) MIME-Version: 1.0 References: <20230713085236.330222-1-mikael@gcc.gnu.org> <20230713085236.330222-15-mikael@gcc.gnu.org> In-Reply-To: <20230713085236.330222-15-mikael@gcc.gnu.org> From: Paul Richard Thomas Date: Fri, 14 Jul 2023 06:55:06 +0100 Message-ID: Subject: Re: [PATCH 14/14] fortran: Pass pre-calculated class container argument [pr110618] To: Mikael Morin Cc: fortran@gcc.gnu.org Content-Type: text/plain; charset="UTF-8" X-Spam-Status: No, score=-7.6 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 List-Id: Hi Mikhail, This patch uses a field for gfc_se called class container, which is neither declared nor set as far as I can tell. Regards Paul On Thu, 13 Jul 2023 at 10:05, Mikael Morin via Fortran wrote: > > Pass already evaluated class container argument from > gfc_conv_procedure_call down to gfc_add_finalizer_call through > gfc_deallocate_scalar_with_status and gfc_deallocate_with_status, > to avoid repeatedly evaluating the same data reference expressions > in the generated code. > > PR fortran/110618 > > gcc/fortran/ChangeLog: > > * trans.h (gfc_deallocate_with_status): Add class container > argument. > (gfc_deallocate_scalar_with_status): Ditto. > * trans.cc (gfc_deallocate_with_status): Add class container > argument and pass it down to gfc_add_finalize_call. > (gfc_deallocate_scalar_with_status): Same. > * trans-array.cc (structure_alloc_comps): Update caller. > * trans-stmt.cc (gfc_trans_deallocate): Ditto. > * trans-expr.cc (gfc_conv_procedure_call): Ditto. Pass > pre-evaluated class container argument if it's available. > > gcc/testsuite/ChangeLog: > > * gfortran.dg/intent_out_22.f90: New test. > --- > gcc/fortran/trans-array.cc | 2 +- > gcc/fortran/trans-expr.cc | 7 ++-- > gcc/fortran/trans-stmt.cc | 3 +- > gcc/fortran/trans.cc | 11 +++--- > gcc/fortran/trans.h | 7 ++-- > gcc/testsuite/gfortran.dg/intent_out_22.f90 | 37 +++++++++++++++++++++ > 6 files changed, 55 insertions(+), 12 deletions(-) > create mode 100644 gcc/testsuite/gfortran.dg/intent_out_22.f90 > > diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc > index 1c2af55d436..951cecfa5d5 100644 > --- a/gcc/fortran/trans-array.cc > +++ b/gcc/fortran/trans-array.cc > @@ -9472,7 +9472,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest, > > tmp = gfc_deallocate_with_status (comp, NULL_TREE, NULL_TREE, > NULL_TREE, NULL_TREE, true, > - NULL, caf_dereg_mode, > + NULL, caf_dereg_mode, NULL_TREE, > add_when_allocated, caf_token); > > gfc_add_expr_to_block (&tmpblock, tmp); > diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc > index dbb04f8c434..8258543b456 100644 > --- a/gcc/fortran/trans-expr.cc > +++ b/gcc/fortran/trans-expr.cc > @@ -6706,9 +6706,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, > if (e->ts.type == BT_CLASS) > ptr = gfc_class_data_get (ptr); > > + tree cls = parmse.class_container; > tmp = gfc_deallocate_scalar_with_status (ptr, NULL_TREE, > NULL_TREE, true, > - e, e->ts); > + e, e->ts, cls); > gfc_add_expr_to_block (&block, tmp); > tmp = fold_build2_loc (input_location, MODIFY_EXPR, > void_type_node, ptr, > @@ -6900,10 +6901,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, > ptr = parmse.expr; > ptr = gfc_class_data_get (ptr); > > + tree cls = parmse.class_container; > tmp = gfc_deallocate_with_status (ptr, NULL_TREE, > NULL_TREE, NULL_TREE, > NULL_TREE, true, e, > - GFC_CAF_COARRAY_NOCOARRAY); > + GFC_CAF_COARRAY_NOCOARRAY, > + cls); > gfc_add_expr_to_block (&block, tmp); > tmp = fold_build2_loc (input_location, MODIFY_EXPR, > void_type_node, ptr, > diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc > index 7e768343a57..93f36bfb955 100644 > --- a/gcc/fortran/trans-stmt.cc > +++ b/gcc/fortran/trans-stmt.cc > @@ -7462,7 +7462,8 @@ gfc_trans_deallocate (gfc_code *code) > { > tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, label_finish, > false, al->expr, > - al->expr->ts, is_coarray); > + al->expr->ts, NULL_TREE, > + is_coarray); > gfc_add_expr_to_block (&se.pre, tmp); > > /* Set to zero after deallocation. */ > diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc > index 18965b9cbd2..569fad45031 100644 > --- a/gcc/fortran/trans.cc > +++ b/gcc/fortran/trans.cc > @@ -1777,8 +1777,8 @@ tree > gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, > tree errlen, tree label_finish, > bool can_fail, gfc_expr* expr, > - int coarray_dealloc_mode, tree add_when_allocated, > - tree caf_token) > + int coarray_dealloc_mode, tree class_container, > + tree add_when_allocated, tree caf_token) > { > stmtblock_t null, non_null; > tree cond, tmp, error; > @@ -1872,7 +1872,7 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, > gfc_start_block (&non_null); > if (add_when_allocated) > gfc_add_expr_to_block (&non_null, add_when_allocated); > - gfc_add_finalizer_call (&non_null, expr); > + gfc_add_finalizer_call (&non_null, expr, class_container); > if (coarray_dealloc_mode == GFC_CAF_COARRAY_NOCOARRAY > || flag_coarray != GFC_FCOARRAY_LIB) > { > @@ -1977,7 +1977,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, > tree > gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, > bool can_fail, gfc_expr* expr, > - gfc_typespec ts, bool coarray) > + gfc_typespec ts, tree class_container, > + bool coarray) > { > stmtblock_t null, non_null; > tree cond, tmp, error; > @@ -2030,7 +2031,7 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, tree label_finish, > gfc_start_block (&non_null); > > /* Free allocatable components. */ > - finalizable = gfc_add_finalizer_call (&non_null, expr); > + finalizable = gfc_add_finalizer_call (&non_null, expr, class_container); > if (!finalizable && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp) > { > int caf_mode = coarray > diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h > index be9ccbc3d29..109d7647235 100644 > --- a/gcc/fortran/trans.h > +++ b/gcc/fortran/trans.h > @@ -771,10 +771,11 @@ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree); > > /* Generate code to deallocate an array. */ > tree gfc_deallocate_with_status (tree, tree, tree, tree, tree, bool, > - gfc_expr *, int, tree a = NULL_TREE, > - tree c = NULL_TREE); > + gfc_expr *, int, tree = NULL_TREE, > + tree a = NULL_TREE, tree c = NULL_TREE); > tree gfc_deallocate_scalar_with_status (tree, tree, tree, bool, gfc_expr*, > - gfc_typespec, bool c = false); > + gfc_typespec, tree = NULL_TREE, > + bool c = false); > > /* Generate code to call realloc(). */ > tree gfc_call_realloc (stmtblock_t *, tree, tree); > diff --git a/gcc/testsuite/gfortran.dg/intent_out_22.f90 b/gcc/testsuite/gfortran.dg/intent_out_22.f90 > new file mode 100644 > index 00000000000..a38afccf0e5 > --- /dev/null > +++ b/gcc/testsuite/gfortran.dg/intent_out_22.f90 > @@ -0,0 +1,37 @@ > +! { dg-do run } > +! > +! PR fortran/110618 > +! Check that if a data reference is passed as actual argument whose dummy > +! has INTENT(OUT) attribute, any other argument depending on the > +! same data reference is evaluated before the data reference deallocation. > + > +program p > + implicit none > + type t > + integer :: i > + end type t > + type u > + class(t), allocatable :: ta(:) > + end type u > + type(u), allocatable :: c(:) > + class(t), allocatable :: d(:) > + allocate(c, source = [u([t(1), t(3)]), u([t(4), t(9)])]) > + allocate(d, source = [t(1), t(5)]) > + call bar ( & > + allocated(c(d(1)%i)%ta), & > + d, & > + c(d(1)%i)%ta, & > + allocated (c(d(1)%i)%ta) & > + ) > + if (allocated (c(1)%ta)) stop 11 > + if (.not. allocated (c(2)%ta)) stop 11 > +contains > + subroutine bar (alloc, x, y, alloc2) > + logical :: alloc, alloc2 > + class(t), allocatable, intent(out) :: x(:) > + class(t), allocatable, intent(out) :: y(:) > + if (allocated (x)) stop 1 > + if (.not. alloc) stop 2 > + if (.not. alloc2) stop 3 > + end subroutine bar > +end > -- > 2.40.1 > -- "If you can't explain it simply, you don't understand it well enough" - Albert Einstein