Commit dda895f9 by Jakub Jelinek Committed by Jakub Jelinek

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
parent adacecf1
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> 2005-06-13 Zdenek Dvorak <dvorakz@suse.cz>
PR middle-end/21985 PR middle-end/21985
......
...@@ -1073,9 +1073,10 @@ gfc_conv_function_val (gfc_se * se, gfc_symbol * sym) ...@@ -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. /* 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_conv_function_call (gfc_se * se, gfc_symbol * sym,
gfc_actual_arglist * arg) gfc_actual_arglist * arg)
{ {
...@@ -1091,6 +1092,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -1091,6 +1092,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
tree len; tree len;
tree stringargs; tree stringargs;
gfc_formal_arglist *formal; gfc_formal_arglist *formal;
int has_alternate_specifier = 0;
arglist = NULL_TREE; arglist = NULL_TREE;
stringargs = NULL_TREE; stringargs = NULL_TREE;
...@@ -1123,7 +1125,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -1123,7 +1125,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
/* Bundle in the string length. */ /* Bundle in the string length. */
se->string_length = len; se->string_length = len;
return; return 0;
} }
} }
info = &se->ss->data.info; info = &se->ss->data.info;
...@@ -1307,9 +1309,17 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, ...@@ -1307,9 +1309,17 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
/* Generate the actual call. */ /* Generate the actual call. */
gfc_conv_function_val (se, sym); gfc_conv_function_val (se, sym);
/* If there are alternate return labels, function type should be /* If there are alternate return labels, function type should be
integer. */ integer. Can't modify the type in place though, since it can be shared
if (has_alternate_specifier) with other functions. */
TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node; 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)); fntype = TREE_TYPE (TREE_TYPE (se->expr));
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), 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, ...@@ -1378,6 +1388,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
} }
} }
} }
return has_alternate_specifier;
} }
......
...@@ -37,8 +37,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA ...@@ -37,8 +37,6 @@ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
#include "trans-const.h" #include "trans-const.h"
#include "arith.h" #include "arith.h"
int has_alternate_specifier;
typedef struct iter_info typedef struct iter_info
{ {
tree var; tree var;
...@@ -206,6 +204,7 @@ tree ...@@ -206,6 +204,7 @@ tree
gfc_trans_call (gfc_code * code) gfc_trans_call (gfc_code * code)
{ {
gfc_se se; gfc_se se;
int has_alternate_specifier;
/* A CALL starts a new block because the actual arguments may have to /* A CALL starts a new block because the actual arguments may have to
be evaluated first. */ be evaluated first. */
...@@ -213,10 +212,10 @@ gfc_trans_call (gfc_code * code) ...@@ -213,10 +212,10 @@ gfc_trans_call (gfc_code * code)
gfc_start_block (&se.pre); gfc_start_block (&se.pre);
gcc_assert (code->resolved_sym); gcc_assert (code->resolved_sym);
has_alternate_specifier = 0;
/* Translate the call. */ /* 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! */ /* A subroutine without side-effect, by definition, does nothing! */
TREE_SIDE_EFFECTS (se.expr) = 1; TREE_SIDE_EFFECTS (se.expr) = 1;
......
...@@ -301,7 +301,7 @@ void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *); ...@@ -301,7 +301,7 @@ void gfc_conv_intrinsic_function (gfc_se *, gfc_expr *);
int gfc_is_intrinsic_libcall (gfc_expr *); int gfc_is_intrinsic_libcall (gfc_expr *);
/* Also used to CALL subroutines. */ /* 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 */ /* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
/* Generate code for a scalar assignment. */ /* Generate code for a scalar assignment. */
...@@ -574,7 +574,4 @@ struct lang_decl GTY(()) ...@@ -574,7 +574,4 @@ struct lang_decl GTY(())
arg1, arg2) arg1, arg2)
#define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \ #define build3_v(code, arg1, arg2, arg3) build3(code, void_type_node, \
arg1, arg2, arg3) arg1, arg2, arg3)
/* flag for alternative return labels. */
extern int has_alternate_specifier; /* for caller */
#endif /* GFC_TRANS_H */ #endif /* GFC_TRANS_H */
2005-06-13 Jakub Jelinek <jakub@redhat.com>
* gfortran.dg/altreturn_1.f90: New test.
2005-06-13 Zdenek Dvorak <dvorakz@suse.cz> 2005-06-13 Zdenek Dvorak <dvorakz@suse.cz>
PR middle-end/21985 PR middle-end/21985
......
! { dg-do compile }
subroutine foo (a)
real t, a, baz
call bar (*10)
t = 2 * baz ()
IF (t.gt.0) t = baz ()
10 END
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment