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
+