[PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 532 bytes --]

Dear all,

the passing of procedure arguments in Fortran sometimes requires
ancillary parameters that are "hidden".  Examples are string length
and the presence status of scalar variables with optional+value
attribute.

The gfortran ABI is actually documented:

https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html

The reporter found that there was a discrepancy between the
caller and the callee.  This is corrected by the attached patch.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr107441.diff --]
[-- Type: text/x-patch, Size: 5033 bytes --]

From b7646403557eca19612c81437f381d4b4dcd51c8 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]

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.

gcc/testsuite/ChangeLog:

	PR fortran/107441
	* gfortran.dg/optional_absent_6.f90: New test.
---
 gcc/fortran/trans-decl.cc                     | 15 +++--
 .../gfortran.dg/optional_absent_6.f90         | 60 +++++++++++++++++++
 2 files changed, 71 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/optional_absent_6.f90

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..18842fe2c4b 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2508,7 +2508,7 @@ create_function_arglist (gfc_symbol * sym)
   tree fndecl;
   gfc_formal_arglist *f;
   tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  tree arglist, hidden_arglist, optional_arglist, strlen_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;
+  strlen_arglist = optional_arglist = NULL_TREE;
   typelist = TYPE_ARG_TYPES (TREE_TYPE (fndecl));

   if (sym->attr.entry_master)
@@ -2644,7 +2645,7 @@ create_function_arglist (gfc_symbol * sym)
 	  length = build_decl (input_location,
 			       PARM_DECL, get_identifier (name), len_type);

-	  hidden_arglist = chainon (hidden_arglist, length);
+	  strlen_arglist = chainon (strlen_arglist, length);
 	  DECL_CONTEXT (length) = fndecl;
 	  DECL_ARTIFICIAL (length) = 1;
 	  DECL_ARG_TYPE (length) = len_type;
@@ -2712,7 +2713,7 @@ create_function_arglist (gfc_symbol * sym)
 			    PARM_DECL, get_identifier (name),
 			    boolean_type_node);

-          hidden_arglist = chainon (hidden_arglist, tmp);
+	  optional_arglist = chainon (optional_arglist, tmp);
           DECL_CONTEXT (tmp) = fndecl;
           DECL_ARTIFICIAL (tmp) = 1;
           DECL_ARG_TYPE (tmp) = boolean_type_node;
@@ -2863,10 +2864,16 @@ create_function_arglist (gfc_symbol * sym)
       typelist = TREE_CHAIN (typelist);
     }

+  /* Add hidden present status for optional+value arguments.  */
+  arglist = chainon (arglist, optional_arglist);
+
   /* Add the hidden string length parameters, unless the procedure
      is bind(C).  */
   if (!sym->attr.is_bind_c)
-    arglist = chainon (arglist, hidden_arglist);
+    arglist = chainon (arglist, strlen_arglist);
+
+  /* Add hidden extra arguments for the gfortran library.  */
+  arglist = chainon (arglist, hidden_arglist);

   gcc_assert (hidden_typelist == NULL_TREE
               || TREE_VALUE (hidden_typelist) == void_type_node);
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
--
2.35.3

Re: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 28/10/2022 à 22:12, Harald Anlauf via Fortran a écrit :
> Dear all,
> 
> the passing of procedure arguments in Fortran sometimes requires
> ancillary parameters that are "hidden".  Examples are string length
> and the presence status of scalar variables with optional+value
> attribute.
> 
> The gfortran ABI is actually documented:
> 
> https://gcc.gnu.org/onlinedocs/gfortran/Argument-passing-conventions.html
> 
> The reporter found that there was a discrepancy between the
> caller and the callee.  This is corrected by the attached patch.
> 
Hello,

I think some discrepancy remains, as gfc_conv_procedure_call accumulates 
coarray stuff into the stringargs, while your change accumulates the 
associated parameter decls separately into hidden_arglist.  It's not 
completely clear to me whether it is really problematic (string length 
and coarray metadata are both integers anyway), but I suspect it is.

