Fortran: Fix func decl mismatch [PR93660]

gcc/fortran/ChangeLog:

	PR fortran/93660
	* trans-decl.c (build_function_decl): Add comment;
	increment hidden_typelist for caf_token/caf_offset.
	* trans-types.c (gfc_get_function_type): Add comment;
	add missing caf_token/caf_offset args.

gcc/testsuite/ChangeLog:

	PR fortran/93660
	* gfortran.dg/gomp/declare-simd-coarray-lib.f90: New test.

(cherry picked from commit 212f4988f37ccf788c8c72b1dc952980bc9be3b7)

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 08ad3fe56c510249ff64a0f6871343adf2b9869c..529417fa8aac7290c6c4eb938bd3796c0fb97e98 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -2465,7 +2465,9 @@ build_function_decl (gfc_symbol * sym, bool global)
 }
 
 
-/* Create the DECL_ARGUMENTS for a procedure.  */
+/* Create the DECL_ARGUMENTS for a procedure.
+   NOTE: The arguments added here must match the argument type created by
+   gfc_get_function_type ().  */
 
 static void
 create_function_arglist (gfc_symbol * sym)
@@ -2784,6 +2786,7 @@ create_function_arglist (gfc_symbol * sym)
          DECL_ARG_TYPE (token) = TREE_VALUE (typelist);
          TREE_READONLY (token) = 1;
          hidden_arglist = chainon (hidden_arglist, token);
+         hidden_typelist = TREE_CHAIN (hidden_typelist);
          gfc_finish_decl (token);
 
          offset = build_decl (input_location, PARM_DECL,
@@ -2809,6 +2812,7 @@ create_function_arglist (gfc_symbol * sym)
          DECL_ARG_TYPE (offset) = TREE_VALUE (typelist);
          TREE_READONLY (offset) = 1;
          hidden_arglist = chainon (hidden_arglist, offset);
+         hidden_typelist = TREE_CHAIN (hidden_typelist);
          gfc_finish_decl (offset);
        }
 

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index b7712dc74d167d1e35506c44fb0fdfb67ef1286e..d3fef08b4b9f2b2ae1fd4122d2e52747e287fa9a 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2975,6 +2975,10 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
   return build_type_attribute_variant (fntype, tmp);
 }
 
+
+/* NOTE: The returned function type must match the argument list created by
+   create_function_arglist.  */
+
 tree
 gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args)
 {
@@ -3082,10 +3086,11 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args)
         }
     }
 
-  /* Add hidden string length parameters.  */
+  /* Add hidden arguments.  */
   for (f = gfc_sym_get_dummy_args (sym); f; f = f->next)
     {
       arg = f->sym;
+      /* Add hidden string length parameters.  */
       if (arg && arg->ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
        {
          if (!arg->ts.deferred)
@@ -3108,6 +3113,20 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args)
               && 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.  */
+      else if (arg
+              && flag_coarray == GFC_FCOARRAY_LIB
+              && ((arg->ts.type != BT_CLASS
+                   && arg->attr.codimension
+                   && !arg->attr.allocatable)
+                  || (arg->ts.type == BT_CLASS
+                      && 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.  */
+       }
     }
 
   if (!vec_safe_is_empty (typelist)

diff --git a/gcc/testsuite/gfortran.dg/gomp/declare-simd-coarray-lib.f90 b/gcc/testsuite/gfortran.dg/gomp/declare-simd-coarray-lib.f90
new file mode 100644 (file)
index 0000000..1f74da7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/declare-simd-coarray-lib.f90
@@ -0,0 +1,12 @@
+! { dg-additional-options "-fcoarray=lib" }
+!
+! PR fortran/93660
+!
+! Failed as TREE_TYPE(fndecl) did not include the
+! hidden caf_token/caf_offset arguments.
+!
+integer function f(x)
+   integer :: x[*]
+   !$omp declare simd
+   f = x[1]
+end