75 lines
2.4 KiB
Diff
75 lines
2.4 KiB
Diff
2007-04-05 Paul Thomas <pault@gcc.gnu.org>
|
|
|
|
PR fortran/31483
|
|
* trans-expr.c (gfc_conv_function_call): Give a dummy
|
|
procedure the correct type if it has alternate returns.
|
|
|
|
* gfortran.dg/altreturn_5.f90: New test.
|
|
|
|
--- gcc/fortran/trans-expr.c (revision 123517)
|
|
+++ gcc/fortran/trans-expr.c (revision 123518)
|
|
@@ -2154,17 +2154,23 @@ gfc_conv_function_call (gfc_se * se, gfc
|
|
|
|
/* Generate the actual call. */
|
|
gfc_conv_function_val (se, sym);
|
|
+
|
|
/* If there are alternate return labels, function type should be
|
|
integer. Can't modify the type in place though, since it can be shared
|
|
- with other functions. */
|
|
+ with other functions. For dummy arguments, the typing is done to
|
|
+ this result, even if it has to be repeated for each call. */
|
|
if (has_alternate_specifier
|
|
&& TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) != integer_type_node)
|
|
{
|
|
- gcc_assert (! sym->attr.dummy);
|
|
- TREE_TYPE (sym->backend_decl)
|
|
- = build_function_type (integer_type_node,
|
|
- TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl)));
|
|
- se->expr = gfc_build_addr_expr (NULL, sym->backend_decl);
|
|
+ if (!sym->attr.dummy)
|
|
+ {
|
|
+ TREE_TYPE (sym->backend_decl)
|
|
+ = build_function_type (integer_type_node,
|
|
+ TYPE_ARG_TYPES (TREE_TYPE (sym->backend_decl)));
|
|
+ se->expr = gfc_build_addr_expr (NULL, sym->backend_decl);
|
|
+ }
|
|
+ else
|
|
+ TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
|
|
}
|
|
|
|
fntype = TREE_TYPE (TREE_TYPE (se->expr));
|
|
--- gcc/testsuite/gfortran.dg/altreturn_5.f90 (revision 0)
|
|
+++ gcc/testsuite/gfortran.dg/altreturn_5.f90 (revision 123518)
|
|
@@ -0,0 +1,31 @@
|
|
+! { dg-do run }
|
|
+! Tests the fix for PR31483, in which dummy argument procedures
|
|
+! produced an ICE if they had an alternate return.
|
|
+!
|
|
+! Contributed by Mathias Fröhlich <M.Froehlich@science-computing.de>
|
|
+
|
|
+ SUBROUTINE R (i, *, *)
|
|
+ INTEGER i
|
|
+ RETURN i
|
|
+ END
|
|
+
|
|
+ SUBROUTINE PHLOAD (READER, i, res)
|
|
+ IMPLICIT NONE
|
|
+ EXTERNAL READER
|
|
+ integer i
|
|
+ character(3) res
|
|
+ CALL READER (i, *1, *2)
|
|
+ 1 res = "one"
|
|
+ return
|
|
+ 2 res = "two"
|
|
+ return
|
|
+ END
|
|
+
|
|
+ EXTERNAL R
|
|
+ character(3) res
|
|
+ call PHLOAD (R, 1, res)
|
|
+ if (res .ne. "one") call abort ()
|
|
+ CALL PHLOAD (R, 2, res)
|
|
+ if (res .ne. "two") call abort ()
|
|
+ END
|
|
+
|