Another probable issue is your change to create_function_arglist changes 
arglist/hidden_arglist without also changing typelist/hidden_typelist 
accordingly.  I think a change to gfc_get_function_type is also 
necessary: as the function decl is changed, the decl type need to be 
changed as well.

I will see whether I can manage to exhibit testcases for these issues.

Re: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 30/10/2022 à 20:23, Mikael Morin a écrit :
> 
> I think some discrepancy remains, as gfc_conv_procedure_call accumulates 
> coarray stuff into the stringargs, while your change accumulates the 
> associated parameter decls separately into hidden_arglist.  It's not 
> completely clear to me whether it is really problematic (string length 
> and coarray metadata are both integers anyway), but I suspect it is.
> > I will see whether I can manage to exhibit testcases for these issues.
> 
Here is a -fcoarray=lib example.  It can be placed in gfortran/coarray.

! { dg-do run }
!
! PR fortran/107441
! Check that with -fcoarray=lib, coarray metadata arguments are passed
! in the right order to procedures.
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

Re: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 30/10/2022 à 20:23, Mikael Morin a écrit :
> Another probable issue is your change to create_function_arglist changes 
> arglist/hidden_arglist without also changing typelist/hidden_typelist 
> accordingly.  I think a change to gfc_get_function_type is also 
> necessary: as the function decl is changed, the decl type need to be 
> changed as well.
> 
> I will see whether I can manage to exhibit testcases for these issues.
> 
Here is a test for the type vs decl mismatch.

! { dg-do run }
!
! PR fortran/107441
! Check that procedure types and procedure decls match when the procedure
! has both chaacter-typed and optional value args.

program p
   interface
     subroutine i(c, o)
       character(*) :: c
       integer, optional, value :: o
     end subroutine i
   end interface
   procedure(i), pointer :: pp
   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

Re: [PATCH] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 30/10/2022 à 22:25, Mikael Morin a écrit :
> Le 30/10/2022 à 20:23, Mikael Morin a écrit :
>> Another probable issue is your change to create_function_arglist 
>> changes arglist/hidden_arglist without also changing 
>> typelist/hidden_typelist accordingly.  I think a change to 
>> gfc_get_function_type is also necessary: as the function decl is 
>> changed, the decl type need to be changed as well.
>>
>> I will see whether I can manage to exhibit testcases for these issues.
>>
> Here is a test for the type vs decl mismatch.
> 
> ! { dg-do run }
> !
> ! PR fortran/107441
> ! Check that procedure types and procedure decls match when the procedure
> ! has both chaacter-typed and optional value args.
> 
> program p
>    interface
>      subroutine i(c, o)
>        character(*) :: c
>        integer, optional, value :: o
>      end subroutine i
>    end interface
>    procedure(i), pointer :: pp
A pointer initialization is missing here:
     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
> 

With the additional initialization, the test passes, so it's not very 
useful.  The type mismatch is visible in the dump though, so maybe a 
dump match can be used.

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1987 bytes --]

Hi Mikael,

thanks a lot, your testcases broke my initial (and incorrect) patch
in multiple ways.  I understand now that the right solution is much
simpler and smaller.

I've added your testcases, see attached, with a simple scan of the
dump for the generated order of hidden arguments in the function decl
for the last testcase.

Regtested again on x86_64-pc-linux-gnu.  OK now?

Thanks,
Harald


Am 31.10.22 um 10:57 schrieb Mikael Morin:
> Le 30/10/2022 à 22:25, Mikael Morin a écrit :
>> Le 30/10/2022 à 20:23, Mikael Morin a écrit :
>>> Another probable issue is your change to create_function_arglist
>>> changes arglist/hidden_arglist without also changing
>>> typelist/hidden_typelist accordingly.  I think a change to
>>> gfc_get_function_type is also necessary: as the function decl is
>>> changed, the decl type need to be changed as well.
>>>
>>> I will see whether I can manage to exhibit testcases for these issues.
>>>
>> Here is a test for the type vs decl mismatch.
>>
>> ! { dg-do run }
>> !
>> ! PR fortran/107441
>> ! Check that procedure types and procedure decls match when the procedure
>> ! has both chaacter-typed and optional value args.
>>
>> program p
>>    interface
>>      subroutine i(c, o)
>>        character(*) :: c
>>        integer, optional, value :: o
>>      end subroutine i
>>    end interface
>>    procedure(i), pointer :: pp
> A pointer initialization is missing here:
>      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
>>
>
> With the additional initialization, the test passes, so it's not very
> useful.  The type mismatch is visible in the dump though, so maybe a
> dump match can be used.
>

