trans-expr.c (gfc_conv_function_call): Return int instead of void.

	* trans-expr.c (gfc_conv_function_call): Return int instead of
	void.  Use a local variable for has_alternate_specifier and
	return it.  Avoid modification of function type's return value
	in place, since it may be shared.
	* trans.h (has_alternate_specifier): Remove.
	(gfc_conv_function_call): Change return type.
	* trans-stmt.c (has_alternate_specifier): Remove.
	(gfc_trans_call): Add a local has_alternate_specifier variable,
	set it from gfc_conv_function_call return value.

	* gfortran.dg/altreturn_1.f90: New test.

From-SVN: r100878

1 files changed, 18 insertions, 6 deletions

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 4395534..3a4d52a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1073,9 +1073,10 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
 
 
 /* Generate code for a procedure call.  Note can return se->post != NULL.
-   If se->direct_byref is set then se->expr contains the return parameter.  */
+   If se->direct_byref is set then se->expr contains the return parameter.
+   Return non-zero, if the call has alternate specifiers.  */
 
-void
+int
 gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 			gfc_actual_arglist * arg)
 {
@@ -1091,6 +1092,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
   tree len;
   tree stringargs;
   gfc_formal_arglist *formal;
+  int has_alternate_specifier = 0;
 
   arglist = NULL_TREE;
   stringargs = NULL_TREE;
@@ -1123,7 +1125,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 
 	      /* Bundle in the string length.  */
 	      se->string_length = len;
-              return;
+              return 0;
             }
 	}
       info = &se->ss->data.info;
@@ -1307,9 +1309,17 @@ 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.  */
-  if (has_alternate_specifier)
-    TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
+     integer.  Can't modify the type in place though, since it can be shared
+     with other functions.  */
+  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);
+    }
 
   fntype = TREE_TYPE (TREE_TYPE (se->expr));
   se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
@@ -1378,6 +1388,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
 	    }
 	}
     }
+
+  return has_alternate_specifier;
 }