2007-07-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31205
PR fortran/32842
* trans-expr.c (gfc_conv_function_call): Remove the default
initialization of intent(out) derived types.
* symbol.c (gfc_lval_expr_from_sym): New function.
* matchexp.c (gfc_get_parentheses): Return argument, if it is
character and posseses a ref.
* gfortran.h : Add prototype for gfc_lval_expr_from_sym.
* resolve.c (has_default_initializer): Move higher up in file.
(resolve_code): On detecting an interface assignment, check
if the rhs and the lhs are the same symbol. If this is so,
enclose the rhs in parenetheses to generate a temporary and
prevent any possible aliasing.
(apply_default_init): Remove code making the lval and call
gfc_lval_expr_from_sym instead.
(resolve_operator): Give a parentheses expression a type-
spec if it has no type.
* trans-decl.c (gfc_trans_deferred_vars): Apply the a default
initializer, if any, to an intent(out) derived type, using
gfc_lval_expr_from_sym and gfc_trans_assignment. Check if
the dummy is present.
2007-07-24 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31205
* gfortran.dg/alloc_comp_basics_1.f90 : Restore number of
"deallocates" to 24, since patch has code rid of much spurious
code.
* gfortran.dg/interface_assignment_1.f90 : New test.
PR fortran/32842
* gfortran.dg/interface_assignment_2.f90 : New test.
From-SVN: r126885
+2007-07-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/31205
+ PR fortran/32842
+ * trans-expr.c (gfc_conv_function_call): Remove the default
+ initialization of intent(out) derived types.
+ * symbol.c (gfc_lval_expr_from_sym): New function.
+ * matchexp.c (gfc_get_parentheses): Return argument, if it is
+ character and posseses a ref.
+ * gfortran.h : Add prototype for gfc_lval_expr_from_sym.
+ * resolve.c (has_default_initializer): Move higher up in file.
+ (resolve_code): On detecting an interface assignment, check
+ if the rhs and the lhs are the same symbol. If this is so,
+ enclose the rhs in parenetheses to generate a temporary and
+ prevent any possible aliasing.
+ (apply_default_init): Remove code making the lval and call
+ gfc_lval_expr_from_sym instead.
+ (resolve_operator): Give a parentheses expression a type-
+ spec if it has no type.
+ * trans-decl.c (gfc_trans_deferred_vars): Apply the a default
+ initializer, if any, to an intent(out) derived type, using
+ gfc_lval_expr_from_sym and gfc_trans_assignment. Check if
+ the dummy is present.
+
2007-07-24 Daniel Franke <franke.daniel@gmail.com>
PR fortran/32867
void gfc_define_st_label (gfc_st_label *, gfc_sl_type, locus *);
try gfc_reference_st_label (gfc_st_label *, gfc_sl_type);
+gfc_expr * gfc_lval_expr_from_sym (gfc_symbol *);
+
gfc_namespace *gfc_get_namespace (gfc_namespace *, int);
gfc_symtree *gfc_new_symtree (gfc_symtree **, const char *);
gfc_symtree *gfc_find_symtree (gfc_symtree *, const char *);
{
gfc_expr *e2;
+ /* This is a temporary fix, awaiting the patch for various
+ other character problems. The resolution and translation
+ of substrings and concatenations are so kludged up that
+ putting parentheses around them breaks everything. */
+ if (e->ts.type == BT_CHARACTER && e->ref)
+ return e;
+
e2 = gfc_get_expr();
e2->expr_type = EXPR_OP;
e2->ts = e->ts;
gfc_error ("Expected a right parenthesis in expression at %C");
/* Now we have the expression inside the parentheses, build the
- expression pointing to it. By 7.1.7.2 the integrity of
- parentheses is only conserved in numerical calculations, so we
- don't bother to keep the parentheses otherwise. */
- if(!gfc_numeric_ts(&e->ts))
- *result = e;
- else
- *result = gfc_get_parentheses (e);
+ expression pointing to it. By 7.1.7.2, any expression in
+ parentheses shall be treated as a data entity. */
+ *result = gfc_get_parentheses (e);
if (m != MATCH_YES)
{
break;
+ case INTRINSIC_PARENTHESES:
+
+ /* This is always correct and sometimes necessary! */
+ if (e->ts.type == BT_UNKNOWN)
+ e->ts = op1->ts;
+
+ if (e->ts.type == BT_CHARACTER && !e->ts.cl)
+ e->ts.cl = op1->ts.cl;
+
case INTRINSIC_NOT:
case INTRINSIC_UPLUS:
case INTRINSIC_UMINUS:
- case INTRINSIC_PARENTHESES:
+ /* Simply copy arrayness attribute */
e->rank = op1->rank;
if (e->shape == NULL)
e->shape = gfc_copy_shape (op1->shape, op1->rank);
- /* Simply copy arrayness attribute */
break;
default:
}
+static gfc_component *
+has_default_initializer (gfc_symbol *der)
+{
+ gfc_component *c;
+ for (c = der->components; c; c = c->next)
+ if ((c->ts.type != BT_DERIVED && c->initializer)
+ || (c->ts.type == BT_DERIVED
+ && !c->pointer
+ && has_default_initializer (c->ts.derived)))
+ break;
+
+ return c;
+}
+
+
/* Given a block of code, recursively resolve everything pointed to by this
code block. */
if (gfc_extend_assign (code, ns) == SUCCESS)
{
+ gfc_expr *lhs = code->ext.actual->expr;
+ gfc_expr *rhs = code->ext.actual->next->expr;
+
if (gfc_pure (NULL) && !gfc_pure (code->symtree->n.sym))
{
gfc_error ("Subroutine '%s' called instead of assignment at "
&code->loc);
break;
}
+
+ /* Make a temporary rhs when there is a default initializer
+ and rhs is the same symbol as the lhs. */
+ if (rhs->expr_type == EXPR_VARIABLE
+ && rhs->symtree->n.sym->ts.type == BT_DERIVED
+ && has_default_initializer (rhs->symtree->n.sym->ts.derived)
+ && (lhs->symtree->n.sym == rhs->symtree->n.sym))
+ code->ext.actual->next->expr = gfc_get_parentheses (rhs);
+
goto call;
}
}
/* Build an l-value expression for the result. */
- lval = gfc_get_expr ();
- lval->expr_type = EXPR_VARIABLE;
- lval->where = sym->declared_at;
- lval->ts = sym->ts;
- lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
-
- /* It will always be a full array. */
- lval->rank = sym->as ? sym->as->rank : 0;
- if (lval->rank)
- {
- lval->ref = gfc_get_ref ();
- lval->ref->type = REF_ARRAY;
- lval->ref->u.ar.type = AR_FULL;
- lval->ref->u.ar.dimen = lval->rank;
- lval->ref->u.ar.where = sym->declared_at;
- lval->ref->u.ar.as = sym->as;
- }
+ lval = gfc_lval_expr_from_sym (sym);
/* Add the code at scope entry. */
init_st = gfc_get_code ();
}
-static gfc_component *
-has_default_initializer (gfc_symbol *der)
-{
- gfc_component *c;
- for (c = der->components; c; c = c->next)
- if ((c->ts.type != BT_DERIVED && c->initializer)
- || (c->ts.type == BT_DERIVED
- && !c->pointer
- && has_default_initializer (c->ts.derived)))
- break;
-
- return c;
-}
-
-
/* Resolve symbols with flavor variable. */
static try
}
+/*******A helper function for creating new expressions*************/
+
+
+gfc_expr *
+gfc_lval_expr_from_sym (gfc_symbol *sym)
+{
+ gfc_expr *lval;
+ lval = gfc_get_expr ();
+ lval->expr_type = EXPR_VARIABLE;
+ lval->where = sym->declared_at;
+ lval->ts = sym->ts;
+ lval->symtree = gfc_find_symtree (sym->ns->sym_root, sym->name);
+
+ /* It will always be a full array. */
+ lval->rank = sym->as ? sym->as->rank : 0;
+ if (lval->rank)
+ {
+ lval->ref = gfc_get_ref ();
+ lval->ref->type = REF_ARRAY;
+ lval->ref->u.ar.type = AR_FULL;
+ lval->ref->u.ar.dimen = lval->rank;
+ lval->ref->u.ar.where = sym->declared_at;
+ lval->ref->u.ar.as = sym->as;
+ }
+
+ return lval;
+}
+
+
/************** Symbol table management subroutines ****************/
/* Basic details: Fortran 95 requires a potentially unlimited number
gfc_init_block (&body);
for (f = proc_sym->formal; f; f = f->next)
- if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
- {
- gcc_assert (f->sym->ts.cl->backend_decl != NULL);
- if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
- gfc_trans_vla_type_sizes (f->sym, &body);
- }
+ {
+ if (f->sym && f->sym->tlink == NULL && f->sym->ts.type == BT_CHARACTER)
+ {
+ gcc_assert (f->sym->ts.cl->backend_decl != NULL);
+ if (TREE_CODE (f->sym->ts.cl->backend_decl) == PARM_DECL)
+ gfc_trans_vla_type_sizes (f->sym, &body);
+ }
+
+ /* If an INTENT(OUT) dummy of derived type has a default
+ initializer, it must be initialized here. */
+ if (f->sym && f->sym->attr.referenced
+ && f->sym->attr.intent == INTENT_OUT
+ && f->sym->ts.type == BT_DERIVED
+ && !f->sym->ts.derived->attr.alloc_comp
+ && f->sym->value)
+ {
+ gfc_expr *tmpe;
+ tree tmp, present;
+ gcc_assert (!f->sym->attr.allocatable);
+ tmpe = gfc_lval_expr_from_sym (f->sym);
+ tmp = gfc_trans_assignment (tmpe, f->sym->value, false);
+
+ present = gfc_conv_expr_present (f->sym);
+ tmp = build3 (COND_EXPR, TREE_TYPE (tmp), present,
+ tmp, build_empty_stmt ());
+ gfc_add_expr_to_block (&body, tmp);
+ gfc_free_expr (tmpe);
+ }
+ }
if (gfc_return_by_reference (proc_sym) && proc_sym->ts.type == BT_CHARACTER
&& current_fake_result_decl != NULL)
&& fsym->attr.optional)
gfc_conv_missing_dummy (&parmse, e, fsym->ts);
- /* If an INTENT(OUT) dummy of derived type has a default
- initializer, it must be (re)initialized here. */
- if (fsym->attr.intent == INTENT_OUT
- && fsym->ts.type == BT_DERIVED
- && fsym->value)
- {
- gcc_assert (!fsym->attr.allocatable);
- tmp = gfc_trans_assignment (e, fsym->value, false);
- gfc_add_expr_to_block (&se->pre, tmp);
- }
-
/* Obtain the character length of an assumed character
length procedure from the typespec. */
if (fsym->ts.type == BT_CHARACTER
+2007-07-24 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/31205
+ * gfortran.dg/alloc_comp_basics_1.f90 : Restore number of
+ "deallocates" to 24, since patch has code rid of much spurious
+ code.
+ * gfortran.dg/interface_assignment_1.f90 : New test.
+
+ PR fortran/32842
+ * gfortran.dg/interface_assignment_2.f90 : New test.
+
2007-07-24 Daniel Franke <franke.daniel@gmail.com>
PR fortran/32867
end subroutine check_alloc2
end program alloc
-! { dg-final { scan-tree-dump-times "deallocate" 33 "original" } }
+! { dg-final { scan-tree-dump-times "deallocate" 24 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-final { cleanup-modules "alloc_m" } }
projects / platform / upstream / gcc.git / commitdiff