[-- Attachment #2: pr107441-v2.diff --]
[-- Type: text/x-patch, Size: 6475 bytes --]

From 705628c89faa1135ed9a446b84e831bbead6095a 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]

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.  The present status for optional+value
	arguments is passed before character length and coarray token and
	offset.

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                     |  8 ++-
 .../gfortran.dg/coarray/pr107441-caf.f90      | 27 +++++++++
 .../gfortran.dg/optional_absent_6.f90         | 60 +++++++++++++++++++
 .../gfortran.dg/optional_absent_7.f90         | 30 ++++++++++
 4 files changed, 123 insertions(+), 2 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

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..64b35f054e5 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2508,7 +2508,7 @@ create_function_arglist (gfc_symbol * sym)
   tree fndecl;
   gfc_formal_arglist *f;
   tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  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)
@@ -2712,7 +2713,7 @@ 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;
@@ -2863,6 +2864,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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..efa7166c7e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -0,0 +1,30 @@
+! { 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" } }
-- 
2.35.3

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1934 bytes --]

Hi Mikael,

thanks a lot, your testcases broke my initial (and incorrect) patch
in multiple ways.  I understand now that the right solution is much
simpler and smaller.

I've added your testcases, see attached, with a simple scan of the
dump for the generated order of hidden arguments in the function decl
for the last testcase.

Regtested again on x86_64-pc-linux-gnu.  OK now?

Thanks,
Harald


Am 31.10.22 um 10:57 schrieb Mikael Morin:
> Le 30/10/2022 à 22:25, Mikael Morin a écrit :
>> Le 30/10/2022 à 20:23, Mikael Morin a écrit :
>>> Another probable issue is your change to create_function_arglist 
>>> changes arglist/hidden_arglist without also changing 
>>> typelist/hidden_typelist accordingly.  I think a change to 
>>> gfc_get_function_type is also necessary: as the function decl is 
>>> changed, the decl type need to be changed as well.
>>>
>>> I will see whether I can manage to exhibit testcases for these issues.
>>>
>> Here is a test for the type vs decl mismatch.
>>
>> ! { dg-do run }
>> !
>> ! PR fortran/107441
>> ! Check that procedure types and procedure decls match when the procedure
>> ! has both chaacter-typed and optional value args.
>>
>> program p
>>    interface
>>      subroutine i(c, o)
>>        character(*) :: c
>>        integer, optional, value :: o
>>      end subroutine i
>>    end interface
>>    procedure(i), pointer :: pp
> A pointer initialization is missing here:
>      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
>>
> 
> With the additional initialization, the test passes, so it's not very 
> useful.  The type mismatch is visible in the dump though, so maybe a 
> dump match can be used.
> 

[-- Attachment #2: pr107441-v2.diff --]
[-- Type: text/x-patch, Size: 6475 bytes --]

From 705628c89faa1135ed9a446b84e831bbead6095a 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]

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.  The present status for optional+value
	arguments is passed before character length and coarray token and
	offset.

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                     |  8 ++-
 .../gfortran.dg/coarray/pr107441-caf.f90      | 27 +++++++++
 .../gfortran.dg/optional_absent_6.f90         | 60 +++++++++++++++++++
 .../gfortran.dg/optional_absent_7.f90         | 30 ++++++++++
 4 files changed, 123 insertions(+), 2 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

diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..64b35f054e5 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -2508,7 +2508,7 @@ create_function_arglist (gfc_symbol * sym)
   tree fndecl;
   gfc_formal_arglist *f;
   tree typelist, hidden_typelist;
