re PR fortran/31483 ([4.1/4.2 only] ICE on fortran Code)

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.

2007-04-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31483
	* gfortran.dg/altreturn_5.f90: New test.

From-SVN: r123518

gcc/fortran/ChangeLog

 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.
+
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/31292
 	* decl.c (gfc_match_modproc): Go up to the top of the namespace
 	tree to find the module namespace for gfc_get_symbol.

gcc/fortran/trans-expr.c

@@ -2392,18 +2392,24 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 
   /* 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
+     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);
+      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 = build_fold_addr_expr (sym->backend_decl);
 	}
+      else
+	TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
+    }
 
   fntype = TREE_TYPE (TREE_TYPE (se->expr));
   se->expr = build_call_list (TREE_TYPE (fntype), se->expr, arglist);

gcc/testsuite/ChangeLog

 2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
 
+	PR fortran/31483
+	* gfortran.dg/altreturn_5.f90: New test.
+
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>
+
 	PR fortran/31292
 	* gfortran.dg/contained_module_proc_1.f90: New test.
 

gcc/testsuite/gfortran.dg/altreturn_5.f90

+! { 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
+