diff options
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 24 |
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; } |