-  tree arglist, hidden_arglist;
+  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)
@@ -2712,7 +2713,7 @@ 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;
@@ -2863,6 +2864,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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..efa7166c7e3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -0,0 +1,30 @@
+! { 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" } }
-- 
2.35.3

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 31/10/2022 à 21:29, Harald Anlauf via Fortran a écrit :
> Hi Mikael,
> 
> thanks a lot, your testcases broke my initial (and incorrect) patch
> in multiple ways.  I understand now that the right solution is much
> simpler and smaller.
> 
> I've added your testcases, see attached, with a simple scan of the
> dump for the generated order of hidden arguments in the function decl
> for the last testcase.
> 
> Regtested again on x86_64-pc-linux-gnu.  OK now?
> 
Unfortunately no, the coarray case works, but the other problem remains.
The type problem is not visible in the definition of S, it is in the 
declaration of S's prototype in P.

S is defined as:

void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o, 
logical(kind=1) _o, integer(kind=8) _c)
{
...
}

but P has:

void p ()
{
   static void s (character(kind=1)[1:] & restrict, integer(kind=4), 
integer(kind=8), logical(kind=1));
   void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4), 
integer(kind=8), logical(kind=1)) pp;

   pp = s;
...
}

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

Am 02.11.22 um 18:20 schrieb Mikael Morin:
> Unfortunately no, the coarray case works, but the other problem remains.
> The type problem is not visible in the definition of S, it is in the 
> declaration of S's prototype in P.
> 
> S is defined as:
> 
> void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o, 
> logical(kind=1) _o, integer(kind=8) _c)
> {
> ...
> }
> 
> but P has:
> 
> void p ()
> {
>    static void s (character(kind=1)[1:] & restrict, integer(kind=4), 
> integer(kind=8), logical(kind=1));
>    void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4), 
> integer(kind=8), logical(kind=1)) pp;
> 
>    pp = s;
> ...
> }

Right, now I see it too.  Simplified case:

program p
   call s ("abcd")
contains
   subroutine s(c, o)
     character(*) :: c
     integer, optional, value :: o
   end subroutine s
end

I do see what needs to be done in gfc_get_function_type, which seems
in fact very simple.  But I get really lost in create_function_arglist
when trying to get the typelist right.

One thing is I really don't understand how the (hidden_)typelist is
managed here.  How does that macro TREE_CHAIN work?  Can we somehow
chain two typelists the same way we chain arguments?

(Failing that, I tried to split the loop over the dummy arguments in
create_function_arglist into two passes, one for the optional+value
variant, and one for the rest.  It turned out to be a bad idea...)

Harald

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

Am 02.11.22 um 18:20 schrieb Mikael Morin:
> Unfortunately no, the coarray case works, but the other problem remains.
> The type problem is not visible in the definition of S, it is in the
> declaration of S's prototype in P.
>
> S is defined as:
>
> void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o,
> logical(kind=1) _o, integer(kind=8) _c)
> {
> ...
> }
>
> but P has:
>
> void p ()
> {
>    static void s (character(kind=1)[1:] & restrict, integer(kind=4),
> integer(kind=8), logical(kind=1));
>    void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4),
> integer(kind=8), logical(kind=1)) pp;
>
>    pp = s;
> ...
> }

Right, now I see it too.  Simplified case:

program p
   call s ("abcd")
contains
   subroutine s(c, o)
     character(*) :: c
     integer, optional, value :: o
   end subroutine s
end

I do see what needs to be done in gfc_get_function_type, which seems
in fact very simple.  But I get really lost in create_function_arglist
when trying to get the typelist right.

One thing is I really don't understand how the (hidden_)typelist is
managed here.  How does that macro TREE_CHAIN work?  Can we somehow
chain two typelists the same way we chain arguments?

(Failing that, I tried to split the loop over the dummy arguments in
create_function_arglist into two passes, one for the optional+value
variant, and one for the rest.  It turned out to be a bad idea...)

