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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6e1be68..5b3001f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,11 @@
 2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
 \r
+       PR fortran/31483\r
+       * trans-expr.c (gfc_conv_function_call): Give a dummy\r
+       procedure the correct type if it has alternate returns.\r
+\r
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
+\r
        PR fortran/31292\r
        * decl.c (gfc_match_modproc): Go up to the top of the namespace\r
        tree to find the module namespace for gfc_get_symbol.\r

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 036d55b..5ff0c44 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -2392,17 +2392,23 @@ 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);
-      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);
+      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));

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c3fccfa..28316c2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,10 @@
 2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
 \r
+       PR fortran/31483\r
+       * gfortran.dg/altreturn_5.f90: New test.\r
+
+2007-04-05  Paul Thomas  <pault@gcc.gnu.org>\r
+\r
        PR fortran/31292\r
        * gfortran.dg/contained_module_proc_1.f90: New test.\r
 \r

diff --git a/gcc/testsuite/gfortran.dg/altreturn_5.f90 b/gcc/testsuite/gfortran.dg/altreturn_5.f90
new file mode 100644 (file)
index 0000000..ff1b822
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/altreturn_5.f90
@@ -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)\r
+      IMPLICIT NONE\r
+      EXTERNAL         READER
+      integer i
+      character(3) res\r
+      CALL READER (i, *1, *2)\r
+ 1    res = "one"
+      return\r
+ 2    res = "two"
+      return\r
+      END
+
+      EXTERNAL R
+      character(3) res\r
+      call PHLOAD (R, 1, res)
+      if (res .ne. "one") call abort ()
+      CALL PHLOAD (R, 2, res)
+      if (res .ne. "two") call abort ()
+      END\r
+\r