From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id B84863858436; Mon, 3 Jul 2023 20:49:39 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org B84863858436 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1688417378; x=1689022178; i=anlauf@gmx.de; bh=NpljhicL3eWxqnwM28xRZMWa84e03nzeYCmdLIQjzb4=; h=X-UI-Sender-Class:Date:Subject:To:References:From:In-Reply-To; b=QSDIGxl85RIbovL/5FL1QAZJ99yworJ2NXcNTQHgaWOAEnumLzMtPeAjAZ4b9UnTW0WCHm/ G/W5aQSJRn6gkAQP3WH+VLDuMNC2M8C6b9lOGflq/dpHHDqtCYvWdAp/buEwjt8kdkiWEX92h bV5qfikbcHBV6F1Sf5qrHQlBqHRaRGNFYdPJ2eq8j8rfTDJRP63IRyNPJ4tpNesBqauT7tqq+ z5o3xYc4ZFNiVjq4efqAjn2Ns5HOhBnva1UXGDuEv9gElQM5DK+IGomANO0GChiUhBwYHpmtr GYdDPAvVjb+IRIuzdP9ce0WZMwcU7H4d0RKnCWQTicg6wI7mUJng== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [192.168.178.29] ([79.232.146.12]) by mail.gmx.net (mrgmx004 [212.227.17.190]) with ESMTPSA (Nemesis) id 1Mlf0K-1pXz7L35RS-00ioo9; Mon, 03 Jul 2023 22:49:37 +0200 Message-ID: <3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de> Date: Mon, 3 Jul 2023 22:49:36 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.12.0 Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178] To: Mikael Morin , fortran , gcc-patches Newsgroups: gmane.comp.gcc.patches,gmane.comp.gcc.fortran References: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr> Content-Language: en-US From: Harald Anlauf In-Reply-To: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: quoted-printable X-Provags-ID: V03:K1:mTjbjamwlG40611yTQ4bwdOX7aPhv6rxYVvjZXGXo/UE/x/Psr+ 7OixdWCokPunR+2zom4jW+WDqS+J9ipgC0vo3d/21bM6J4tjEh75ghzN+A59phVC0qdQxVU OateqKYZM4S7Bbyw2i74jvvodHHQQhNd+LvFdpl/p3xpYcm232W30vb0KIFHrylvG6rNRG+ UAuf3KPqnT7nxGMpkXAdA== UI-OutboundReport: notjunk:1;M01:P0:i5+naDxVWwg=;FabFFt4f25G6VmEqwacI+HRBbli Ea2njanYCowHqorl7J0WI4dF8Fv5mw/WBrmauKNe9AEwEm8UvXzKfA3+kW66gyt09XWo4b7mP +yB6eDq9lBEcwZMNPPTDFfXzyr8gMa8lqiqfL9yKXYZNELpRoiJ4FSlfX5P6DJ644Q0A/LD1U F7op55qNNmJEU2o4lhlFikf0FOiTmj2Sb5lvre1fGJdgSMDCTUHtyhXMJ//pyU/SBCfD+2f8S wAIpHF+ULNE4QCIsnPFAFECmCAWqtU/SNxMnhv55e6ix5w/hVG/x3OOljlnYwNftKnunrfI1k izY3yr8dLm7OgM/kjjS7AXE1hDY6u/hVzqGpU98bCCnm9H/VlL29MEL9O+WiOaqoWJI8owOXz GzKoy11HhSX/5G7HHI/FrLnYvB2tVuwL3bzkEs/sCrbt7o4+wQPtCy+IJW2kLJ30zr651F+fN Vw8NCf6+/AgdhJk3DKjlb18KupiTkngdjEDj0VRllsrhy+7e3arqUH6N2Chca5ohec70CNqJw 9awmC5qun5JEra4Oq2dHEPG4qGC9Zy07U2kS5NNyH2lsoyI5OXJSPFyIhGBsPNsRiYPoirpMG HC/i99901poiQ8IgxOKuR01jeg8fpbAn3oG2wM5e0j006O/sCo4bw8LZ1ia/p78wZgFhczOiV hrobOvjJPQNv9rUTkbZAx/23WJG/M959Etp8sTXMD5OHykJAvIGzG1ZK4kWlNE3WvFm0/ffey tjdpyz3G16yO2rgiusvZYuuAr5C8rS1irg1iAv+LhfL9HNsSm6Ayrs/e7u4zqAr/4NR1ByqVP 46BXXzdLjRpu++E/K2jphJN1oRBghUE2W2JQLdJ2ZB/+v8vCtYoojCsUBcALiEdjIX7avC4br caysDqg0xiAXArGpnmVviPVOw9+hNTHN0nz2lD6FZe3dz47lY5BlFMdYZ6yYeRPGjnK+ZP58L IlEcOqwM27H3Kr8PAs8/jlS8QOw= X-Spam-Status: No, score=-11.0 required=5.0 tests=BAYES_00,BODY_8BITS,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,NICE_REPLY_A,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,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 Mikael, Am 03.07.23 um 13:46 schrieb Mikael Morin: > A few thing to double check below. > >> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc >> index 30946ba3f63..16e8f037cfc 100644 >> --- a/gcc/fortran/trans-expr.cc >> +++ b/gcc/fortran/trans-expr.cc > (...) >> @@ -6117,6 +6118,33 @@ gfc_conv_procedure_call (gfc_se * se, >> gfc_symbol * sym, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && U= NLIMITED_POLY (sym) >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && c= omp && (strcmp ("_copy", comp->name) =3D=3D 0); >> >> +=C2=A0 /* First scan argument list for allocatable actual arguments pa= ssed to >> +=C2=A0=C2=A0=C2=A0=C2=A0 allocatable dummy arguments with INTENT(OUT).= =C2=A0 As the corresponding >> +=C2=A0=C2=A0=C2=A0=C2=A0 actual arguments are deallocated before execu= tion of the >> procedure, we >> +=C2=A0=C2=A0=C2=A0=C2=A0 evaluate actual argument expressions to avoid= problems with >> possible >> +=C2=A0=C2=A0=C2=A0=C2=A0 dependencies.=C2=A0 */ >> +=C2=A0 bool force_eval_args =3D false; >> +=C2=A0 gfc_formal_arglist *tmp_formal; >> +=C2=A0 for (arg =3D args, tmp_formal =3D formal; arg !=3D NULL; >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 arg =3D arg->next, tmp_formal =3D= tmp_formal ? tmp_formal->next : >> NULL) >> +=C2=A0=C2=A0=C2=A0 { >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 e =3D arg->expr; >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 fsym =3D tmp_formal ? tmp_formal->sym := NULL; >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 if (e && fsym >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && e->expr_type =3D=3D EXPR_VARIABLE >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && fsym->attr.intent =3D=3D INTENT_OUT >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && (fsym->ts.type =3D=3D BT_CLASS && fs= ym->attr.class_ok >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 ? CLASS_DATA (f= sym)->attr.allocatable >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 : fsym->attr.al= locatable) >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && e->symtree >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && e->symtree->n.sym >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && gfc_variable_attr (e, NULL).allocata= ble) >> +=C2=A0=C2=A0=C2=A0 { >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 force_eval_args =3D true; >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 break; >> +=C2=A0=C2=A0=C2=A0 } >> +=C2=A0=C2=A0=C2=A0 } >> + > The function is already big enough, would you mind outlining this to its > own function? This can be done. At least it is not part of the monster loop. > >> =C2=A0=C2=A0 /* Evaluate the arguments.=C2=A0 */ >> =C2=A0=C2=A0 for (arg =3D args, argc =3D 0; arg !=3D NULL; >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 arg =3D arg->next, formal = =3D formal ? formal->next : NULL, ++argc) >> @@ -6680,7 +6708,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0 else >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0 tmp =3D gfc_finish_block (&block); >> >> -=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0 gfc_add_expr_to_block (&se->pre, tmp); >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0 gfc_add_expr_to_block (&dealloc_blk, tmp); >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0 } >> >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 /* A class= array element needs converting back to be a >> @@ -6980,7 +7008,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 build_empty_stmt (inpu= t_location)); >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0 } >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0 if (tmp !=3D NULL_TREE) >> -=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0 gfc_add_expr_to_block (&se->pre, tmp); >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0 gfc_add_expr_to_block (&dealloc_blk, tmp); >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 } >> >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 tmp =3D pa= rmse.expr; >> @@ -7004,7 +7032,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 void_type_node, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 gfc_conv_expr_pr= esent (e->symtree->n.sym), >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2= =A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 tmp,= build_empty_stmt (input_location)); >> -=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 gfc_add_expr_to= _block (&se->pre, tmp); >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 gfc_add_expr_to= _block (&dealloc_blk, tmp); >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 } >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 } >> =C2=A0=C2=A0=C2=A0=C2=A0 } > These look good, but I'm surprised that there is no similar change at > the 6819 line. > This is the class array actual vs class array dummy case. > It seems to be checked by the "bar" subroutine in your testcase, except > that the intent(out) argument comes last there, whereas it was coming > first with the original testcases in the PR. > Can you double check? I believe I tried that before and encountered regressions. The change diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 16e8f037cfc..43e013fa720 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6844,7 +6844,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else tmp =3D gfc_finish_block (&block); - gfc_add_expr_to_block (&se->pre, tmp); +// gfc_add_expr_to_block (&se->pre, tmp); + gfc_add_expr_to_block (&dealloc_blk, tmp); } /* The conversion does not repackage the reference to a cla= ss regresses on: gfortran.dg/class_array_16.f90 gfortran.dg/finalize_12.f90 gfortran.dg/optional_class_1.f90 A simplified testcase for further study: program p implicit none class(*), allocatable :: c(:) c =3D [3, 4] call bar (allocated (c), c, allocated (c)) if (allocated (c)) stop 14 contains subroutine bar (alloc, x, alloc2) logical :: alloc, alloc2 class(*), allocatable, intent(out) :: x(:) if (allocated (x)) stop 5 if (.not. alloc) stop 6 if (.not. alloc2) stop 16 end subroutine bar end (This fails in a different place for the posted patch and for the above trial change. Need to go to the drawing board...) >> @@ -7101,6 +7129,21 @@ gfc_conv_procedure_call (gfc_se * se, >> gfc_symbol * sym, >> =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 } >> =C2=A0=C2=A0=C2=A0=C2=A0 } >> >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 /* If any actual argument of the proced= ure is allocatable and >> passed >> +=C2=A0=C2=A0=C2=A0=C2=A0 to an allocatable dummy with INTENT(OUT), we = conservatively >> +=C2=A0=C2=A0=C2=A0=C2=A0 evaluate all actual argument expressions befo= re deallocations are >> +=C2=A0=C2=A0=C2=A0=C2=A0 performed and the procedure is executed.=C2= =A0 This ensures we conform >> +=C2=A0=C2=A0=C2=A0=C2=A0 to F2023:15.5.3, 15.5.4.=C2=A0 Create tempora= ries except for constants, >> +=C2=A0=C2=A0=C2=A0=C2=A0 variables, and functions returning pointers t= hat can appear in a >> +=C2=A0=C2=A0=C2=A0=C2=A0 variable definition context.=C2=A0 */ >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 if (e && fsym && force_eval_args >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && e->expr_type !=3D EXPR_VARIABLE >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && !gfc_is_constant_expr (e) >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && (e->expr_type !=3D EXPR_FUNCTION >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 || !(gfc_expr_a= ttr (e).pointer >> +=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 || gfc_ex= pr_attr (e).proc_pointer))) >> +=C2=A0=C2=A0=C2=A0 parmse.expr =3D gfc_evaluate_now (parmse.expr, &par= mse.pre); >> + > I'm not sure about the guarding condition. > It looks like it may miss evaluation in some cases (one testcase below). > With a value dummy, it is always safe to evaluate to a temporary > variable, and with a non-value dummy, parmse.expr contains a pointer, so > it is safe as well to evaluate that to a temporary pointer? > At least a || fsym->attr.value condition is missing somewhere, but I > think the condition can be reduced to this: > =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 if (e && fsym && force_eval_args > =C2=A0=C2=A0=C2=A0=C2=A0=C2=A0 && !gfc_is_constant_expr (e)) > Were there failures that drove to your above guarding conditions? It seems that your simpler version essentially behaves the same way, at least as far as regtesting is concerned. > > Mikael > > PS: The testcase (as promised): > > program p > =C2=A0 implicit none > =C2=A0 type t > =C2=A0=C2=A0=C2=A0 integer :: i > =C2=A0=C2=A0=C2=A0 integer, pointer :: pi > =C2=A0 end type t > =C2=A0 integer, target :: j > =C2=A0 type(t), allocatable :: ta > =C2=A0 j =3D 1 > =C2=A0 ta =3D t(2, j) > =C2=A0 call assign(ta, id(ta%pi)) > =C2=A0 if (ta%i /=3D 1) stop 1 > =C2=A0 if (associated(ta%pi)) stop 2 > contains > =C2=A0 subroutine assign(a, b) > =C2=A0=C2=A0=C2=A0 type(t), intent(out), allocatable :: a > =C2=A0=C2=A0=C2=A0 integer, intent(in) , value=C2=A0=C2=A0=C2=A0=C2=A0= =C2=A0=C2=A0 :: b > =C2=A0=C2=A0=C2=A0 allocate(a) > =C2=A0=C2=A0=C2=A0 a%i =3D b > =C2=A0=C2=A0=C2=A0 a%pi =3D> null() > =C2=A0 end subroutine assign > =C2=A0 function id(a) > =C2=A0=C2=A0=C2=A0 integer, pointer :: id, a > =C2=A0=C2=A0=C2=A0 id =3D> a > =C2=A0 end function id > end program p Indeed, this is a nice demonstration. While playing, I was wondering whether the following code is conforming: program p call s ((1)) contains subroutine s (x) integer :: x x =3D 42 end subroutine end (It crashes with gfortran, but not with any foreign brand tested). Harald From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from ciao.gmane.io (ciao.gmane.io [116.202.254.214]) by sourceware.org (Postfix) with ESMTPS id 4B309385772C for ; Mon, 3 Jul 2023 20:49:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 4B309385772C Authentication-Results: sourceware.org; dmarc=fail (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=m.gmane-mx.org Received: from list by ciao.gmane.io with local (Exim 4.92) (envelope-from ) id 1qGQUR-0007wy-Jp for gcc-patches@gcc.gnu.org; Mon, 03 Jul 2023 22:49:43 +0200 X-Injected-Via-Gmane: http://gmane.org/ To: gcc-patches@gcc.gnu.org From: Harald Anlauf Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178] Date: Mon, 3 Jul 2023 22:49:36 +0200 Message-ID: <3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de> References: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr> Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.12.0 Content-Language: en-US In-Reply-To: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr> Cc: fortran@gcc.gnu.org X-Spam-Status: No, score=-7.5 required=5.0 tests=BAYES_00,BODY_8BITS,FREEMAIL_FORGED_FROMDOMAIN,FREEMAIL_FROM,GIT_PATCH_0,HEADER_FROM_DIFFERENT_DOMAINS,KAM_DMARC_STATUS,NICE_REPLY_A,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: Message-ID: <20230703204936.2bROsCB3EYZx4yIrpqcaPDVuT77MoJbJmfMo6AwPHD4@z> Hi Mikael, Am 03.07.23 um 13:46 schrieb Mikael Morin: > A few thing to double check below. > >> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc >> index 30946ba3f63..16e8f037cfc 100644 >> --- a/gcc/fortran/trans-expr.cc >> +++ b/gcc/fortran/trans-expr.cc > (...) >> @@ -6117,6 +6118,33 @@ gfc_conv_procedure_call (gfc_se * se, >> gfc_symbol * sym, >>             && UNLIMITED_POLY (sym) >>             && comp && (strcmp ("_copy", comp->name) == 0); >> >> +  /* First scan argument list for allocatable actual arguments passed to >> +     allocatable dummy arguments with INTENT(OUT).  As the corresponding >> +     actual arguments are deallocated before execution of the >> procedure, we >> +     evaluate actual argument expressions to avoid problems with >> possible >> +     dependencies.  */ >> +  bool force_eval_args = false; >> +  gfc_formal_arglist *tmp_formal; >> +  for (arg = args, tmp_formal = formal; arg != NULL; >> +       arg = arg->next, tmp_formal = tmp_formal ? tmp_formal->next : >> NULL) >> +    { >> +      e = arg->expr; >> +      fsym = tmp_formal ? tmp_formal->sym : NULL; >> +      if (e && fsym >> +      && e->expr_type == EXPR_VARIABLE >> +      && fsym->attr.intent == INTENT_OUT >> +      && (fsym->ts.type == BT_CLASS && fsym->attr.class_ok >> +          ? CLASS_DATA (fsym)->attr.allocatable >> +          : fsym->attr.allocatable) >> +      && e->symtree >> +      && e->symtree->n.sym >> +      && gfc_variable_attr (e, NULL).allocatable) >> +    { >> +      force_eval_args = true; >> +      break; >> +    } >> +    } >> + > The function is already big enough, would you mind outlining this to its > own function? This can be done. At least it is not part of the monster loop. > >>    /* Evaluate the arguments.  */ >>    for (arg = args, argc = 0; arg != NULL; >>         arg = arg->next, formal = formal ? formal->next : NULL, ++argc) >> @@ -6680,7 +6708,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >>                else >>              tmp = gfc_finish_block (&block); >> >> -              gfc_add_expr_to_block (&se->pre, tmp); >> +              gfc_add_expr_to_block (&dealloc_blk, tmp); >>              } >> >>            /* A class array element needs converting back to be a >> @@ -6980,7 +7008,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >>                      build_empty_stmt (input_location)); >>                } >>              if (tmp != NULL_TREE) >> -              gfc_add_expr_to_block (&se->pre, tmp); >> +              gfc_add_expr_to_block (&dealloc_blk, tmp); >>            } >> >>            tmp = parmse.expr; >> @@ -7004,7 +7032,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol >> * sym, >>                       void_type_node, >>                       gfc_conv_expr_present (e->symtree->n.sym), >>                         tmp, build_empty_stmt (input_location)); >> -          gfc_add_expr_to_block (&se->pre, tmp); >> +          gfc_add_expr_to_block (&dealloc_blk, tmp); >>          } >>          } >>      } > These look good, but I'm surprised that there is no similar change at > the 6819 line. > This is the class array actual vs class array dummy case. > It seems to be checked by the "bar" subroutine in your testcase, except > that the intent(out) argument comes last there, whereas it was coming > first with the original testcases in the PR. > Can you double check? I believe I tried that before and encountered regressions. The change diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 16e8f037cfc..43e013fa720 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6844,7 +6844,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else tmp = gfc_finish_block (&block); - gfc_add_expr_to_block (&se->pre, tmp); +// gfc_add_expr_to_block (&se->pre, tmp); + gfc_add_expr_to_block (&dealloc_blk, tmp); } /* The conversion does not repackage the reference to a class regresses on: gfortran.dg/class_array_16.f90 gfortran.dg/finalize_12.f90 gfortran.dg/optional_class_1.f90 A simplified testcase for further study: program p implicit none class(*), allocatable :: c(:) c = [3, 4] call bar (allocated (c), c, allocated (c)) if (allocated (c)) stop 14 contains subroutine bar (alloc, x, alloc2) logical :: alloc, alloc2 class(*), allocatable, intent(out) :: x(:) if (allocated (x)) stop 5 if (.not. alloc) stop 6 if (.not. alloc2) stop 16 end subroutine bar end (This fails in a different place for the posted patch and for the above trial change. Need to go to the drawing board...) >> @@ -7101,6 +7129,21 @@ gfc_conv_procedure_call (gfc_se * se, >> gfc_symbol * sym, >>          } >>      } >> >> +      /* If any actual argument of the procedure is allocatable and >> passed >> +     to an allocatable dummy with INTENT(OUT), we conservatively >> +     evaluate all actual argument expressions before deallocations are >> +     performed and the procedure is executed.  This ensures we conform >> +     to F2023:15.5.3, 15.5.4.  Create temporaries except for constants, >> +     variables, and functions returning pointers that can appear in a >> +     variable definition context.  */ >> +      if (e && fsym && force_eval_args >> +      && e->expr_type != EXPR_VARIABLE >> +      && !gfc_is_constant_expr (e) >> +      && (e->expr_type != EXPR_FUNCTION >> +          || !(gfc_expr_attr (e).pointer >> +           || gfc_expr_attr (e).proc_pointer))) >> +    parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre); >> + > I'm not sure about the guarding condition. > It looks like it may miss evaluation in some cases (one testcase below). > With a value dummy, it is always safe to evaluate to a temporary > variable, and with a non-value dummy, parmse.expr contains a pointer, so > it is safe as well to evaluate that to a temporary pointer? > At least a || fsym->attr.value condition is missing somewhere, but I > think the condition can be reduced to this: >       if (e && fsym && force_eval_args >       && !gfc_is_constant_expr (e)) > Were there failures that drove to your above guarding conditions? It seems that your simpler version essentially behaves the same way, at least as far as regtesting is concerned. > > Mikael > > PS: The testcase (as promised): > > program p >   implicit none >   type t >     integer :: i >     integer, pointer :: pi >   end type t >   integer, target :: j >   type(t), allocatable :: ta >   j = 1 >   ta = t(2, j) >   call assign(ta, id(ta%pi)) >   if (ta%i /= 1) stop 1 >   if (associated(ta%pi)) stop 2 > contains >   subroutine assign(a, b) >     type(t), intent(out), allocatable :: a >     integer, intent(in) , value       :: b >     allocate(a) >     a%i = b >     a%pi => null() >   end subroutine assign >   function id(a) >     integer, pointer :: id, a >     id => a >   end function id > end program p Indeed, this is a nice demonstration. While playing, I was wondering whether the following code is conforming: program p call s ((1)) contains subroutine s (x) integer :: x x = 42 end subroutine end (It crashes with gfortran, but not with any foreign brand tested). Harald