Harald

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 02/11/2022 à 22:19, Harald Anlauf via Fortran a écrit :
> Am 02.11.22 um 18:20 schrieb Mikael Morin:
>> Unfortunately no, the coarray case works, but the other problem remains.
>> The type problem is not visible in the definition of S, it is in the 
>> declaration of S's prototype in P.
>>
>> S is defined as:
>>
>> void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o, 
>> logical(kind=1) _o, integer(kind=8) _c)
>> {
>> ...
>> }
>>
>> but P has:
>>
>> void p ()
>> {
>>    static void s (character(kind=1)[1:] & restrict, integer(kind=4), 
>> integer(kind=8), logical(kind=1));
>>    void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4), 
>> integer(kind=8), logical(kind=1)) pp;
>>
>>    pp = s;
>> ...
>> }
> 
> Right, now I see it too.  Simplified case:
> 
> program p
>    call s ("abcd")
> contains
>    subroutine s(c, o)
>      character(*) :: c
>      integer, optional, value :: o
>    end subroutine s
> end
> 
> I do see what needs to be done in gfc_get_function_type, which seems
> in fact very simple.  But I get really lost in create_function_arglist
> when trying to get the typelist right.
> 
> One thing is I really don't understand how the (hidden_)typelist is
> managed here.  How does that macro TREE_CHAIN work?  Can we somehow
> chain two typelists the same way we chain arguments?
> 
TREE_CHAIN is just a linked list "next" pointer like there is in the 
fortran frontend a "next" pointer in gfc_ref or gfc_actual_arglist 
structures.
Yes, we can chain typelists; the implementation of chainon in tree.cc is 
just TREE_CHAIN appending under the hood.

> (Failing that, I tried to split the loop over the dummy arguments in
> create_function_arglist into two passes, one for the optional+value
> variant, and one for the rest.  It turned out to be a bad idea...)
> 
Not necessarily a bad idea, but one has to be careful to keep linked 
lists synchronized with argument walking.

The most simple, I think, is to move the hidden_typelist advancement for 
optional, value presence arguments from the main loop to a preliminary loop.

I hope it helps.

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

Am 03.11.22 um 11:06 schrieb Mikael Morin:
> Le 02/11/2022 à 22:19, Harald Anlauf via Fortran a écrit :
>> Am 02.11.22 um 18:20 schrieb Mikael Morin:
>>> Unfortunately no, the coarray case works, but the other problem remains.
>>> The type problem is not visible in the definition of S, it is in the
>>> declaration of S's prototype in P.
>>>
>>> S is defined as:
>>>
>>> void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o,
>>> logical(kind=1) _o, integer(kind=8) _c)
>>> {
>>> ...
>>> }
>>>
>>> but P has:
>>>
>>> void p ()
>>> {
>>>    static void s (character(kind=1)[1:] & restrict, integer(kind=4),
>>> integer(kind=8), logical(kind=1));
>>>    void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4),
>>> integer(kind=8), logical(kind=1)) pp;
>>>
>>>    pp = s;
>>> ...
>>> }
>>
>> Right, now I see it too.  Simplified case:
>>
>> program p
>>    call s ("abcd")
>> contains
>>    subroutine s(c, o)
>>      character(*) :: c
>>      integer, optional, value :: o
>>    end subroutine s
>> end
>>
>> I do see what needs to be done in gfc_get_function_type, which seems
>> in fact very simple.  But I get really lost in create_function_arglist
>> when trying to get the typelist right.
>>
>> One thing is I really don't understand how the (hidden_)typelist is
>> managed here.  How does that macro TREE_CHAIN work?  Can we somehow
>> chain two typelists the same way we chain arguments?
>>
> TREE_CHAIN is just a linked list "next" pointer like there is in the
> fortran frontend a "next" pointer in gfc_ref or gfc_actual_arglist
> structures.
> Yes, we can chain typelists; the implementation of chainon in tree.cc is
> just TREE_CHAIN appending under the hood.
>
>> (Failing that, I tried to split the loop over the dummy arguments in
>> create_function_arglist into two passes, one for the optional+value
>> variant, and one for the rest.  It turned out to be a bad idea...)
>>
> Not necessarily a bad idea, but one has to be careful to keep linked
> lists synchronized with argument walking.
>
> The most simple, I think, is to move the hidden_typelist advancement for
> optional, value presence arguments from the main loop to a preliminary
> loop.
>
> I hope it helps.
>

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.

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

