[v3] Fortran: ordering of hidden procedure arguments [PR107441]
Checks
Commit Message
Dear all,
Am 04.11.22 um 10:53 schrieb Mikael Morin:
> Le 03/11/2022 à 23:03, Harald Anlauf a écrit :
>> I've spent some time not only staring at create_function_arglist,
>> but trying several variations handling the declared hidden parms,
>> and applying the necessary adjustments to gfc_get_function_type.
>> (Managing linked trees is not the issue, just understanding them.)
>> I've been unable to get the declarations in sync, and would need
>> help how to debug the mess I've created. Dropping my patch for
>> the time being.
>>
> If you want, we can meet on IRC somewhen (tonight?).
armed with the new knowledge, I could now understand what
(more or less) trivially went wrong with my previous patch.
The attached patch remedies that: gfc_get_function_type() now
properly separates the types of the hidden parameters so that
optional+value comes before string length and caf stuff,
while in create_function_arglist we simply need to split
the walking over the typelists so that the optional+value
stuff, which is basically just booleans, is done separately
from the other parts.
Looking at the tree-dumps, the function decls now seem to be
fine at least for the given testcases. I've adjusted one of
the testcases to validate this.
Regtests fine on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
Comments
Hello,
Le 07/11/2022 à 22:45, Harald Anlauf via Fortran a écrit :
> Dear all,
>
> Am 04.11.22 um 10:53 schrieb Mikael Morin:
>> Le 03/11/2022 à 23:03, Harald Anlauf a écrit :
>>> I've spent some time not only staring at create_function_arglist,
>>> but trying several variations handling the declared hidden parms,
>>> and applying the necessary adjustments to gfc_get_function_type.
>>> (Managing linked trees is not the issue, just understanding them.)
>>> I've been unable to get the declarations in sync, and would need
>>> help how to debug the mess I've created. Dropping my patch for
>>> the time being.
>>>
>> If you want, we can meet on IRC somewhen (tonight?).
>
> armed with the new knowledge, I could now understand what
> (more or less) trivially went wrong with my previous patch.
>
> The attached patch remedies that: gfc_get_function_type() now
> properly separates the types of the hidden parameters so that
> optional+value comes before string length and caf stuff,
> while in create_function_arglist we simply need to split
> the walking over the typelists so that the optional+value
> stuff, which is basically just booleans, is done separately
> from the other parts.
>
> Looking at the tree-dumps, the function decls now seem to be
> fine at least for the given testcases. I've adjusted one of
> the testcases to validate this.
>
> Regtests fine on x86_64-pc-linux-gnu. OK for mainline?
>
this is mostly good.
There is one last corner case that is not properly handled:
> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
> index 63515b9072a..94988b8690e 100644
> --- a/gcc/fortran/trans-decl.cc
> +++ b/gcc/fortran/trans-decl.cc
(...)
> @@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
> if (f->sym != NULL) /* Ignore alternate returns. */
> hidden_typelist = TREE_CHAIN (hidden_typelist);
>
> + /* Advance hidden_typelist over optional+value argument presence flags. */
> + optval_typelist = hidden_typelist;
> + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
> + if (f->sym != NULL
> + && f->sym->attr.optional && f->sym->attr.value
> + && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
> + && !gfc_bt_struct (f->sym->ts.type))
> + hidden_typelist = TREE_CHAIN (hidden_typelist);
> +
This new loop copies the condition guarding the handling of optional
value presence arguments, except that the condition is in an "else if",
and the complement of the condition in the corresponding "if" is
missing, to have strictly the same conditions.
Admittedly, it only makes a difference for character optional value
arguments, which are hardly working. At least they work as long as one
doesn't try to query their presence. Below is a case regressing with
your patch.
With that fixed, I think it's good for mainline.
Thanks for your patience.
! { dg-do compile }
!
! PR fortran/107441
! Check that procedure types and procedure decls match when the procedure
! has both character-typed and character-typed optional value args.
!
! Contributed by M.Morin
program p
interface
subroutine i(c, o)
character(*) :: c
character(3), optional, value :: o
end subroutine i
end interface
procedure(i), pointer :: pp
pp => s
call pp("abcd", "xyz")
contains
subroutine s(c, o)
character(*) :: c
character(3), optional, value :: o
if (o /= "xyz") stop 1
if (c /= "abcd") stop 2
end subroutine s
end program p
Hi Mikael,
Am 08.11.22 um 11:32 schrieb Mikael Morin:
> this is mostly good.
> There is one last corner case that is not properly handled:
>
>> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
>> index 63515b9072a..94988b8690e 100644
>> --- a/gcc/fortran/trans-decl.cc
>> +++ b/gcc/fortran/trans-decl.cc
> (...)
>> @@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
>> if (f->sym != NULL) /* Ignore alternate returns. */
>> hidden_typelist = TREE_CHAIN (hidden_typelist);
>>
>> + /* Advance hidden_typelist over optional+value argument presence
>> flags. */
>> + optval_typelist = hidden_typelist;
>> + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
>> + if (f->sym != NULL
>> + && f->sym->attr.optional && f->sym->attr.value
>> + && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
>> + && !gfc_bt_struct (f->sym->ts.type))
>> + hidden_typelist = TREE_CHAIN (hidden_typelist);
>> +
>
> This new loop copies the condition guarding the handling of optional
> value presence arguments, except that the condition is in an "else if",
> and the complement of the condition in the corresponding "if" is
> missing, to have strictly the same conditions.
I know, and I left that intentionally, as it is related to
PR107444, assuming that it doesn't lead to a new ICE. Bad idea.
> Admittedly, it only makes a difference for character optional value
> arguments, which are hardly working. At least they work as long as one
> doesn't try to query their presence. Below is a case regressing with
> your patch.
> With that fixed, I think it's good for mainline.
> Thanks for your patience.
>
>
> ! { dg-do compile }
> !
> ! PR fortran/107441
> ! Check that procedure types and procedure decls match when the procedure
> ! has both character-typed and character-typed optional value args.
> !
> ! Contributed by M.Morin
>
> program p
> interface
> subroutine i(c, o)
> character(*) :: c
> character(3), optional, value :: o
> end subroutine i
> end interface
> procedure(i), pointer :: pp
> pp => s
> call pp("abcd", "xyz")
> contains
> subroutine s(c, o)
> character(*) :: c
> character(3), optional, value :: o
> if (o /= "xyz") stop 1
> if (c /= "abcd") stop 2
> end subroutine s
> end program p
Well, that testcase may compile with 12-branch, but it gives
wrong code. Furthermore, it is arguably invalid, as you are
currently unable to check the presence of the optional argument
due to PR107444. I am therefore reluctant to have that testcase
now.
To fix that, we may have to bite the bullet and break the
documented ABI, or rather update it, as character,value,optional
is broken in all current gfortran versions, and the documentation
is not completely consistent. I had planned to do this with the
fix for PR107444, which want to keep separate from the current
patch for good reasons.
I have modified my patch so that your testcase above compiles
and runs. But as explained, I don't want to add it now.
Regtested again. What do you think?
Thanks,
Harald
Le 08/11/2022 à 21:31, Harald Anlauf a écrit :
> Hi Mikael,
>
> Am 08.11.22 um 11:32 schrieb Mikael Morin:
>> this is mostly good.
>> There is one last corner case that is not properly handled:
>>
>>> diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
>>> index 63515b9072a..94988b8690e 100644
>>> --- a/gcc/fortran/trans-decl.cc
>>> +++ b/gcc/fortran/trans-decl.cc
>> (...)
>>> @@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
>>> if (f->sym != NULL) /* Ignore alternate returns. */
>>> hidden_typelist = TREE_CHAIN (hidden_typelist);
>>>
>>> + /* Advance hidden_typelist over optional+value argument presence
>>> flags. */
>>> + optval_typelist = hidden_typelist;
>>> + for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
>>> + if (f->sym != NULL
>>> + && f->sym->attr.optional && f->sym->attr.value
>>> + && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
>>> + && !gfc_bt_struct (f->sym->ts.type))
>>> + hidden_typelist = TREE_CHAIN (hidden_typelist);
>>> +
>>
>> This new loop copies the condition guarding the handling of optional
>> value presence arguments, except that the condition is in an "else if",
>> and the complement of the condition in the corresponding "if" is
>> missing, to have strictly the same conditions.
>
> I know, and I left that intentionally, as it is related to
> PR107444, assuming that it doesn't lead to a new ICE. Bad idea.
>
>> Admittedly, it only makes a difference for character optional value
>> arguments, which are hardly working. At least they work as long as one
>> doesn't try to query their presence. Below is a case regressing with
>> your patch.
>
>> With that fixed, I think it's good for mainline.
>> Thanks for your patience.
>>
>>
>> ! { dg-do compile }
>> !
>> ! PR fortran/107441
>> ! Check that procedure types and procedure decls match when the procedure
>> ! has both character-typed and character-typed optional value args.
>> !
>> ! Contributed by M.Morin
>>
>> program p
>> interface
>> subroutine i(c, o)
>> character(*) :: c
>> character(3), optional, value :: o
>> end subroutine i
>> end interface
>> procedure(i), pointer :: pp
>> pp => s
>> call pp("abcd", "xyz")
>> contains
>> subroutine s(c, o)
>> character(*) :: c
>> character(3), optional, value :: o
>> if (o /= "xyz") stop 1
>> if (c /= "abcd") stop 2
>> end subroutine s
>> end program p
>
> Well, that testcase may compile with 12-branch, but it gives
> wrong code. Furthermore, it is arguably invalid, as you are
> currently unable to check the presence of the optional argument
> due to PR107444. I am therefore reluctant to have that testcase
> now.
>
> To fix that, we may have to bite the bullet and break the
> documented ABI, or rather update it, as character,value,optional
> is broken in all current gfortran versions, and the documentation
> is not completely consistent. I had planned to do this with the
> fix for PR107444, which want to keep separate from the current
> patch for good reasons.
>
> I have modified my patch so that your testcase above compiles
> and runs. But as explained, I don't want to add it now.
>
> Regtested again. What do you think?
>
Let's proceed with the v3 then. Character optional value arguments are
corner cases anyway.
From 7ba433c9c22e206532a9abcad8ff1b22d3f77b3a Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Fri, 28 Oct 2022 21:58:08 +0200
Subject: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]
The gfortran ABI specifies the order of given and hidden procedure arguments,
where the hidden presence status flags of optional+value scalar arguments
shall come before character length, coarray token and offset.
gcc/fortran/ChangeLog:
PR fortran/107441
* trans-decl.cc (create_function_arglist): Adjust the ordering of
automatically generated hidden procedure arguments to match the
documented ABI for gfortran.
* trans-types.cc (gfc_get_function_type): Separate hidden parameters
so that the presence flag for optional+value arguments come before
string length, coarray token and offset, as required.
gcc/testsuite/ChangeLog:
PR fortran/107441
* gfortran.dg/coarray/pr107441-caf.f90: New test.
* gfortran.dg/optional_absent_6.f90: New test.
* gfortran.dg/optional_absent_7.f90: New test.
---
gcc/fortran/trans-decl.cc | 23 +++++--
gcc/fortran/trans-types.cc | 11 +++-
.../gfortran.dg/coarray/pr107441-caf.f90 | 27 +++++++++
.../gfortran.dg/optional_absent_6.f90 | 60 +++++++++++++++++++
.../gfortran.dg/optional_absent_7.f90 | 31 ++++++++++
5 files changed, 145 insertions(+), 7 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_6.f90
create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -2507,8 +2507,8 @@ create_function_arglist (gfc_symbol * sym)
{
tree fndecl;
gfc_formal_arglist *f;
- tree typelist, hidden_typelist;
- tree arglist, hidden_arglist;
+ tree typelist, hidden_typelist, optval_typelist;
+ tree arglist, hidden_arglist, optval_arglist;
tree type;
tree parm;
@@ -2518,6 +2518,7 @@ create_function_arglist (gfc_symbol * sym)
the new FUNCTION_DECL node. */
arglist = NULL_TREE;
hidden_arglist = NULL_TREE;
+ optval_arglist = NULL_TREE;
typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));
if (sym->attr.entry_master)
@@ -2619,6 +2620,15 @@ create_function_arglist (gfc_symbol * sym)
if (f->sym != NULL) /* Ignore alternate returns. */
hidden_typelist = TREE_CHAIN (hidden_typelist);
+ /* Advance hidden_typelist over optional+value argument presence flags. */
+ optval_typelist = hidden_typelist;
+ for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
+ if (f->sym != NULL
+ && f->sym->attr.optional && f->sym->attr.value
+ && !f->sym->attr.dimension && f->sym->ts.type != BT_CLASS
+ && !gfc_bt_struct (f->sym->ts.type))
+ hidden_typelist = TREE_CHAIN (hidden_typelist);
+
for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
{
char name[GFC_MAX_SYMBOL_LEN + 2];
@@ -2712,14 +2722,16 @@ create_function_arglist (gfc_symbol * sym)
PARM_DECL, get_identifier (name),
boolean_type_node);
- hidden_arglist = chainon (hidden_arglist, tmp);
+ optval_arglist = chainon (optval_arglist, tmp);
DECL_CONTEXT (tmp) = fndecl;
DECL_ARTIFICIAL (tmp) = 1;
DECL_ARG_TYPE (tmp) = boolean_type_node;
TREE_READONLY (tmp) = 1;
gfc_finish_decl (tmp);
- hidden_typelist = TREE_CHAIN (hidden_typelist);
+ /* The presence flag must be boolean. */
+ gcc_assert (TREE_VALUE (optval_typelist) == boolean_type_node);
+ optval_typelist = TREE_CHAIN (optval_typelist);
}
/* For non-constant length array arguments, make sure they use
@@ -2863,6 +2875,9 @@ create_function_arglist (gfc_symbol * sym)
typelist = TREE_CHAIN (typelist);
}
+ /* Add hidden present status for optional+value arguments. */
+ arglist = chainon (arglist, optval_arglist);
+
/* Add the hidden string length parameters, unless the procedure
is bind(C). */
if (!sym->attr.is_bind_c)
@@ -3105,6 +3105,7 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
{
tree type;
vec<tree, va_gc> *typelist = NULL;
+ vec<tree, va_gc> *hidden_typelist = NULL;
gfc_formal_arglist *f;
gfc_symbol *arg;
int alternate_return = 0;
@@ -3222,7 +3223,7 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
so that the value can be returned. */
type = build_pointer_type (gfc_charlen_type_node);
- vec_safe_push (typelist, type);
+ vec_safe_push (hidden_typelist, type);
}
/* For noncharacter scalar intrinsic types, VALUE passes the value,
hence, the optional status cannot be transferred via a NULL pointer.
@@ -3245,11 +3246,15 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args,
&& CLASS_DATA (arg)->attr.codimension
&& !CLASS_DATA (arg)->attr.allocatable)))
{
- vec_safe_push (typelist, pvoid_type_node); /* caf_token. */
- vec_safe_push (typelist, gfc_array_index_type); /* caf_offset. */
+ vec_safe_push (hidden_typelist, pvoid_type_node); /* caf_token. */
+ vec_safe_push (hidden_typelist, gfc_array_index_type); /* caf_offset. */
}
}
+ /* Put hidden character length, caf_token, caf_offset at the end. */
+ vec_safe_reserve (typelist, vec_safe_length (hidden_typelist));
+ vec_safe_splice (typelist, hidden_typelist);
+
if (!vec_safe_is_empty (typelist)
|| sym->attr.is_main_program
|| sym->attr.if_source != IFSRC_UNKNOWN)
new file mode 100644
@@ -0,0 +1,27 @@
+! { dg-do run }
+!
+! PR fortran/107441
+! Check that with -fcoarray=lib, coarray metadata arguments are passed
+! in the right order to procedures.
+!
+! Contributed by M.Morin
+
+program p
+ integer :: ci[*]
+ ci = 17
+ call s(1, ci, "abcd")
+contains
+ subroutine s(ra, ca, c)
+ integer :: ra, ca[*]
+ character(*) :: c
+ ca[1] = 13
+ if (ra /= 1) stop 1
+ if (this_image() == 1) then
+ if (ca /= 13) stop 2
+ else
+ if (ca /= 17) stop 3
+ end if
+ if (len(c) /= 4) stop 4
+ if (c /= "abcd") stop 5
+ end subroutine s
+end program p
new file mode 100644
@@ -0,0 +1,60 @@
+! { dg-do run }
+! PR fortran/107441
+!
+! Test VALUE + OPTIONAL for integer/real/...
+! in the presence of non-optional character dummies
+
+program bugdemo
+ implicit none
+ character :: s = 'a'
+ integer :: t
+
+ t = testoptional(s)
+ call test2 (s)
+ call test3 (s)
+ call test4 (w='123',x=42)
+
+contains
+
+ function testoptional (w, x) result(t)
+ character, intent(in) :: w
+ integer, intent(in), value, optional :: x
+ integer :: t
+ print *, 'present(x) is', present(x)
+ t = 0
+ if (present (x)) stop 1
+ end function testoptional
+
+ subroutine test2 (w, x)
+ character, intent(in) :: w
+ integer, intent(in), value, optional :: x
+ print*, 'present(x) is', present(x)
+ if (present (x)) stop 2
+ end subroutine test2
+
+ subroutine test3 (w, x)
+ character, intent(in), optional :: w
+ integer, intent(in), value, optional :: x
+ print *, 'present(w) is', present(w)
+ print *, 'present(x) is', present(x)
+ if (.not. present (w)) stop 3
+ if (present (x)) stop 4
+ end subroutine test3
+
+ subroutine test4 (r, w, x)
+ real, value, optional :: r
+ character(*), intent(in), optional :: w
+ integer, value, optional :: x
+ print *, 'present(r) is', present(r)
+ print *, 'present(w) is', present(w)
+ print *, 'present(x) is', present(x)
+ if (present (r)) stop 5
+ if (.not. present (w)) stop 6
+ if (.not. present (x)) stop 7
+ print *, 'x=', x
+ print *, 'len(w)=', len(w)
+ if (len(w) /= 3) stop 8
+ if (x /= 42) stop 9
+ end subroutine test4
+
+end program bugdemo
new file mode 100644
@@ -0,0 +1,31 @@
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/107441
+! Check that procedure types and procedure decls match when the procedure
+! has both character-typed and optional value args.
+!
+! Contributed by M.Morin
+
+program p
+ interface
+ subroutine i(c, o)
+ character(*) :: c
+ integer, optional, value :: o
+ end subroutine i
+ end interface
+ procedure(i), pointer :: pp
+ pp => s
+ call pp("abcd")
+contains
+ subroutine s(c, o)
+ character(*) :: c
+ integer, optional, value :: o
+ if (present(o)) stop 1
+ if (len(c) /= 4) stop 2
+ if (c /= "abcd") stop 3
+ end subroutine s
+end program p
+
+! { dg-final { scan-tree-dump "void s .* c, .* o, logical.* _o, integer.* _c" "original" } }
+! { dg-final { scan-tree-dump ", integer.*, logical.*, integer.* pp" "original" } }
--
2.35.3