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