Am 03.11.22 um 11:06 schrieb Mikael Morin:
> Le 02/11/2022 à 22:19, Harald Anlauf via Fortran a écrit :
>> Am 02.11.22 um 18:20 schrieb Mikael Morin:
>>> Unfortunately no, the coarray case works, but the other problem remains.
>>> The type problem is not visible in the definition of S, it is in the 
>>> declaration of S's prototype in P.
>>>
>>> S is defined as:
>>>
>>> void s (character(kind=1)[1:_c] & restrict c, integer(kind=4) o, 
>>> logical(kind=1) _o, integer(kind=8) _c)
>>> {
>>> ...
>>> }
>>>
>>> but P has:
>>>
>>> void p ()
>>> {
>>>    static void s (character(kind=1)[1:] & restrict, integer(kind=4), 
>>> integer(kind=8), logical(kind=1));
>>>    void (*<T63a>) (character(kind=1)[1:] & restrict, integer(kind=4), 
>>> integer(kind=8), logical(kind=1)) pp;
>>>
>>>    pp = s;
>>> ...
>>> }
>>
>> Right, now I see it too.  Simplified case:
>>
>> program p
>>    call s ("abcd")
>> contains
>>    subroutine s(c, o)
>>      character(*) :: c
>>      integer, optional, value :: o
>>    end subroutine s
>> end
>>
>> I do see what needs to be done in gfc_get_function_type, which seems
>> in fact very simple.  But I get really lost in create_function_arglist
>> when trying to get the typelist right.
>>
>> One thing is I really don't understand how the (hidden_)typelist is
>> managed here.  How does that macro TREE_CHAIN work?  Can we somehow
>> chain two typelists the same way we chain arguments?
>>
> TREE_CHAIN is just a linked list "next" pointer like there is in the 
> fortran frontend a "next" pointer in gfc_ref or gfc_actual_arglist 
> structures.
> Yes, we can chain typelists; the implementation of chainon in tree.cc is 
> just TREE_CHAIN appending under the hood.
> 
>> (Failing that, I tried to split the loop over the dummy arguments in
>> create_function_arglist into two passes, one for the optional+value
>> variant, and one for the rest.  It turned out to be a bad idea...)
>>
> Not necessarily a bad idea, but one has to be careful to keep linked 
> lists synchronized with argument walking.
> 
> The most simple, I think, is to move the hidden_typelist advancement for 
> optional, value presence arguments from the main loop to a preliminary 
> loop.
> 
> I hope it helps.
> 

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.

Re: [PATCH, v2] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

Le 03/11/2022 à 23:03, Harald Anlauf a écrit :
> Am 03.11.22 um 11:06 schrieb Mikael Morin:
>> Le 02/11/2022 à 22:19, Harald Anlauf via Fortran a écrit :
>>> I do see what needs to be done in gfc_get_function_type, which seems
>>> in fact very simple.  But I get really lost in create_function_arglist
>>> when trying to get the typelist right.
>>>
>>> One thing is I really don't understand how the (hidden_)typelist is
>>> managed here.  How does that macro TREE_CHAIN work?  Can we somehow
>>> chain two typelists the same way we chain arguments?
>>>
>> TREE_CHAIN is just a linked list "next" pointer like there is in the
>> fortran frontend a "next" pointer in gfc_ref or gfc_actual_arglist
>> structures.
>> Yes, we can chain typelists; the implementation of chainon in tree.cc is
>> just TREE_CHAIN appending under the hood.
>>
>>> (Failing that, I tried to split the loop over the dummy arguments in
>>> create_function_arglist into two passes, one for the optional+value
>>> variant, and one for the rest.  It turned out to be a bad idea...)
>>>
>> Not necessarily a bad idea, but one has to be careful to keep linked
>> lists synchronized with argument walking.
>>
>> The most simple, I think, is to move the hidden_typelist advancement for
>> optional, value presence arguments from the main loop to a preliminary
>> loop.
>>
>> I hope it helps.
>>
> 
> 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?).

[PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1356 bytes --]

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


