Fortran: Fix function decl's location [PR95847]

gcc/fortran/ChangeLog:

	PR fortran/95847
	* trans-decl.c (gfc_get_symbol_decl): Do not (re)set the location
	of an external procedure.
	(build_entry_thunks, generate_coarray_init, create_main_function,
	gfc_generate_function_code): Use fndecl's location in BIND_EXPR.

gcc/testsuite/ChangeLog:

	PR fortran/95847
	* gfortran.dg/coverage.f90: New test.

(cherry picked from commit 2d59593105d3b1e38e49f96b74fd81e4e5038c7f)

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 45a739ac860ae6a0375c37c5426efd2df23ccb3c..08ad3fe56c510249ff64a0f6871343adf2b9869c 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1728,7 +1728,6 @@ gfc_get_symbol_decl (gfc_symbol * sym)
          || sym->attr.if_source != IFSRC_DECL)
        {
          decl = gfc_get_extern_function_decl (sym);
-         gfc_set_decl_location (decl, &sym->declared_at);
        }
       else
        {
@@ -3000,8 +2999,9 @@ build_entry_thunks (gfc_namespace * ns, bool global)
       poplevel (1, 1);
       BLOCK_SUPERCONTEXT (DECL_INITIAL (thunk_fndecl)) = thunk_fndecl;
       DECL_SAVED_TREE (thunk_fndecl)
-       = build3_v (BIND_EXPR, tmp, DECL_SAVED_TREE (thunk_fndecl),
-                   DECL_INITIAL (thunk_fndecl));
+       = fold_build3_loc (DECL_SOURCE_LOCATION (thunk_fndecl), BIND_EXPR,
+                          void_type_node, tmp, DECL_SAVED_TREE (thunk_fndecl),
+                          DECL_INITIAL (thunk_fndecl));
 
       /* Output the GENERIC tree.  */
       dump_function (TDI_original, thunk_fndecl);
@@ -5754,8 +5754,8 @@ generate_coarray_init (gfc_namespace * ns __attribute((unused)))
   BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
 
   DECL_SAVED_TREE (fndecl)
-    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
-                DECL_INITIAL (fndecl));
+    = fold_build3_loc (DECL_SOURCE_LOCATION (fndecl), BIND_EXPR, void_type_node,
+                      decl, DECL_SAVED_TREE (fndecl), DECL_INITIAL (fndecl));
   dump_function (TDI_original, fndecl);
 
   cfun->function_end_locus = input_location;
@@ -6480,8 +6480,9 @@ create_main_function (tree fndecl)
   BLOCK_SUPERCONTEXT (DECL_INITIAL (ftn_main)) = ftn_main;
 
   DECL_SAVED_TREE (ftn_main)
-    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (ftn_main),
-               DECL_INITIAL (ftn_main));
+    = fold_build3_loc (DECL_SOURCE_LOCATION (ftn_main), BIND_EXPR,
+                      void_type_node, decl, DECL_SAVED_TREE (ftn_main),
+                      DECL_INITIAL (ftn_main));
 
   /* Output the GENERIC tree.  */
   dump_function (TDI_original, ftn_main);
@@ -6972,8 +6973,8 @@ gfc_generate_function_code (gfc_namespace * ns)
   BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
 
   DECL_SAVED_TREE (fndecl)
-    = build3_v (BIND_EXPR, decl, DECL_SAVED_TREE (fndecl),
-               DECL_INITIAL (fndecl));
+    = fold_build3_loc (DECL_SOURCE_LOCATION (fndecl), BIND_EXPR, void_type_node,
+                      decl, DECL_SAVED_TREE (fndecl), DECL_INITIAL (fndecl));
 
   /* Output the GENERIC tree.  */
   dump_function (TDI_original, fndecl);

diff --git a/gcc/testsuite/gfortran.dg/coverage.f90 b/gcc/testsuite/gfortran.dg/coverage.f90
new file mode 100644 (file)
index 0000000..e0800f8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coverage.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-additional-options "-fprofile-arcs -ftest-coverage" }
+!
+! PR fortran/95847
+!
+module foo
+contains
+    subroutine sbr()
+    end subroutine sbr
+end module foo
+
+function foo_suite() result(suite)
+   use foo
+   integer :: bar
+   integer :: res
+   res = bar(sbr)
+end function foo_suite