/* Expression translation
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software
- Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+ Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl>
#include "ggc.h"
#include "toplev.h"
#include "real.h"
-#include "tree-gimple.h"
+#include "gimple.h"
#include "langhooks.h"
#include "flags.h"
#include "gfortran.h"
/* We need a temporary for this result. */
var = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, var, se->expr);
+ gfc_add_modify (&se->pre, var, se->expr);
se->expr = var;
}
tmp = fold_convert (tmp, build_fold_indirect_ref (se->expr));
/* Test for a NULL value. */
- tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, tmp, integer_one_node);
+ tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present, tmp,
+ fold_convert (TREE_TYPE (tmp), integer_one_node));
tmp = gfc_evaluate_now (tmp, &se->pre);
- se->expr = build_fold_addr_expr (tmp);
+ se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
}
else
{
return length;
}
-
+
+/* For each character array constructor subexpression without a ts.cl->length,
+ replace it by its first element (if there aren't any elements, the length
+ should already be set to zero). */
+
+static void
+flatten_array_ctors_without_strlen (gfc_expr* e)
+{
+ gfc_actual_arglist* arg;
+ gfc_constructor* c;
+
+ if (!e)
+ return;
+
+ switch (e->expr_type)
+ {
+
+ case EXPR_OP:
+ flatten_array_ctors_without_strlen (e->value.op.op1);
+ flatten_array_ctors_without_strlen (e->value.op.op2);
+ break;
+
+ case EXPR_COMPCALL:
+ /* TODO: Implement as with EXPR_FUNCTION when needed. */
+ gcc_unreachable ();
+
+ case EXPR_FUNCTION:
+ for (arg = e->value.function.actual; arg; arg = arg->next)
+ flatten_array_ctors_without_strlen (arg->expr);
+ break;
+
+ case EXPR_ARRAY:
+
+ /* We've found what we're looking for. */
+ if (e->ts.type == BT_CHARACTER && !e->ts.cl->length)
+ {
+ gfc_expr* new_expr;
+ gcc_assert (e->value.constructor);
+
+ new_expr = e->value.constructor->expr;
+ e->value.constructor->expr = NULL;
+
+ flatten_array_ctors_without_strlen (new_expr);
+ gfc_replace_expr (e, new_expr);
+ break;
+ }
+
+ /* Otherwise, fall through to handle constructor elements. */
+ case EXPR_STRUCTURE:
+ for (c = e->value.constructor; c; c = c->next)
+ flatten_array_ctors_without_strlen (c->expr);
+ break;
+
+ default:
+ break;
+
+ }
+}
+
/* Generate code to initialize a string length variable. Returns the
- value. */
+ value. For array constructors, cl->length might be NULL and in this case,
+ the first element of the constructor is needed. expr is the original
+ expression so we can access it but can be NULL if this is not needed. */
void
-gfc_conv_string_length (gfc_charlen * cl, stmtblock_t * pblock)
+gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
{
gfc_se se;
gfc_init_se (&se, NULL);
+
+ /* If cl->length is NULL, use gfc_conv_expr to obtain the string length but
+ "flatten" array constructors by taking their first element; all elements
+ should be the same length or a cl->length should be present. */
+ if (!cl->length)
+ {
+ gfc_expr* expr_flat;
+ gcc_assert (expr);
+
+ expr_flat = gfc_copy_expr (expr);
+ flatten_array_ctors_without_strlen (expr_flat);
+ gfc_resolve_expr (expr_flat);
+
+ gfc_conv_expr (&se, expr_flat);
+ gfc_add_block_to_block (pblock, &se.pre);
+ cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
+
+ gfc_free_expr (expr_flat);
+ return;
+ }
+
+ /* Convert cl->length. */
+
+ gcc_assert (cl->length);
+
gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr,
build_int_cst (gfc_charlen_type_node, 0));
gfc_add_block_to_block (pblock, &se.pre);
if (cl->backend_decl)
- gfc_add_modify_expr (pblock, cl->backend_decl, se.expr);
+ gfc_add_modify (pblock, cl->backend_decl, se.expr);
else
cl->backend_decl = gfc_evaluate_now (se.expr, pblock);
}
if (!CONSTANT_CLASS_P (end.expr) && !DECL_P (end.expr))
end.expr = gfc_evaluate_now (end.expr, &se->pre);
- if (flag_bounds_check)
+ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
tree nonempty = fold_build2 (LE_EXPR, boolean_type_node,
start.expr, end.expr);
else
asprintf (&msg, "Substring out of bounds: lower bound (%%ld)"
"is less than one");
- gfc_trans_runtime_check (fault, &se->pre, where, msg,
+ gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
fold_convert (long_integer_type_node,
start.expr));
gfc_free (msg);
else
asprintf (&msg, "Substring out of bounds: upper bound (%%ld) "
"exceeds string length (%%ld)");
- gfc_trans_runtime_check (fault, &se->pre, where, msg,
+ gfc_trans_runtime_check (true, false, fault, &se->pre, where, msg,
fold_convert (long_integer_type_node, end.expr),
fold_convert (long_integer_type_node,
se->string_length));
se->string_length = tmp;
}
- if (c->pointer && c->dimension == 0 && c->ts.type != BT_CHARACTER)
+ if ((c->attr.pointer && c->attr.dimension == 0 && c->ts.type != BT_CHARACTER)
+ || c->attr.proc_pointer)
se->expr = build_fold_indirect_ref (se->expr);
}
+/* This function deals with component references to components of the
+ parent type for derived type extensons. */
+static void
+conv_parent_component_references (gfc_se * se, gfc_ref * ref)
+{
+ gfc_component *c;
+ gfc_component *cmp;
+ gfc_symbol *dt;
+ gfc_ref parent;
+
+ dt = ref->u.c.sym;
+ c = ref->u.c.component;
+
+ /* Build a gfc_ref to recursively call gfc_conv_component_ref. */
+ parent.type = REF_COMPONENT;
+ parent.next = NULL;
+ parent.u.c.sym = dt;
+ parent.u.c.component = dt->components;
+
+ if (dt->attr.extension && dt->components)
+ {
+ /* Return if the component is not in the parent type. */
+ for (cmp = dt->components->next; cmp; cmp = cmp->next)
+ if (strcmp (c->name, cmp->name) == 0)
+ return;
+
+ /* Otherwise build the reference and call self. */
+ gfc_conv_component_ref (se, &parent);
+ parent.u.c.sym = dt->components->ts.derived;
+ parent.u.c.component = c;
+ conv_parent_component_references (se, &parent);
+ }
+}
+
/* Return the contents of a variable. Also handles reference/pointer
variables (all Fortran pointer references are implicit). */
if (!sym->attr.dummy && !sym->attr.proc_pointer)
{
gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL);
- se->expr = build_fold_addr_expr (se->expr);
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
}
return;
}
break;
case REF_COMPONENT:
+ if (ref->u.c.sym->attr.extension)
+ conv_parent_component_references (se, ref);
+
gfc_conv_component_ref (se, ref);
break;
if (expr->ts.type == BT_CHARACTER)
gfc_conv_string_parameter (se);
else
- se->expr = build_fold_addr_expr (se->expr);
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
}
}
fold_build2 (MULT_EXPR, TREE_TYPE (len), len,
fold_convert (TREE_TYPE (len),
TYPE_SIZE (type))));
- gfc_add_modify_expr (&se->pre, var, tmp);
+ gfc_add_modify (&se->pre, var, tmp);
/* Free the temporary afterwards. */
tmp = gfc_call_free (convert (pvoid_type_node, var));
}
static void
-gfc_conv_function_val (gfc_se * se, gfc_symbol * sym)
+conv_function_val (gfc_se * se, gfc_symbol * sym, gfc_expr * expr)
{
tree tmp;
- if (sym->attr.dummy)
+ if (is_proc_ptr_comp (expr, NULL))
+ tmp = gfc_get_proc_ptr_comp (se, expr);
+ else if (sym->attr.dummy)
{
tmp = gfc_get_symbol_decl (sym);
if (sym->attr.proc_pointer)
sym->backend_decl = gfc_get_extern_function_decl (sym);
tmp = sym->backend_decl;
+
if (sym->attr.cray_pointee)
- tmp = convert (build_pointer_type (TREE_TYPE (tmp)),
- gfc_get_symbol_decl (sym->cp_pointer));
+ {
+ /* TODO - make the cray pointee a pointer to a procedure,
+ assign the pointer to it and use it for the call. This
+ will do for now! */
+ tmp = convert (build_pointer_type (TREE_TYPE (tmp)),
+ gfc_get_symbol_decl (sym->cp_pointer));
+ tmp = gfc_evaluate_now (tmp, &se->pre);
+ }
+
if (!POINTER_TYPE_P (TREE_TYPE (tmp)))
{
gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);
- tmp = build_fold_addr_expr (tmp);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
}
}
se->expr = tmp;
}
-/* Translate the call for an elemental subroutine call used in an operator
- assignment. This is a simplified version of gfc_conv_function_call. */
-
-tree
-gfc_conv_operator_assign (gfc_se *lse, gfc_se *rse, gfc_symbol *sym)
-{
- tree args;
- tree tmp;
- gfc_se se;
- stmtblock_t block;
-
- /* Only elemental subroutines with two arguments. */
- gcc_assert (sym->attr.elemental && sym->attr.subroutine);
- gcc_assert (sym->formal->next->next == NULL);
-
- gfc_init_block (&block);
-
- gfc_add_block_to_block (&block, &lse->pre);
- gfc_add_block_to_block (&block, &rse->pre);
-
- /* Build the argument list for the call, including hidden string lengths. */
- args = gfc_chainon_list (NULL_TREE, build_fold_addr_expr (lse->expr));
- args = gfc_chainon_list (args, build_fold_addr_expr (rse->expr));
- if (lse->string_length != NULL_TREE)
- args = gfc_chainon_list (args, lse->string_length);
- if (rse->string_length != NULL_TREE)
- args = gfc_chainon_list (args, rse->string_length);
-
- /* Build the function call. */
- gfc_init_se (&se, NULL);
- gfc_conv_function_val (&se, sym);
- tmp = TREE_TYPE (TREE_TYPE (TREE_TYPE (se.expr)));
- tmp = build_call_list (tmp, se.expr, args);
- gfc_add_expr_to_block (&block, tmp);
-
- gfc_add_block_to_block (&block, &lse->post);
- gfc_add_block_to_block (&block, &rse->post);
-
- return gfc_finish_block (&block);
-}
-
-
/* Initialize MAPPING. */
void
for (sym = mapping->syms; sym; sym = nextsym)
{
nextsym = sym->next;
+ sym->new_sym->n.sym->formal = NULL;
gfc_free_symbol (sym->new_sym->n.sym);
gfc_free_expr (sym->expr);
gfc_free (sym->new_sym);
type = gfc_get_nodesc_array_type (type, sym->as, packed);
var = gfc_create_var (type, "ifm");
- gfc_add_modify_expr (block, var, fold_convert (type, data));
+ gfc_add_modify (block, var, fold_convert (type, data));
return var;
}
/* Create a new symbol to represent the actual argument. */
new_sym = gfc_new_symbol (sym->name, NULL);
new_sym->ts = sym->ts;
+ new_sym->as = gfc_copy_array_spec (sym->as);
new_sym->attr.referenced = 1;
new_sym->attr.dimension = sym->attr.dimension;
new_sym->attr.pointer = sym->attr.pointer;
new_sym->attr.flavor = sym->attr.flavor;
new_sym->attr.function = sym->attr.function;
+ /* Ensure that the interface is available and that
+ descriptors are passed for array actual arguments. */
+ if (sym->attr.flavor == FL_PROCEDURE)
+ {
+ new_sym->formal = expr->symtree->n.sym->formal;
+ new_sym->attr.always_explicit
+ = expr->symtree->n.sym->attr.always_explicit;
+ }
+
/* Create a fake symtree for it. */
root = NULL;
new_symtree = gfc_new_symtree (&root, sym->name);
gfc_apply_interface_mapping_to_expr (mapping, expr);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
-
+ se.expr = fold_convert (gfc_charlen_type_node, se.expr);
se.expr = gfc_evaluate_now (se.expr, &se.pre);
gfc_add_block_to_block (pre, &se.pre);
gfc_add_block_to_block (post, &se.post);
/* Convert intrinsic function calls into result expressions. */
+
static bool
-gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping * mapping)
+gfc_map_intrinsic_function (gfc_expr *expr, gfc_interface_mapping *mapping)
{
gfc_symbol *sym;
gfc_expr *new_expr;
else
arg2 = NULL;
- sym = arg1->symtree->n.sym;
+ sym = arg1->symtree->n.sym;
if (sym->attr.dummy)
return false;
case GFC_ISYM_LEN:
/* TODO figure out why this condition is necessary. */
if (sym->attr.function
- && arg1->ts.cl->length->expr_type != EXPR_CONSTANT
- && arg1->ts.cl->length->expr_type != EXPR_VARIABLE)
+ && (arg1->ts.cl->length == NULL
+ || (arg1->ts.cl->length->expr_type != EXPR_CONSTANT
+ && arg1->ts.cl->length->expr_type != EXPR_VARIABLE)))
return false;
new_expr = gfc_copy_expr (arg1->ts.cl->length);
for (; d < dup; d++)
{
gfc_expr *tmp;
+
+ if (!sym->as->upper[d] || !sym->as->lower[d])
+ {
+ gfc_free_expr (new_expr);
+ return false;
+ }
+
tmp = gfc_add (gfc_copy_expr (sym->as->upper[d]), gfc_int_expr (1));
tmp = gfc_subtract (tmp, gfc_copy_expr (sym->as->lower[d]));
if (new_expr)
gcc_unreachable ();
if (expr->value.function.isym->id == GFC_ISYM_LBOUND)
- new_expr = gfc_copy_expr (sym->as->lower[d]);
+ {
+ if (sym->as->lower[d])
+ new_expr = gfc_copy_expr (sym->as->lower[d]);
+ }
else
- new_expr = gfc_copy_expr (sym->as->upper[d]);
+ {
+ if (sym->as->upper[d])
+ new_expr = gfc_copy_expr (sym->as->upper[d]);
+ }
break;
default:
case EXPR_STRUCTURE:
gfc_apply_interface_mapping_to_cons (mapping, expr->value.constructor);
break;
+
+ case EXPR_COMPCALL:
+ case EXPR_PPC:
+ gcc_unreachable ();
+ break;
}
return;
/* Build an ss for the temporary. */
if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
- gfc_conv_string_length (expr->ts.cl, &parmse->pre);
+ gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre);
base_type = gfc_typenode_for_spec (&expr->ts);
if (GFC_ARRAY_TYPE_P (base_type)
tmp_index = fold_build2 (MINUS_EXPR, gfc_array_index_type,
tmp_index, rse.loop->from[0]);
- gfc_add_modify_expr (&rse.loop->code[0], offset, tmp_index);
+ gfc_add_modify (&rse.loop->code[0], offset, tmp_index);
tmp_index = fold_build2 (PLUS_EXPR, gfc_array_index_type,
rse.loop->loopvar[0], offset);
if (g77)
parmse->expr = gfc_conv_descriptor_data_get (parmse->expr);
else
- parmse->expr = build_fold_addr_expr (parmse->expr);
+ parmse->expr = gfc_build_addr_expr (NULL_TREE, parmse->expr);
return;
}
/* 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.
- Return nonzero, if the call has alternate specifiers. */
+ Return nonzero, if the call has alternate specifiers.
+ 'expr' is only needed for procedure pointer components. */
int
-gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
- gfc_actual_arglist * arg, tree append_args)
+gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
+ gfc_actual_arglist * arg, gfc_expr * expr,
+ tree append_args)
{
gfc_interface_mapping mapping;
tree arglist;
gfc_symbol *fsym;
stmtblock_t post;
enum {MISSING = 0, ELEMENTAL, SCALAR, SCALAR_POINTER, ARRAY};
+ gfc_component *comp = NULL;
arglist = NULL_TREE;
retargs = NULL_TREE;
f = f || !sym->attr.always_explicit;
argss = gfc_walk_expr (arg->expr);
- gfc_conv_array_parameter (se, arg->expr, argss, f);
+ gfc_conv_array_parameter (se, arg->expr, argss, f,
+ NULL, NULL, NULL);
}
/* TODO -- the following two lines shouldn't be necessary, but
gfc_add_block_to_block (&se->post, &cptrse.post);
gfc_init_se (&fptrse, NULL);
- if (sym->intmod_sym_id == ISOCBINDING_F_POINTER)
- fptrse.want_pointer = 1;
+ if (sym->intmod_sym_id == ISOCBINDING_F_POINTER
+ || is_proc_ptr_comp (arg->next->expr, NULL))
+ fptrse.want_pointer = 1;
gfc_conv_expr (&fptrse, arg->next->expr);
gfc_add_block_to_block (&se->pre, &fptrse.pre);
gfc_add_block_to_block (&se->post, &fptrse.post);
- tmp = arg->next->expr->symtree->n.sym->backend_decl;
- se->expr = fold_build2 (MODIFY_EXPR, TREE_TYPE (tmp), fptrse.expr,
- fold_convert (TREE_TYPE (tmp), cptrse.expr));
+ if (is_proc_ptr_comp (arg->next->expr, NULL))
+ tmp = gfc_get_ppc_type (arg->next->expr->ref->u.c.component);
+ else
+ tmp = TREE_TYPE (arg->next->expr->symtree->n.sym->backend_decl);
+ se->expr = fold_build2 (MODIFY_EXPR, tmp, fptrse.expr,
+ fold_convert (tmp, cptrse.expr));
return 0;
}
gfc_init_block (&post);
gfc_init_interface_mapping (&mapping);
+ is_proc_ptr_comp (expr, &comp);
need_interface_mapping = ((sym->ts.type == BT_CHARACTER
&& sym->ts.cl->length
&& sym->ts.cl->length->expr_type
!= EXPR_CONSTANT)
- || sym->attr.dimension);
+ || (comp && comp->attr.dimension)
+ || (!comp && sym->attr.dimension));
formal = sym->formal;
/* Evaluate the arguments. */
for (; arg != NULL; arg = arg->next, formal = formal ? formal->next : NULL)
if (argss == gfc_ss_terminator)
{
- if (fsym && fsym->attr.value)
+ if (e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->attr.cray_pointee
+ && fsym && fsym->attr.flavor == FL_PROCEDURE)
+ {
+ /* The Cray pointer needs to be converted to a pointer to
+ a type given by the expression. */
+ gfc_conv_expr (&parmse, e);
+ type = build_pointer_type (TREE_TYPE (parmse.expr));
+ tmp = gfc_get_symbol_decl (e->symtree->n.sym->cp_pointer);
+ parmse.expr = convert (type, tmp);
+ }
+ else if (fsym && fsym->attr.value)
{
if (fsym->ts.type == BT_CHARACTER
&& fsym->ts.is_c_interop
&& fsym && fsym->attr.target)
{
gfc_conv_expr (&parmse, e);
- parmse.expr = build_fold_addr_expr (parmse.expr);
+ parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
}
else
{
indirection. The null pointer already contains
this level of indirection. */
parm_kind = SCALAR_POINTER;
- parmse.expr = build_fold_addr_expr (parmse.expr);
+ parmse.expr = gfc_build_addr_expr (NULL_TREE, parmse.expr);
}
}
}
gfc_conv_subref_array_arg (&parmse, e, f,
fsym ? fsym->attr.intent : INTENT_INOUT);
else
- gfc_conv_array_parameter (&parmse, e, argss, f);
+ gfc_conv_array_parameter (&parmse, e, argss, f, fsym,
+ sym->name, NULL);
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
allocated on entry, it must be deallocated. */
&& parmse.string_length == NULL_TREE
&& e->ts.type == BT_PROCEDURE
&& e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.cl->length != NULL)
+ && e->symtree->n.sym->ts.cl->length != NULL
+ && e->symtree->n.sym->ts.cl->length->expr_type == EXPR_CONSTANT)
{
gfc_conv_const_charlen (e->symtree->n.sym->ts.cl);
parmse.string_length = e->symtree->n.sym->ts.cl->backend_decl;
gfc_add_block_to_block (&post, &parmse.post);
/* Allocated allocatable components of derived types must be
- deallocated for INTENT(OUT) dummy arguments and non-variable
- scalars. Non-variable arrays are dealt with in trans-array.c
- (gfc_conv_array_parameter). */
+ deallocated for non-variable scalars. Non-variable arrays are
+ dealt with in trans-array.c(gfc_conv_array_parameter). */
if (e && e->ts.type == BT_DERIVED
&& e->ts.derived->attr.alloc_comp
- && ((formal && formal->sym->attr.intent == INTENT_OUT)
- ||
- (e->expr_type != EXPR_VARIABLE && !e->rank)))
+ && (e->expr_type != EXPR_VARIABLE && !e->rank))
{
int parm_rank;
tmp = build_fold_indirect_ref (parmse.expr);
case (SCALAR_POINTER):
tmp = build_fold_indirect_ref (tmp);
break;
- case (ARRAY):
- tmp = parmse.expr;
- break;
}
- tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
- if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.optional)
- tmp = build3_v (COND_EXPR, gfc_conv_expr_present (e->symtree->n.sym),
- tmp, build_empty_stmt ());
-
- if (e->expr_type != EXPR_VARIABLE)
- /* Don't deallocate non-variables until they have been used. */
- gfc_add_expr_to_block (&se->post, tmp);
- else
+ if (e->expr_type == EXPR_OP
+ && e->value.op.op == INTRINSIC_PARENTHESES
+ && e->value.op.op1->expr_type == EXPR_VARIABLE)
{
- gcc_assert (formal && formal->sym->attr.intent == INTENT_OUT);
- gfc_add_expr_to_block (&se->pre, tmp);
+ tree local_tmp;
+ local_tmp = gfc_evaluate_now (tmp, &se->pre);
+ local_tmp = gfc_copy_alloc_comp (e->ts.derived, local_tmp, tmp, parm_rank);
+ gfc_add_expr_to_block (&se->post, local_tmp);
}
+
+ tmp = gfc_deallocate_alloc_comp (e->ts.derived, tmp, parm_rank);
+
+ gfc_add_expr_to_block (&se->post, tmp);
}
/* Character strings are passed as two parameters, a length and a
gfc_finish_interface_mapping (&mapping, &se->pre, &se->post);
ts = sym->ts;
- if (ts.type == BT_CHARACTER && !sym->attr.is_bind_c)
+ if (ts.type == BT_CHARACTER && sym->attr.is_bind_c)
+ se->string_length = build_int_cst (gfc_charlen_type_node, 1);
+ else if (ts.type == BT_CHARACTER)
{
if (sym->ts.cl->length == NULL)
{
len = cl.backend_decl;
}
- byref = gfc_return_by_reference (sym);
+ byref = (comp && comp->attr.dimension)
+ || (!comp && gfc_return_by_reference (sym));
if (byref)
{
if (se->direct_byref)
mustn't be deallocated. */
callee_alloc = sym->attr.allocatable || sym->attr.pointer;
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop, info, tmp,
- false, !sym->attr.pointer, callee_alloc,
- &se->ss->expr->where);
+ NULL_TREE, false, !sym->attr.pointer,
+ callee_alloc, &se->ss->expr->where);
/* Pass the temporary as the first argument. */
tmp = info->descriptor;
- tmp = build_fold_addr_expr (tmp);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
retargs = gfc_chainon_list (retargs, tmp);
}
else if (ts.type == BT_CHARACTER)
var = gfc_create_var (type, "pstr");
/* Provide an address expression for the function arguments. */
- var = build_fold_addr_expr (var);
+ var = gfc_build_addr_expr (NULL_TREE, var);
}
else
var = gfc_conv_string_tmp (se, type, len);
gcc_assert (gfc_option.flag_f2c && ts.type == BT_COMPLEX);
type = gfc_get_complex_type (ts.kind);
- var = build_fold_addr_expr (gfc_create_var (type, "cmplx"));
+ var = gfc_build_addr_expr (NULL_TREE, gfc_create_var (type, "cmplx"));
retargs = gfc_chainon_list (retargs, var);
}
arglist = chainon (arglist, append_args);
/* Generate the actual call. */
- gfc_conv_function_val (se, sym);
+ conv_function_val (se, sym, expr);
/* If there are alternate return labels, function type should be
integer. Can't modify the type in place though, since it can be shared
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);
+ se->expr = gfc_build_addr_expr (NULL_TREE, sym->backend_decl);
}
else
TREE_TYPE (TREE_TYPE (TREE_TYPE (se->expr))) = integer_type_node;
something like
x = f()
where f is pointer valued, we have to dereference the result. */
- if (!se->want_pointer && !byref && sym->attr.pointer)
+ if (!se->want_pointer && !byref && sym->attr.pointer
+ && !is_proc_ptr_comp (expr, NULL))
se->expr = build_fold_indirect_ref (se->expr);
/* f2c calling conventions require a scalar default real function to
{
if (sym->attr.dimension)
{
- if (flag_bounds_check)
+ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
/* Check the data pointer hasn't been modified. This would
happen in a function returning a pointer. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
tmp = fold_build2 (NE_EXPR, boolean_type_node,
tmp, info->data);
- gfc_trans_runtime_check (tmp, &se->pre, NULL, gfc_msg_fault);
+ gfc_trans_runtime_check (true, false, tmp, &se->pre, NULL,
+ gfc_msg_fault);
}
se->expr = info->descriptor;
/* Bundle in the string length. */
/* Initialize variables. */
gfc_init_block (&block);
i = gfc_create_var (sizetype, "i");
- gfc_add_modify_expr (&block, i, fold_convert (sizetype, size));
+ gfc_add_modify (&block, i, fold_convert (sizetype, size));
el = gfc_create_var (build_pointer_type (type), "el");
- gfc_add_modify_expr (&block, el, fold_convert (TREE_TYPE (el), start));
+ gfc_add_modify (&block, el, fold_convert (TREE_TYPE (el), start));
exit_label = gfc_build_label_decl (NULL_TREE);
TREE_USED (exit_label) = 1;
gfc_add_expr_to_block (&loop, tmp);
/* Assignment. */
- gfc_add_modify_expr (&loop, fold_build1 (INDIRECT_REF, type, el),
+ gfc_add_modify (&loop, fold_build1 (INDIRECT_REF, type, el),
build_int_cst (type,
lang_hooks.to_target_charset (' ')));
/* Increment loop variables. */
- gfc_add_modify_expr (&loop, i, fold_build2 (MINUS_EXPR, sizetype, i,
+ gfc_add_modify (&loop, i, fold_build2 (MINUS_EXPR, sizetype, i,
TYPE_SIZE_UNIT (type)));
- gfc_add_modify_expr (&loop, el, fold_build2 (POINTER_PLUS_EXPR,
+ gfc_add_modify (&loop, el, fold_build2 (POINTER_PLUS_EXPR,
TREE_TYPE (el), el,
TYPE_SIZE_UNIT (type)));
if (dsc != NULL_TREE && ssc != NULL_TREE
&& TREE_TYPE (dsc) == TREE_TYPE (ssc))
{
- gfc_add_modify_expr (block, dsc, ssc);
+ gfc_add_modify (block, dsc, ssc);
return;
}
/* For non-default character kinds, we have to multiply the string
length by the base type size. */
chartype = gfc_get_char_type (dkind);
- slen = fold_build2 (MULT_EXPR, size_type_node, slen,
- TYPE_SIZE_UNIT (chartype));
- dlen = fold_build2 (MULT_EXPR, size_type_node, dlen,
- TYPE_SIZE_UNIT (chartype));
+ slen = fold_build2 (MULT_EXPR, size_type_node,
+ fold_convert (size_type_node, slen),
+ fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype)));
+ dlen = fold_build2 (MULT_EXPR, size_type_node,
+ fold_convert (size_type_node, dlen),
+ fold_convert (size_type_node, TYPE_SIZE_UNIT (chartype)));
if (dlength)
dest = fold_convert (pvoid_type_node, dest);
gfc_conv_expr (&lse, args->expr);
gfc_add_block_to_block (&se->pre, &lse.pre);
- gfc_add_modify_expr (&se->pre, temp_vars[n], lse.expr);
+ gfc_add_modify (&se->pre, temp_vars[n], lse.expr);
gfc_add_block_to_block (&se->pre, &lse.post);
}
}
+/* Return the backend_decl for a procedure pointer component. */
+
+tree
+gfc_get_proc_ptr_comp (gfc_se *se, gfc_expr *e)
+{
+ gfc_se comp_se;
+ gfc_init_se (&comp_se, NULL);
+ e->expr_type = EXPR_VARIABLE;
+ gfc_conv_expr (&comp_se, e);
+ comp_se.expr = build_fold_addr_expr (comp_se.expr);
+ return gfc_evaluate_now (comp_se.expr, &se->pre);
+}
+
+
/* Translate a function expression. */
static void
sym = expr->value.function.esym;
if (!sym)
sym = expr->symtree->n.sym;
- gfc_conv_function_call (se, sym, expr->value.function.actual, NULL_TREE);
+
+ gfc_conv_procedure_call (se, sym, expr->value.function.actual, expr,
+ NULL_TREE);
}
gfc_start_block (&block);
- if (cm->pointer)
+ if (cm->attr.pointer)
{
gfc_init_se (&se, NULL);
/* Pointer component. */
- if (cm->dimension)
+ if (cm->attr.dimension)
{
/* Array pointer. */
if (expr->expr_type == EXPR_NULL)
se.want_pointer = 1;
gfc_conv_expr (&se, expr);
gfc_add_block_to_block (&block, &se.pre);
- gfc_add_modify_expr (&block, dest,
+ gfc_add_modify (&block, dest,
fold_convert (TREE_TYPE (dest), se.expr));
gfc_add_block_to_block (&block, &se.post);
}
}
- else if (cm->dimension)
+ else if (cm->attr.dimension)
{
- if (cm->allocatable && expr->expr_type == EXPR_NULL)
+ if (cm->attr.allocatable && expr->expr_type == EXPR_NULL)
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
- else if (cm->allocatable)
+ else if (cm->attr.allocatable)
{
tree tmp2;
gfc_add_block_to_block (&block, &se.pre);
tmp = fold_convert (TREE_TYPE (dest), se.expr);
- gfc_add_modify_expr (&block, dest, tmp);
+ gfc_add_modify (&block, dest, tmp);
if (cm->ts.type == BT_DERIVED && cm->ts.derived->attr.alloc_comp)
tmp = gfc_copy_alloc_comp (cm->ts.derived, se.expr, dest,
cm->as->rank);
gfc_add_expr_to_block (&block, tmp);
-
gfc_add_block_to_block (&block, &se.post);
- gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
+
+ if (expr->expr_type != EXPR_VARIABLE)
+ gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
/* Shift the lbound and ubound of temporaries to being unity, rather
than zero, based. Calculate the offset for all cases. */
offset = gfc_conv_descriptor_offset (dest);
- gfc_add_modify_expr (&block, offset, gfc_index_zero_node);
+ gfc_add_modify (&block, offset, gfc_index_zero_node);
tmp2 =gfc_create_var (gfc_array_index_type, NULL);
for (n = 0; n < expr->rank; n++)
{
tmp = gfc_conv_descriptor_ubound (dest, gfc_rank_cst[n]);
span = fold_build2 (MINUS_EXPR, gfc_array_index_type, tmp,
gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]));
- gfc_add_modify_expr (&block, tmp,
+ gfc_add_modify (&block, tmp,
fold_build2 (PLUS_EXPR,
gfc_array_index_type,
span, gfc_index_one_node));
tmp = gfc_conv_descriptor_lbound (dest, gfc_rank_cst[n]);
- gfc_add_modify_expr (&block, tmp, gfc_index_one_node);
+ gfc_add_modify (&block, tmp, gfc_index_one_node);
}
tmp = fold_build2 (MULT_EXPR, gfc_array_index_type,
gfc_conv_descriptor_lbound (dest,
gfc_rank_cst[n]),
gfc_conv_descriptor_stride (dest,
gfc_rank_cst[n]));
- gfc_add_modify_expr (&block, tmp2, tmp);
+ gfc_add_modify (&block, tmp2, tmp);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, offset, tmp2);
- gfc_add_modify_expr (&block, offset, tmp);
+ gfc_add_modify (&block, offset, tmp);
+ }
+
+ if (expr->expr_type == EXPR_FUNCTION
+ && expr->value.function.isym
+ && expr->value.function.isym->conversion
+ && expr->value.function.actual->expr
+ && expr->value.function.actual->expr->expr_type
+ == EXPR_VARIABLE)
+ {
+ /* If a conversion expression has a null data pointer
+ argument, nullify the allocatable component. */
+ gfc_symbol *s;
+ tree non_null_expr;
+ tree null_expr;
+ s = expr->value.function.actual->expr->symtree->n.sym;
+ if (s->attr.allocatable || s->attr.pointer)
+ {
+ non_null_expr = gfc_finish_block (&block);
+ gfc_start_block (&block);
+ gfc_conv_descriptor_data_set (&block, dest,
+ null_pointer_node);
+ null_expr = gfc_finish_block (&block);
+ tmp = gfc_conv_descriptor_data_get (s->backend_decl);
+ tmp = build2 (EQ_EXPR, boolean_type_node, tmp,
+ fold_convert (TREE_TYPE (tmp),
+ null_pointer_node));
+ return build3_v (COND_EXPR, tmp, null_expr,
+ non_null_expr);
+ }
}
}
else
{
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, expr);
- gfc_add_modify_expr (&block, dest,
+ gfc_add_block_to_block (&block, &se.pre);
+ gfc_add_modify (&block, dest,
fold_convert (TREE_TYPE (dest), se.expr));
+ gfc_add_block_to_block (&block, &se.post);
}
else
{
{
/* Skip absent members in default initializers. */
if (!c->expr)
- continue;
+ continue;
- /* Update the type/kind of the expression if it represents either
- C_NULL_PTR or C_NULL_FUNPTR. This is done here because this may
- be the first place reached for initializing output variables that
- have components of type C_PTR/C_FUNPTR that are initialized. */
- if (c->expr->ts.type == BT_DERIVED && c->expr->ts.derived
- && c->expr->ts.derived->attr.is_iso_c)
- {
- c->expr->expr_type = EXPR_NULL;
- c->expr->ts.type = c->expr->ts.derived->ts.type;
- c->expr->ts.f90_type = c->expr->ts.derived->ts.f90_type;
- c->expr->ts.kind = c->expr->ts.derived->ts.kind;
- }
-
field = cm->backend_decl;
tmp = fold_build3 (COMPONENT_REF, TREE_TYPE (field),
dest, field, NULL_TREE);
components. Although the latter have a default initializer
of EXPR_NULL,... by default, the static nullify is not needed
since this is done every time we come into scope. */
- if (!c->expr || cm->allocatable)
+ if (!c->expr || cm->attr.allocatable)
continue;
val = gfc_conv_initializer (c->expr, &cm->ts,
- TREE_TYPE (cm->backend_decl), cm->dimension, cm->pointer);
+ TREE_TYPE (cm->backend_decl), cm->attr.dimension,
+ cm->attr.pointer || cm->attr.proc_pointer);
/* Append it to the constructor list. */
CONSTRUCTOR_APPEND_ELT (v, cm->backend_decl, val);
if (se->post.head)
{
val = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, val, se->expr);
+ gfc_add_modify (&se->pre, val, se->expr);
se->expr = val;
gfc_add_block_to_block (&se->pre, &se->post);
}
if (se->post.head)
{
var = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, var, se->expr);
+ gfc_add_modify (&se->pre, var, se->expr);
gfc_add_block_to_block (&se->pre, &se->post);
se->expr = var;
}
se->want_pointer = 1;
gfc_conv_expr (se, expr);
var = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, var, se->expr);
+ gfc_add_modify (&se->pre, var, se->expr);
se->expr = var;
return;
}
else
{
var = gfc_create_var (TREE_TYPE (se->expr), NULL);
- gfc_add_modify_expr (&se->pre, var, se->expr);
+ gfc_add_modify (&se->pre, var, se->expr);
}
gfc_add_block_to_block (&se->pre, &se->post);
/* Take the address of that value. */
- se->expr = build_fold_addr_expr (var);
+ se->expr = gfc_build_addr_expr (NULL_TREE, var);
}
tree
gfc_trans_pointer_assign (gfc_code * code)
{
- return gfc_trans_pointer_assignment (code->expr, code->expr2);
+ return gfc_trans_pointer_assignment (code->expr1, code->expr2);
}
tree tmp;
tree decl;
-
gfc_start_block (&block);
gfc_init_se (&lse, NULL);
&& expr1->symtree->n.sym->attr.dummy)
lse.expr = build_fold_indirect_ref (lse.expr);
+ if (expr2->symtree && expr2->symtree->n.sym->attr.proc_pointer
+ && expr2->symtree->n.sym->attr.dummy)
+ rse.expr = build_fold_indirect_ref (rse.expr);
+
gfc_add_block_to_block (&block, &lse.pre);
gfc_add_block_to_block (&block, &rse.pre);
- gfc_add_modify_expr (&block, lse.expr,
+
+ /* Check character lengths if character expression. The test is only
+ really added if -fbounds-check is enabled. */
+ if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
+ {
+ gcc_assert (expr2->ts.type == BT_CHARACTER);
+ gcc_assert (lse.string_length && rse.string_length);
+ gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
+ lse.string_length, rse.string_length,
+ &block);
+ }
+
+ gfc_add_modify (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), rse.expr));
+
gfc_add_block_to_block (&block, &rse.post);
gfc_add_block_to_block (&block, &lse.post);
}
else
{
+ tree strlen_lhs;
+ tree strlen_rhs = NULL_TREE;
+
/* Array pointer. */
gfc_conv_expr_descriptor (&lse, expr1, lss);
+ strlen_lhs = lse.string_length;
switch (expr2->expr_type)
{
case EXPR_NULL:
case EXPR_VARIABLE:
/* Assign directly to the pointer's descriptor. */
- lse.direct_byref = 1;
+ lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2, rss);
+ strlen_rhs = lse.string_length;
/* If this is a subreference array pointer assignment, use the rhs
descriptor element size for the lhs span. */
tmp = gfc_get_element_type (TREE_TYPE (rse.expr));
tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
if (!INTEGER_CST_P (tmp))
- gfc_add_block_to_block (&lse.post, &rse.pre);
- gfc_add_modify_expr (&lse.post, GFC_DECL_SPAN(decl), tmp);
+ gfc_add_block_to_block (&lse.post, &rse.pre);
+ gfc_add_modify (&lse.post, GFC_DECL_SPAN(decl), tmp);
}
break;
lse.expr = tmp;
lse.direct_byref = 1;
gfc_conv_expr_descriptor (&lse, expr2, rss);
- gfc_add_modify_expr (&lse.pre, desc, tmp);
+ strlen_rhs = lse.string_length;
+ gfc_add_modify (&lse.pre, desc, tmp);
break;
- }
+ }
+
gfc_add_block_to_block (&block, &lse.pre);
+
+ /* Check string lengths if applicable. The check is only really added
+ to the output code if -fbounds-check is enabled. */
+ if (expr1->ts.type == BT_CHARACTER && expr2->expr_type != EXPR_NULL)
+ {
+ gcc_assert (expr2->ts.type == BT_CHARACTER);
+ gcc_assert (strlen_lhs && strlen_rhs);
+ gfc_trans_same_strlen_check ("pointer assignment", &expr1->where,
+ strlen_lhs, strlen_rhs, &block);
+ }
+
gfc_add_block_to_block (&block, &lse.post);
}
return gfc_finish_block (&block);
if (r_is_var)
{
cond = fold_build2 (EQ_EXPR, boolean_type_node,
- build_fold_addr_expr (lse->expr),
- build_fold_addr_expr (rse->expr));
+ gfc_build_addr_expr (NULL_TREE, lse->expr),
+ gfc_build_addr_expr (NULL_TREE, rse->expr));
cond = gfc_evaluate_now (cond, &lse->pre);
}
gfc_add_block_to_block (&block, &rse->pre);
gfc_add_block_to_block (&block, &lse->pre);
- gfc_add_modify_expr (&block, lse->expr,
+ gfc_add_modify (&block, lse->expr,
fold_convert (TREE_TYPE (lse->expr), rse->expr));
/* Do a deep copy if the rhs is a variable, if it is not the
gfc_add_block_to_block (&block, &lse->pre);
gfc_add_block_to_block (&block, &rse->pre);
- gfc_add_modify_expr (&block, lse->expr,
+ gfc_add_modify (&block, lse->expr,
fold_convert (TREE_TYPE (lse->expr), rse->expr));
}
gfc_ss *ss;
gfc_ref * ref;
bool seen_array_ref;
+ gfc_component *comp = NULL;
/* The caller has already checked rank>0 and expr_type == EXPR_FUNCTION. */
if (expr2->value.function.isym && !gfc_is_intrinsic_libcall (expr2))
/* Check for a dependency. */
if (gfc_check_fncall_dependency (expr1, INTENT_OUT,
expr2->value.function.esym,
- expr2->value.function.actual))
+ expr2->value.function.actual,
+ NOT_ELEMENTAL))
return NULL;
/* The frontend doesn't seem to bother filling in expr->symtree for intrinsic
functions. */
+ is_proc_ptr_comp(expr2, &comp);
gcc_assert (expr2->value.function.isym
- || (gfc_return_by_reference (expr2->value.function.esym)
+ || (comp && comp->attr.dimension)
+ || (!comp && gfc_return_by_reference (expr2->value.function.esym)
&& expr2->value.function.esym->result->attr.dimension));
ss = gfc_walk_expr (expr1);
gfc_start_block (&se.pre);
se.want_pointer = 1;
- gfc_conv_array_parameter (&se, expr1, ss, 0);
+ gfc_conv_array_parameter (&se, expr1, ss, 0, NULL, NULL, NULL);
se.direct_byref = 1;
se.ss = gfc_walk_expr (expr2);
len = fold_build2 (MULT_EXPR, gfc_array_index_type, len,
fold_convert (gfc_array_index_type, tmp));
- /* Convert arguments to the correct types. */
+ /* If we are zeroing a local array avoid taking its address by emitting
+ a = {} instead. */
if (!POINTER_TYPE_P (TREE_TYPE (dest)))
- dest = gfc_build_addr_expr (pvoid_type_node, dest);
- else
- dest = fold_convert (pvoid_type_node, dest);
+ return build2 (MODIFY_EXPR, void_type_node,
+ dest, build_constructor (TREE_TYPE (dest), NULL));
+
+ /* Convert arguments to the correct types. */
+ dest = fold_convert (pvoid_type_node, dest);
len = fold_convert (size_type_node, len);
/* Construct call to __builtin_memset. */
/* Helper for gfc_trans_array_copy and gfc_trans_array_constructor_copy
that constructs the call to __builtin_memcpy. */
-static tree
+tree
gfc_build_memcpy_call (tree dst, tree src, tree len)
{
tree tmp;
stmtblock_t block;
stmtblock_t body;
bool l_is_temp;
+ bool scalar_to_array;
+ tree string_length;
/* Assignment of the form lhs = rhs. */
gfc_start_block (&block);
rss = NULL;
if (lss != gfc_ss_terminator)
{
+ /* Allow the scalarizer to workshare array assignments. */
+ if (ompws_flags & OMPWS_WORKSHARE_FLAG)
+ ompws_flags |= OMPWS_SCALARIZER_WS;
+
/* The assignment needs scalarization. */
lss_section = lss;
/* Translate the expression. */
gfc_conv_expr (&rse, expr2);
+ /* Stabilize a string length for temporaries. */
+ if (expr2->ts.type == BT_CHARACTER)
+ string_length = gfc_evaluate_now (rse.string_length, &rse.pre);
+ else
+ string_length = NULL_TREE;
+
if (l_is_temp)
{
gfc_conv_tmp_array_ref (&lse);
gfc_advance_se_ss_chain (&lse);
+ if (expr2->ts.type == BT_CHARACTER)
+ lse.string_length = string_length;
}
else
gfc_conv_expr (&lse, expr1);
+ /* Assignments of scalar derived types with allocatable components
+ to arrays must be done with a deep copy and the rhs temporary
+ must have its components deallocated afterwards. */
+ scalar_to_array = (expr2->ts.type == BT_DERIVED
+ && expr2->ts.derived->attr.alloc_comp
+ && expr2->expr_type != EXPR_VARIABLE
+ && !gfc_is_constant_expr (expr2)
+ && expr1->rank && !expr2->rank);
+ if (scalar_to_array)
+ {
+ tmp = gfc_deallocate_alloc_comp (expr2->ts.derived, rse.expr, 0);
+ gfc_add_expr_to_block (&loop.post, tmp);
+ }
+
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
l_is_temp || init_flag,
- expr2->expr_type == EXPR_VARIABLE);
+ (expr2->expr_type == EXPR_VARIABLE)
+ || scalar_to_array);
gfc_add_expr_to_block (&body, tmp);
if (lss == gfc_ss_terminator)
gcc_assert (lse.ss == gfc_ss_terminator
&& rse.ss == gfc_ss_terminator);
+ if (expr2->ts.type == BT_CHARACTER)
+ rse.string_length = string_length;
+
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts,
false, false);
gfc_add_expr_to_block (&body, tmp);
tree
gfc_trans_init_assign (gfc_code * code)
{
- return gfc_trans_assignment (code->expr, code->expr2, true);
+ return gfc_trans_assignment (code->expr1, code->expr2, true);
}
tree
gfc_trans_assign (gfc_code * code)
{
- return gfc_trans_assignment (code->expr, code->expr2, false);
+ return gfc_trans_assignment (code->expr1, code->expr2, false);
}
OSDN Git Service