[-- Attachment #2: pr107441-v3.diff --]
[-- Type: text/x-patch, Size: 9705 bytes --]

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

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
@@ -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)
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index def7552ac67..42907becd27 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..1be981c88f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -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

[PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 1322 bytes --]

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


[-- Attachment #2: pr107441-v3.diff --]
[-- Type: text/x-patch, Size: 9705 bytes --]

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

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
@@ -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)
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index def7552ac67..42907becd27 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..1be981c88f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -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

Re: [PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

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

Re: [PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 3277 bytes --]

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


[-- Attachment #2: pr107441-v4.diff --]
[-- Type: text/x-patch, Size: 12188 bytes --]

From 8694d1d2cbd19b5148b5d1d891b182cc3e718f40 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 argument passing conventions specify a certain order for
procedure arguments that should be followed consequently: the hidden
presence status flags of optional+value scalar arguments of intrinsic type
shall come before the hidden character length, coarray token and offset.
Clarify that in the documentation.

gcc/fortran/ChangeLog:

	PR fortran/107441
	* gfortran.texi (Argument passing conventions): Clarify the gfortran
	argument passing conventions with regard to OPTIONAL dummy arguments
	of intrinsic type.
	* 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/gfortran.texi                     |  3 +-
 gcc/fortran/trans-decl.cc                     | 31 +++++++---
 gcc/fortran/trans-types.cc                    | 25 ++++----
 .../gfortran.dg/coarray/pr107441-caf.f90      | 27 +++++++++
 .../gfortran.dg/optional_absent_6.f90         | 60 +++++++++++++++++++
 .../gfortran.dg/optional_absent_7.f90         | 31 ++++++++++
 6 files changed, 157 insertions(+), 20 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

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4b4ecd528a7..60fac2e0417 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3763,8 +3763,7 @@ is used for dummy arguments; with @code{VALUE}, those variables are
 passed by value.
 
 For @code{OPTIONAL} dummy arguments, an absent argument is denoted
-by a NULL pointer, except for scalar dummy arguments of type
-@code{INTEGER}, @code{LOGICAL}, @code{REAL} and @code{COMPLEX}
+by a NULL pointer, except for scalar dummy arguments of intrinsic type
 which have the @code{VALUE} attribute.  For those, a hidden Boolean
 argument (@code{logical(kind=C_bool),value}) is used to indicate
 whether the argument is present.
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..c6948e1d859 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -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];
@@ -2698,12 +2708,12 @@ create_function_arglist (gfc_symbol * sym)
 		type = gfc_sym_type (f->sym);
 	    }
 	}
-      /* For noncharacter scalar intrinsic types, VALUE passes the value,
+      /* For scalar intrinsic types, VALUE passes the value,
 	 hence, the optional status cannot be transferred via a NULL pointer.
 	 Thus, we will use a hidden argument in that case.  */
-      else if (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))
+      if (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))
 	{
           tree tmp;
           strcpy (&name[1], f->sym->name);
@@ -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)
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index def7552ac67..196f2cecbfc 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -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,17 +3223,17 @@ 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,
+      /* For scalar intrinsic types, VALUE passes the value,
 	 hence, the optional status cannot be transferred via a NULL pointer.
 	 Thus, we will use a hidden argument in that case.  */
-      else if (arg
-	       && arg->attr.optional
-	       && arg->attr.value
-	       && !arg->attr.dimension
-	       && arg->ts.type != BT_CLASS
-	       && !gfc_bt_struct (arg->ts.type))
+      if (arg
+	  && arg->attr.optional
+	  && arg->attr.value
+	  && !arg->attr.dimension
+	  && arg->ts.type != BT_CLASS
+	  && !gfc_bt_struct (arg->ts.type))
 	vec_safe_push (typelist, boolean_type_node);
       /* Coarrays which are descriptorless or assumed-shape pass with
 	 -fcoarray=lib the token and the offset as hidden arguments.  */
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..1be981c88f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -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

Re: [PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Harald Anlauf]

