This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] Fix alternate returns with multiple entry points (PR fortran/18824)
- From: Jakub Jelinek <jakub at redhat dot com>
- To: Paul Brook <paul at codesourcery dot com>
- Cc: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Fri, 8 Apr 2005 16:37:36 -0400
- Subject: [PATCH] Fix alternate returns with multiple entry points (PR fortran/18824)
- Reply-to: Jakub Jelinek <jakub at redhat dot com>
Hi!
The following patch on top of my PR fortran/13082 patch posted earlier
today:
http://gcc.gnu.org/ml/gcc-patches/2005-04/msg00855.html
fixes alternate returns in subroutines with alternate entry points.
Bootstrapped/regtested on x86_64-redhat-linux.
2005-04-08 Jakub Jelinek <jakub@redhat.com>
PR fortran/18824
* trans-decl.c (build_entry_thunks): Ignore alternate return dummy
arguments. Return whatever entry master returned whenever its
DECL_RESULT has non-void type.
* gfortran.fortran-torture/execute/entry_1.f90: New test.
--- gcc/fortran/trans-decl.c 2005-04-08 16:18:55.000000000 +0200
+++ gcc/fortran/trans-decl.c 2005-04-08 21:44:42.000000000 +0200
@@ -1396,6 +1396,10 @@ build_entry_thunks (gfc_namespace * ns)
for (formal = ns->proc_name->formal; formal; formal = formal->next)
{
+ /* Ignore alternate returns. */
+ if (formal->sym == NULL)
+ continue;
+
/* We don't have a clever way of identifying arguments, so resort to
a brute-force search. */
for (thunk_formal = thunk_sym->formal;
@@ -1434,16 +1438,12 @@ build_entry_thunks (gfc_namespace * ns)
args = chainon (args, nreverse (string_args));
tmp = ns->proc_name->backend_decl;
tmp = gfc_build_function_call (tmp, args);
- if (thunk_sym->attr.function)
+ if (TREE_TYPE (DECL_RESULT (current_function_decl)) != void_type_node)
{
- if (TREE_TYPE (DECL_RESULT (current_function_decl))
- != void_type_node)
- {
- tmp = build2 (MODIFY_EXPR,
- TREE_TYPE (DECL_RESULT (current_function_decl)),
- DECL_RESULT (current_function_decl), tmp);
- tmp = build1_v (RETURN_EXPR, tmp);
- }
+ tmp = build2 (MODIFY_EXPR,
+ TREE_TYPE (DECL_RESULT (current_function_decl)),
+ DECL_RESULT (current_function_decl), tmp);
+ tmp = build1_v (RETURN_EXPR, tmp);
}
gfc_add_expr_to_block (&body, tmp);
@@ -1473,11 +1473,12 @@ build_entry_thunks (gfc_namespace * ns)
points and the master function. Clear them so that they are
recreated for each function. */
for (formal = thunk_sym->formal; formal; formal = formal->next)
- {
- formal->sym->backend_decl = NULL_TREE;
- if (formal->sym->ts.type == BT_CHARACTER)
- formal->sym->ts.cl->backend_decl = NULL_TREE;
- }
+ if (formal->sym != NULL) /* Ignore alternate returns. */
+ {
+ formal->sym->backend_decl = NULL_TREE;
+ if (formal->sym->ts.type == BT_CHARACTER)
+ formal->sym->ts.cl->backend_decl = NULL_TREE;
+ }
if (thunk_sym->attr.function)
{
--- gcc/testsuite/gfortran.fortran-torture/execute/entry_1.f90.jj 2005-04-08 22:05:55.000000000 +0200
+++ gcc/testsuite/gfortran.fortran-torture/execute/entry_1.f90 2005-04-08 22:10:15.000000000 +0200
@@ -0,0 +1,40 @@
+ subroutine f1 (n, *, i)
+ integer n, i
+ if (i .ne. 42) call abort ()
+ entry e1 (n, *)
+ if (n .eq. 1) return 1
+ if (n .eq. 2) return
+ return
+ entry e2 (n, i, *, *, *)
+ if (i .ne. 46) call abort ()
+ if (n .ge. 4) return
+ return n
+ entry e3 (n, i)
+ if ((i .ne. 48) .or. (n .ne. 61)) call abort ()
+ end subroutine
+
+ program alt_return
+ implicit none
+
+ call f1 (1, *10, 42)
+20 continue
+ call abort ()
+10 continue
+ call f1 (2, *20, 42)
+ call f1 (3, *20, 42)
+ call e1 (2, *20)
+ call e1 (1, *30)
+ call abort ()
+30 continue
+ call e2 (1, 46, *40, *20, *20)
+ call abort ()
+40 continue
+ call e2 (2, 46, *20, *50, *20)
+ call abort ()
+50 continue
+ call e2 (3, 46, *20, *20, *60)
+ call abort ()
+60 continue
+ call e2 (4, 46, *20, *20, *20)
+ call e3 (61, 48)
+ end program
Jakub