/* Expression translation
- Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
and Steven Bosscher <s.bosscher@student.tudelft.nl>
#include "coretypes.h"
#include "tree.h"
#include "convert.h"
-#include <stdio.h>
#include "ggc.h"
#include "toplev.h"
#include "real.h"
#include "tree-gimple.h"
#include "flags.h"
-#include <gmp.h>
-#include <assert.h>
#include "gfortran.h"
#include "trans.h"
#include "trans-const.h"
{
gfc_se *p;
- assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
+ gcc_assert (se != NULL && se->ss != NULL && se->ss != gfc_ss_terminator);
p = se;
/* Walk down the parent chain. */
while (p != NULL)
{
/* Simple consistency check. */
- assert (p->parent == NULL || p->parent->ss == p->ss);
+ gcc_assert (p->parent == NULL || p->parent->ss == p->ss);
p->ss = p->ss->next;
{
tree var;
- if (TREE_CODE_CLASS (TREE_CODE (se->expr)) == 'c')
+ if (CONSTANT_CLASS_P (se->expr))
return;
/* We need a temporary for this result. */
}
-/* Return an expression which determines if a dummy parameter is present. */
+/* Return an expression which determines if a dummy parameter is present.
+ Also used for arguments to procedures with multiple entry points. */
tree
gfc_conv_expr_present (gfc_symbol * sym)
{
tree decl;
- assert (sym->attr.dummy && sym->attr.optional);
+ gcc_assert (sym->attr.dummy);
decl = gfc_get_symbol_decl (sym);
if (TREE_CODE (decl) != PARM_DECL)
{
/* Array parameters use a temporary descriptor, we want the real
parameter. */
- assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))
|| GFC_ARRAY_TYPE_P (TREE_TYPE (decl)));
decl = GFC_DECL_SAVED_DESCRIPTOR (decl);
}
}
+/* Get the character length of an expression, looking through gfc_refs
+ if necessary. */
+
+tree
+gfc_get_expr_charlen (gfc_expr *e)
+{
+ gfc_ref *r;
+ tree length;
+
+ gcc_assert (e->expr_type == EXPR_VARIABLE
+ && e->ts.type == BT_CHARACTER);
+
+ length = NULL; /* To silence compiler warning. */
+
+ /* First candidate: if the variable is of type CHARACTER, the
+ expression's length could be the length of the character
+ variable. */
+ if (e->symtree->n.sym->ts.type == BT_CHARACTER)
+ length = e->symtree->n.sym->ts.cl->backend_decl;
+
+ /* Look through the reference chain for component references. */
+ for (r = e->ref; r; r = r->next)
+ {
+ switch (r->type)
+ {
+ case REF_COMPONENT:
+ if (r->u.c.component->ts.type == BT_CHARACTER)
+ length = r->u.c.component->ts.cl->backend_decl;
+ break;
+
+ case REF_ARRAY:
+ /* Do nothing. */
+ break;
+
+ default:
+ /* We should never got substring references here. These will be
+ broken down by the scalarizer. */
+ gcc_unreachable ();
+ }
+ }
+
+ gcc_assert (length != NULL);
+ return length;
+}
+
+
+
/* Generate code to initialize a string length variable. Returns the
value. */
tree tmp;
gfc_init_se (&se, NULL);
- gfc_conv_expr_type (&se, cl->length, gfc_strlen_type_node);
+ gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
gfc_add_block_to_block (pblock, &se.pre);
tmp = cl->backend_decl;
var = NULL_TREE;
gfc_init_se (&start, se);
- gfc_conv_expr_type (&start, ref->u.ss.start, gfc_strlen_type_node);
+ gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
gfc_add_block_to_block (&se->pre, &start.pre);
if (integer_onep (start.expr))
end.expr = se->string_length;
else
{
- gfc_conv_expr_type (&end, ref->u.ss.end, gfc_strlen_type_node);
+ gfc_conv_expr_type (&end, ref->u.ss.end, gfc_charlen_type_node);
gfc_add_block_to_block (&se->pre, &end.pre);
}
tmp =
- build2 (MINUS_EXPR, gfc_strlen_type_node,
- fold_convert (gfc_strlen_type_node, integer_one_node),
+ build2 (MINUS_EXPR, gfc_charlen_type_node,
+ fold_convert (gfc_charlen_type_node, integer_one_node),
start.expr);
- tmp = build2 (PLUS_EXPR, gfc_strlen_type_node, end.expr, tmp);
+ tmp = build2 (PLUS_EXPR, gfc_charlen_type_node, end.expr, tmp);
se->string_length = fold (tmp);
}
c = ref->u.c.component;
- assert (c->backend_decl);
+ gcc_assert (c->backend_decl);
field = c->backend_decl;
- assert (TREE_CODE (field) == FIELD_DECL);
+ gcc_assert (TREE_CODE (field) == FIELD_DECL);
decl = se->expr;
tmp = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field, NULL_TREE);
{
tmp = c->ts.cl->backend_decl;
/* Components must always be constant length. */
- assert (tmp && INTEGER_CST_P (tmp));
+ gcc_assert (tmp && INTEGER_CST_P (tmp));
se->string_length = tmp;
}
if (se->ss != NULL)
{
/* Check that something hasn't gone horribly wrong. */
- assert (se->ss != gfc_ss_terminator);
- assert (se->ss->expr == expr);
+ gcc_assert (se->ss != gfc_ss_terminator);
+ gcc_assert (se->ss->expr == expr);
/* A scalarized term. We already know the descriptor. */
se->expr = se->ss->data.info.descriptor;
}
else
{
+ tree se_expr = NULL_TREE;
+
se->expr = gfc_get_symbol_decl (sym);
+ /* Special case for assigning the return value of a function.
+ Self recursive functions must have an explicit return value. */
+ if (se->expr == current_function_decl && sym->attr.function
+ && (sym->result == sym))
+ se_expr = gfc_get_fake_result_decl (sym);
+
+ /* Similarly for alternate entry points. */
+ else if (sym->attr.function && sym->attr.entry
+ && (sym->result == sym)
+ && sym->ns->proc_name->backend_decl == current_function_decl)
+ {
+ gfc_entry_list *el = NULL;
+
+ for (el = sym->ns->entries; el; el = el->next)
+ if (sym == el->sym)
+ {
+ se_expr = gfc_get_fake_result_decl (sym);
+ break;
+ }
+ }
+
+ else if (sym->attr.result
+ && sym->ns->proc_name->backend_decl == current_function_decl
+ && sym->ns->proc_name->attr.entry_master
+ && !gfc_return_by_reference (sym->ns->proc_name))
+ se_expr = gfc_get_fake_result_decl (sym);
+
+ if (se_expr)
+ se->expr = se_expr;
+
/* Procedure actual arguments. */
- if (sym->attr.flavor == FL_PROCEDURE
- && se->expr != current_function_decl)
+ else if (sym->attr.flavor == FL_PROCEDURE
+ && se->expr != current_function_decl)
{
- assert (se->want_pointer);
+ gcc_assert (se->want_pointer);
if (!sym->attr.dummy)
{
- assert (TREE_CODE (se->expr) == FUNCTION_DECL);
+ gcc_assert (TREE_CODE (se->expr) == FUNCTION_DECL);
se->expr = gfc_build_addr_expr (NULL, se->expr);
}
return;
}
- /* Special case for assigning the return value of a function.
- Self recursive functions must have an explicit return value. */
- if (se->expr == current_function_decl && sym->attr.function
- && (sym->result == sym))
- {
- se->expr = gfc_get_fake_result_decl (sym);
- }
-
/* Dereference scalar dummy variables. */
if (sym->attr.dummy
&& sym->ts.type != BT_CHARACTER
&& !sym->attr.dimension)
se->expr = gfc_build_indirect_ref (se->expr);
+ /* Dereference scalar hidden result. */
+ if (gfc_option.flag_f2c
+ && (sym->attr.function || sym->attr.result)
+ && sym->ts.type == BT_COMPLEX
+ && !sym->attr.dimension)
+ se->expr = gfc_build_indirect_ref (se->expr);
+
/* Dereference pointer variables. */
if ((sym->attr.pointer || sym->attr.allocatable)
&& (sym->attr.dummy
if (sym->ts.type == BT_CHARACTER)
{
se->string_length = sym->ts.cl->backend_decl;
- assert (se->string_length);
+ gcc_assert (se->string_length);
}
while (ref)
break;
default:
- abort ();
+ gcc_unreachable ();
break;
}
ref = ref->next;
gfc_se operand;
tree type;
- assert (expr->ts.type != BT_CHARACTER);
+ gcc_assert (expr->ts.type != BT_CHARACTER);
/* Initialize the operand. */
gfc_init_se (&operand, se);
- gfc_conv_expr_val (&operand, expr->op1);
+ gfc_conv_expr_val (&operand, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &operand.pre);
type = gfc_typenode_for_spec (&expr->ts);
op1 = op0;
}
- tmp = fold (build2 (MULT_EXPR, TREE_TYPE (op0), op0, op1));
+ tmp = fold_build2 (MULT_EXPR, TREE_TYPE (op0), op0, op1);
tmp = gfc_evaluate_now (tmp, &se->pre);
if (n < POWI_TABLE_SIZE)
n = abs (TREE_INT_CST_LOW (rhs));
sgn = tree_int_cst_sgn (rhs);
- if ((!flag_unsafe_math_optimizations || optimize_size) && (n > 2 || n < -1))
+ if (((FLOAT_TYPE_P (type) && !flag_unsafe_math_optimizations) || optimize_size)
+ && (n > 2 || n < -1))
return 0;
/* rhs == 0 */
static void
gfc_conv_power_op (gfc_se * se, gfc_expr * expr)
{
+ tree gfc_int4_type_node;
int kind;
int ikind;
gfc_se lse;
tree tmp;
gfc_init_se (&lse, se);
- gfc_conv_expr_val (&lse, expr->op1);
+ gfc_conv_expr_val (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
gfc_init_se (&rse, se);
- gfc_conv_expr_val (&rse, expr->op2);
+ gfc_conv_expr_val (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
- if (expr->op2->ts.type == BT_INTEGER
- && expr->op2->expr_type == EXPR_CONSTANT)
+ if (expr->value.op.op2->ts.type == BT_INTEGER
+ && expr->value.op.op2->expr_type == EXPR_CONSTANT)
if (gfc_conv_cst_int_power (se, lse.expr, rse.expr))
return;
- kind = expr->op1->ts.kind;
- switch (expr->op2->ts.type)
+ gfc_int4_type_node = gfc_get_int_type (4);
+
+ kind = expr->value.op.op1->ts.kind;
+ switch (expr->value.op.op2->ts.type)
{
case BT_INTEGER:
- ikind = expr->op2->ts.kind;
+ ikind = expr->value.op.op2->ts.kind;
switch (ikind)
{
case 1:
break;
default:
- abort();
+ gcc_unreachable ();
}
switch (kind)
{
case 1:
case 2:
- if (expr->op1->ts.type == BT_INTEGER)
+ if (expr->value.op.op1->ts.type == BT_INTEGER)
lse.expr = convert (gfc_int4_type_node, lse.expr);
else
- abort ();
+ gcc_unreachable ();
/* Fall through. */
case 4:
break;
default:
- abort();
+ gcc_unreachable ();
}
- switch (expr->op1->ts.type)
+ switch (expr->value.op.op1->ts.type)
{
case BT_INTEGER:
fndecl = gfor_fndecl_math_powi[kind][ikind].integer;
break;
default:
- abort ();
+ gcc_unreachable ();
}
break;
fndecl = built_in_decls[BUILT_IN_POW];
break;
default:
- abort ();
+ gcc_unreachable ();
}
break;
fndecl = gfor_fndecl_math_cpow;
break;
default:
- abort ();
+ gcc_unreachable ();
}
break;
default:
- abort ();
+ gcc_unreachable ();
break;
}
tree tmp;
tree args;
- if (TREE_TYPE (len) != gfc_strlen_type_node)
- abort ();
+ gcc_assert (TREE_TYPE (len) == gfc_charlen_type_node);
if (gfc_can_put_var_on_stack (len))
{
/* Create a temporary variable to hold the result. */
- tmp = fold (build2 (MINUS_EXPR, gfc_strlen_type_node, len,
- convert (gfc_strlen_type_node,
- integer_one_node)));
+ tmp = fold_build2 (MINUS_EXPR, gfc_charlen_type_node, len,
+ convert (gfc_charlen_type_node, integer_one_node));
tmp = build_range_type (gfc_array_index_type, gfc_index_zero_node, tmp);
tmp = build_array_type (gfc_character1_type_node, tmp);
var = gfc_create_var (tmp, "str");
tree args;
tree tmp;
- assert (expr->op1->ts.type == BT_CHARACTER
- && expr->op2->ts.type == BT_CHARACTER);
+ gcc_assert (expr->value.op.op1->ts.type == BT_CHARACTER
+ && expr->value.op.op2->ts.type == BT_CHARACTER);
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_conv_string_parameter (&lse);
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_conv_string_parameter (&rse);
gfc_add_block_to_block (&se->pre, &lse.pre);
len = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
if (len == NULL_TREE)
{
- len = fold (build2 (PLUS_EXPR, TREE_TYPE (lse.string_length),
- lse.string_length, rse.string_length));
+ len = fold_build2 (PLUS_EXPR, TREE_TYPE (lse.string_length),
+ lse.string_length, rse.string_length);
}
type = build_pointer_type (type);
checkstring = 0;
lop = 0;
- switch (expr->operator)
+ switch (expr->value.op.operator)
{
case INTRINSIC_UPLUS:
- gfc_conv_expr (se, expr->op1);
+ gfc_conv_expr (se, expr->value.op.op1);
return;
case INTRINSIC_UMINUS:
case INTRINSIC_USER:
case INTRINSIC_ASSIGN:
/* These should be converted into function calls by the frontend. */
- abort ();
- return;
+ gcc_unreachable ();
default:
fatal_error ("Unknown intrinsic op");
}
/* The only exception to this is **, which is handled separately anyway. */
- assert (expr->op1->ts.type == expr->op2->ts.type);
+ gcc_assert (expr->value.op.op1->ts.type == expr->value.op.op2->ts.type);
- if (checkstring && expr->op1->ts.type != BT_CHARACTER)
+ if (checkstring && expr->value.op.op1->ts.type != BT_CHARACTER)
checkstring = 0;
/* lhs */
gfc_init_se (&lse, se);
- gfc_conv_expr (&lse, expr->op1);
+ gfc_conv_expr (&lse, expr->value.op.op1);
gfc_add_block_to_block (&se->pre, &lse.pre);
/* rhs */
gfc_init_se (&rse, se);
- gfc_conv_expr (&rse, expr->op2);
+ gfc_conv_expr (&rse, expr->value.op.op2);
gfc_add_block_to_block (&se->pre, &rse.pre);
/* For string comparisons we generate a library call, and compare the return
if (lop)
{
/* The result of logical ops is always boolean_type_node. */
- tmp = fold (build2 (code, type, lse.expr, rse.expr));
+ tmp = fold_build2 (code, type, lse.expr, rse.expr);
se->expr = convert (type, tmp);
}
else
- se->expr = fold (build2 (code, type, lse.expr, rse.expr));
+ se->expr = fold_build2 (code, type, lse.expr, rse.expr);
/* Add the post blocks. */
gfc_add_block_to_block (&se->post, &rse.post);
if (sym->attr.dummy)
{
tmp = gfc_get_symbol_decl (sym);
- assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
+ gcc_assert (TREE_CODE (TREE_TYPE (tmp)) == POINTER_TYPE
&& TREE_CODE (TREE_TYPE (TREE_TYPE (tmp))) == FUNCTION_TYPE);
se->expr = tmp;
sym->backend_decl = gfc_get_extern_function_decl (sym);
tmp = sym->backend_decl;
- assert (TREE_CODE (tmp) == FUNCTION_DECL);
+ gcc_assert (TREE_CODE (tmp) == FUNCTION_DECL);
se->expr = gfc_build_addr_expr (NULL, tmp);
}
}
{
if (!sym->attr.elemental)
{
- assert (se->ss->type == GFC_SS_FUNCTION);
+ gcc_assert (se->ss->type == GFC_SS_FUNCTION);
if (se->ss->useflags)
{
- assert (gfc_return_by_reference (sym)
+ gcc_assert (gfc_return_by_reference (sym)
&& sym->result->attr.dimension);
- assert (se->loop != NULL);
+ gcc_assert (se->loop != NULL);
/* Access the previously obtained result. */
gfc_conv_tmp_array_ref (se);
arglist = gfc_chainon_list (arglist, se->expr);
else if (sym->result->attr.dimension)
{
- assert (se->loop && se->ss);
+ gcc_assert (se->loop && se->ss);
/* Set the type of the array. */
tmp = gfc_typenode_for_spec (&sym->ts);
info->dimen = se->loop->dimen;
}
else if (sym->ts.type == BT_CHARACTER)
{
- assert (sym->ts.cl && sym->ts.cl->length
+ gcc_assert (sym->ts.cl && sym->ts.cl->length
&& sym->ts.cl->length->expr_type == EXPR_CONSTANT);
len = gfc_conv_mpz_to_tree
(sym->ts.cl->length->value.integer, sym->ts.cl->length->ts.kind);
var = gfc_conv_string_tmp (se, type, len);
arglist = gfc_chainon_list (arglist, var);
- arglist = gfc_chainon_list (arglist, convert (gfc_strlen_type_node,
- len));
+ arglist = gfc_chainon_list (arglist,
+ convert (gfc_charlen_type_node, len));
+ }
+ else
+ {
+ gcc_assert (gfc_option.flag_f2c && sym->ts.type == BT_COMPLEX);
+
+ type = gfc_get_complex_type (sym->ts.kind);
+ var = gfc_build_addr_expr (NULL, gfc_create_var (type, "cmplx"));
+ arglist = gfc_chainon_list (arglist, var);
}
- else /* TODO: derived type function return values. */
- abort ();
}
formal = sym->formal;
{
stringargs =
gfc_chainon_list (stringargs,
- convert (gfc_strlen_type_node,
+ convert (gfc_charlen_type_node,
integer_zero_node));
}
}
actual argument is passed according to the
corresponding formal argument. If the corresponding
formal argument is a POINTER or assumed shape, we do
- not use g77's calling aonvention, and pass the
+ not use g77's calling convention, and pass the
address of the array descriptor instead. Otherwise we
use g77's calling convention. */
int f;
gfc_add_block_to_block (&se->pre, &parmse.pre);
gfc_add_block_to_block (&se->post, &parmse.post);
- /* Character strings are passed as two paramarers, a length and a
+ /* Character strings are passed as two parameters, a length and a
pointer. */
if (parmse.string_length != NULL_TREE)
stringargs = gfc_chainon_list (stringargs, parmse.string_length);
se->expr = build3 (CALL_EXPR, TREE_TYPE (fntype), se->expr,
arglist, NULL_TREE);
+ if (sym->result)
+ sym = sym->result;
+
+ /* If we have a pointer function, but we don't want a pointer, e.g.
+ something like
+ x = f()
+ where f is pointer valued, we have to dereference the result. */
+ if (!se->want_pointer && !byref && sym->attr.pointer)
+ se->expr = gfc_build_indirect_ref (se->expr);
+
+ /* f2c calling conventions require a scalar default real function to
+ return a double precision result. Convert this back to default
+ real. We only care about the cases that can happen in Fortran 77.
+ */
+ if (gfc_option.flag_f2c && sym->ts.type == BT_REAL
+ && sym->ts.kind == gfc_default_real_kind
+ && !sym->attr.always_explicit)
+ se->expr = fold_convert (gfc_get_real_type (sym->ts.kind), se->expr);
+
/* A pure function may still have side-effects - it may modify its
parameters. */
TREE_SIDE_EFFECTS (se->expr) = 1;
se->string_length = len;
}
else
- abort ();
+ {
+ gcc_assert (sym->ts.type == BT_COMPLEX && gfc_option.flag_f2c);
+ se->expr = gfc_build_indirect_ref (var);
+ }
}
}
}
{
/* Each dummy shall be specified, explicitly or implicitly, to be
scalar. */
- assert (fargs->sym->attr.dimension == 0);
+ gcc_assert (fargs->sym->attr.dimension == 0);
fsym = fargs->sym;
/* Create a temporary to hold the value. */
/* Copy string arguments. */
tree arglen;
- assert (fsym->ts.cl && fsym->ts.cl->length
+ gcc_assert (fsym->ts.cl && fsym->ts.cl->length
&& fsym->ts.cl->length->expr_type == EXPR_CONSTANT);
arglen = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
static void
gfc_conv_array_constructor_expr (gfc_se * se, gfc_expr * expr)
{
- assert (se->ss != NULL && se->ss != gfc_ss_terminator);
- assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR);
+ gcc_assert (se->ss != NULL && se->ss != gfc_ss_terminator);
+ gcc_assert (se->ss->expr == expr && se->ss->type == GFC_SS_CONSTRUCTOR);
gfc_conv_tmp_array_ref (se);
gfc_advance_se_ss_chain (se);
tmp = gfc_trans_scalar_assign (&lse, &rse, cm->ts.type);
gfc_add_expr_to_block (&body, tmp);
- if (rse.ss != gfc_ss_terminator)
- abort ();
+ gcc_assert (rse.ss == gfc_ss_terminator);
/* Generate the copying loops. */
gfc_trans_scalarizing_loops (&loop, &body);
gfc_add_block_to_block (&block, &loop.pre);
gfc_add_block_to_block (&block, &loop.post);
- gfc_cleanup_loop (&loop);
-
for (n = 0; n < cm->as->rank; n++)
mpz_clear (lss->shape[n]);
gfc_free (lss->shape);
+ gfc_cleanup_loop (&loop);
+
return gfc_finish_block (&block);
}
}
else if (expr->ts.type == BT_DERIVED)
{
- /* Nested dervived type. */
+ /* Nested derived type. */
tmp = gfc_trans_structure_assign (dest, expr);
gfc_add_expr_to_block (&block, tmp);
}
return gfc_finish_block (&block);
}
-/* Assign a derived type contructor to a variable. */
+/* Assign a derived type constructor to a variable. */
static tree
gfc_trans_structure_assign (tree dest, gfc_expr * expr)
tree type;
tree tmp;
- assert (se->ss == NULL);
- assert (expr->expr_type == EXPR_STRUCTURE);
+ gcc_assert (se->ss == NULL);
+ gcc_assert (expr->expr_type == EXPR_STRUCTURE);
type = gfc_typenode_for_spec (&expr->ts);
if (!init)
ref = expr->ref;
- assert(ref->type == REF_SUBSTRING);
+ gcc_assert (ref->type == REF_SUBSTRING);
se->expr = gfc_build_string_const(expr->value.character.length,
expr->value.character.string);
break;
default:
- abort ();
+ gcc_unreachable ();
break;
}
}
gfc_conv_expr (se, expr);
/* AFAICS all numeric lvalues have empty post chains. If not we need to
figure out a way of rewriting an lvalue so that it has no post chain. */
- assert (expr->ts.type != BT_CHARACTER || !se->post.head);
+ gcc_assert (expr->ts.type != BT_CHARACTER || !se->post.head);
}
void
{
tree val;
- assert (expr->ts.type != BT_CHARACTER);
+ gcc_assert (expr->ts.type != BT_CHARACTER);
gfc_conv_expr (se, expr);
if (se->post.head)
{
/* Scalar pointers. */
lse.want_pointer = 1;
gfc_conv_expr (&lse, expr1);
- assert (rss == gfc_ss_terminator);
+ gcc_assert (rss == gfc_ss_terminator);
gfc_init_se (&rse, NULL);
rse.want_pointer = 1;
gfc_conv_expr (&rse, expr2);
type = TREE_TYPE (se->expr);
if (TYPE_STRING_FLAG (type))
{
- assert (TREE_CODE (se->expr) != INDIRECT_REF);
+ gcc_assert (TREE_CODE (se->expr) != INDIRECT_REF);
se->expr = gfc_build_addr_expr (pchar_type_node, se->expr);
}
- assert (POINTER_TYPE_P (TREE_TYPE (se->expr)));
- assert (se->string_length
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (se->expr)));
+ gcc_assert (se->string_length
&& TREE_CODE (TREE_TYPE (se->string_length)) == INTEGER_TYPE);
}
if (type == BT_CHARACTER)
{
- assert (lse->string_length != NULL_TREE
+ gcc_assert (lse->string_length != NULL_TREE
&& rse->string_length != NULL_TREE);
gfc_conv_string_parameter (lse);
/* The frontend doesn't seem to bother filling in expr->symtree for intrinsic
functions. */
- assert (expr2->value.function.isym
- || (gfc_return_by_reference (expr2->symtree->n.sym)
- && expr2->symtree->n.sym->result->attr.dimension));
+ gcc_assert (expr2->value.function.isym
+ || (gfc_return_by_reference (expr2->value.function.esym)
+ && expr2->value.function.esym->result->attr.dimension));
ss = gfc_walk_expr (expr1);
- assert (ss != gfc_ss_terminator);
+ gcc_assert (ss != gfc_ss_terminator);
gfc_init_se (&se, NULL);
gfc_start_block (&se.pre);
se.want_pointer = 1;
se.direct_byref = 1;
se.ss = gfc_walk_expr (expr2);
- assert (se.ss != gfc_ss_terminator);
+ gcc_assert (se.ss != gfc_ss_terminator);
gfc_conv_function_expr (&se, expr2);
gfc_add_block_to_block (&se.pre, &se.post);
&& lss_section->type != GFC_SS_SECTION)
lss_section = lss_section->next;
- assert (lss_section != gfc_ss_terminator);
+ gcc_assert (lss_section != gfc_ss_terminator);
/* Initialize the scalarizer. */
gfc_init_loopinfo (&loop);
}
else
{
- if (lse.ss != gfc_ss_terminator)
- abort ();
- if (rse.ss != gfc_ss_terminator)
- abort ();
+ gcc_assert (lse.ss == gfc_ss_terminator
+ && rse.ss == gfc_ss_terminator);
if (loop.temp_ss != NULL)
{
gfc_advance_se_ss_chain (&rse);
gfc_conv_expr (&lse, expr1);
- if (lse.ss != gfc_ss_terminator)
- abort ();
-
- if (rse.ss != gfc_ss_terminator)
- abort ();
+ gcc_assert (lse.ss == gfc_ss_terminator
+ && rse.ss == gfc_ss_terminator);
tmp = gfc_trans_scalar_assign (&lse, &rse, expr1->ts.type);
gfc_add_expr_to_block (&body, tmp);