[-- Attachment #1: Type: text/plain, Size: 3198 bytes --]

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


[-- Attachment #2: pr107441-v4.diff --]
[-- Type: text/x-patch, Size: 12188 bytes --]

From 8694d1d2cbd19b5148b5d1d891b182cc3e718f40 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 argument passing conventions specify a certain order for
procedure arguments that should be followed consequently: the hidden
presence status flags of optional+value scalar arguments of intrinsic type
shall come before the hidden character length, coarray token and offset.
Clarify that in the documentation.

gcc/fortran/ChangeLog:

	PR fortran/107441
	* gfortran.texi (Argument passing conventions): Clarify the gfortran
	argument passing conventions with regard to OPTIONAL dummy arguments
	of intrinsic type.
	* 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/gfortran.texi                     |  3 +-
 gcc/fortran/trans-decl.cc                     | 31 +++++++---
 gcc/fortran/trans-types.cc                    | 25 ++++----
 .../gfortran.dg/coarray/pr107441-caf.f90      | 27 +++++++++
 .../gfortran.dg/optional_absent_6.f90         | 60 +++++++++++++++++++
 .../gfortran.dg/optional_absent_7.f90         | 31 ++++++++++
 6 files changed, 157 insertions(+), 20 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

diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi
index 4b4ecd528a7..60fac2e0417 100644
--- a/gcc/fortran/gfortran.texi
+++ b/gcc/fortran/gfortran.texi
@@ -3763,8 +3763,7 @@ is used for dummy arguments; with @code{VALUE}, those variables are
 passed by value.
 
 For @code{OPTIONAL} dummy arguments, an absent argument is denoted
-by a NULL pointer, except for scalar dummy arguments of type
-@code{INTEGER}, @code{LOGICAL}, @code{REAL} and @code{COMPLEX}
+by a NULL pointer, except for scalar dummy arguments of intrinsic type
 which have the @code{VALUE} attribute.  For those, a hidden Boolean
 argument (@code{logical(kind=C_bool),value}) is used to indicate
 whether the argument is present.
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 63515b9072a..c6948e1d859 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -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];
@@ -2698,12 +2708,12 @@ create_function_arglist (gfc_symbol * sym)
 		type = gfc_sym_type (f->sym);
 	    }
 	}
-      /* For noncharacter scalar intrinsic types, VALUE passes the value,
+      /* For scalar intrinsic types, VALUE passes the value,
 	 hence, the optional status cannot be transferred via a NULL pointer.
 	 Thus, we will use a hidden argument in that case.  */
-      else if (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))
+      if (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))
 	{
           tree tmp;
           strcpy (&name[1], f->sym->name);
@@ -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)
diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc
index def7552ac67..196f2cecbfc 100644
--- a/gcc/fortran/trans-types.cc
+++ b/gcc/fortran/trans-types.cc
@@ -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,17 +3223,17 @@ 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,
+      /* For scalar intrinsic types, VALUE passes the value,
 	 hence, the optional status cannot be transferred via a NULL pointer.
 	 Thus, we will use a hidden argument in that case.  */
-      else if (arg
-	       && arg->attr.optional
-	       && arg->attr.value
-	       && !arg->attr.dimension
-	       && arg->ts.type != BT_CLASS
-	       && !gfc_bt_struct (arg->ts.type))
+      if (arg
+	  && arg->attr.optional
+	  && arg->attr.value
+	  && !arg->attr.dimension
+	  && arg->ts.type != BT_CLASS
+	  && !gfc_bt_struct (arg->ts.type))
 	vec_safe_push (typelist, boolean_type_node);
       /* Coarrays which are descriptorless or assumed-shape pass with
 	 -fcoarray=lib the token and the offset as hidden arguments.  */
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90 b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
new file mode 100644
index 00000000000..23b2242e217
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/pr107441-caf.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_6.f90 b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
new file mode 100644
index 00000000000..b8abb06980a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_6.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/optional_absent_7.f90 b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
new file mode 100644
index 00000000000..1be981c88f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/optional_absent_7.f90
@@ -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

Re: [PATCH, v3] Fortran: ordering of hidden procedure arguments [PR107441]

[Mikael Morin]

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.