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

gcc/ChangeLog

@@ -1,3 +1,15 @@
+2005-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* 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.
+
 2005-06-13  Zdenek Dvorak  <dvorakz@suse.cz>
 
 	PR middle-end/21985

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;
 }
 
 

gcc/fortran/trans-stmt.c

@@ -37,8 +37,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 #include "trans-const.h"
 #include "arith.h"
 
-int has_alternate_specifier;
-
 typedef struct iter_info
 {
   tree var;
@@ -206,6 +204,7 @@ tree
 gfc_trans_call (gfc_code * code)
 {
   gfc_se se;
+  int has_alternate_specifier;
 
   /* A CALL starts a new block because the actual arguments may have to
      be evaluated first.  */
@@ -213,10 +212,10 @@ gfc_trans_call (gfc_code * code)
   gfc_start_block (&se.pre);
 
   gcc_assert (code->resolved_sym);
-  has_alternate_specifier = 0;
 
   /* Translate the call.  */
-  gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
+  has_alternate_specifier
+    = gfc_conv_function_call (&se, code->resolved_sym, code->ext.actual);
 
   /* A subroutine without side-effect, by definition, does nothing!  */
   TREE_SIDE_EFFECTS (se.expr) = 1;

gcc/fortran/trans.h

@@ -301,7 +301,7 @@ void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
 int gfc_is_intrinsic_libcall (gfc_expr *);
 
 /* Also used to CALL subroutines.  */
-void gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *);
+int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *);
 /* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
 
 /* Generate code for a scalar assignment.  */
@@ -574,7 +574,4 @@ struct lang_decl		GTY(())
                                           arg1, arg2)
 #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \
                                                 arg1, arg2, arg3)
-
-/* flag for alternative return labels.  */
-extern int has_alternate_specifier;  /* for caller */
 #endif /* GFC_TRANS_H */

gcc/testsuite/ChangeLog

@@ -1,3 +1,7 @@
+2005-06-13  Jakub Jelinek  <jakub@redhat.com>
+
+	* gfortran.dg/altreturn_1.f90: New test.
+
 2005-06-13  Zdenek Dvorak  <dvorakz@suse.cz>
 
 	PR middle-end/21985

gcc/testsuite/gfortran.dg/altreturn_1.f90

@@ -0,0 +1,7 @@
+! { dg-do compile }
+	subroutine foo (a)
+	real t, a, baz
+	call bar (*10)
+	t = 2 * baz ()
+	IF (t.gt.0) t = baz ()
+10	END