From: Harald Anlauf <anlauf@gmx.de>
To: Mikael Morin <morin-mikael@orange.fr>,
fortran <fortran@gcc.gnu.org>,
gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178]
Date: Mon, 3 Jul 2023 22:49:36 +0200 [thread overview]
Message-ID: <3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de> (raw)
In-Reply-To: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr>
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
WARNING: multiple messages have this Message-ID
From: Harald Anlauf <anlauf@gmx.de>
To: gcc-patches@gcc.gnu.org
Cc: fortran@gcc.gnu.org
Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178]
Date: Mon, 3 Jul 2023 22:49:36 +0200 [thread overview]
Message-ID: <3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de> (raw)
Message-ID: <20230703204936.2bROsCB3EYZx4yIrpqcaPDVuT77MoJbJmfMo6AwPHD4@z> (raw)
In-Reply-To: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr>
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
next prev parent reply other threads:[~2023-07-03 20:49 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-02 20:38 Harald Anlauf
2023-07-03 11:46 ` Mikael Morin
2023-07-03 20:49 ` Harald Anlauf [this message]
2023-07-03 20:49 ` Harald Anlauf
2023-07-03 23:56 ` Steve Kargl
2023-07-04 9:26 ` Mikael Morin
2023-07-04 15:50 ` Steve Kargl
2023-07-04 13:35 ` Mikael Morin
2023-07-04 19:00 ` Harald Anlauf
2023-07-04 19:00 ` Harald Anlauf
2023-07-04 19:37 ` Mikael Morin
2023-07-05 14:54 ` Mikael Morin
2023-07-05 20:36 ` Harald Anlauf
2023-07-05 20:36 ` Harald Anlauf
2023-07-07 12:21 ` Mikael Morin
2023-07-07 18:23 ` Harald Anlauf
2023-07-07 18:23 ` Harald Anlauf
2023-07-08 12:07 ` Mikael Morin
2023-07-08 14:20 ` Harald Anlauf
2023-07-08 14:20 ` Harald Anlauf
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de \
--to=anlauf@gmx.de \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
--cc=morin-mikael@orange.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).