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