/* Array translation routines
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ 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>
gcc_assert (DATA_FIELD == 0);
t = fold_build3 (COMPONENT_REF, TREE_TYPE (field), desc, field, NULL_TREE);
- return build_fold_addr_expr (t);
+ return gfc_build_addr_expr (NULL_TREE, t);
}
tree
tmp = build_array_type (gfc_get_element_type (TREE_TYPE (desc)),
tmp);
tmp = gfc_create_var (tmp, "A");
- tmp = build_fold_addr_expr (tmp);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
gfc_conv_descriptor_data_set (pre, desc, tmp);
}
else
gfc_trans_string_copy (&se->pre, esize, tmp, expr->ts.kind,
se->string_length, se->expr, expr->ts.kind);
}
- if (flag_bounds_check && !typespec_chararray_ctor)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS) && !typespec_chararray_ctor)
{
if (first_len)
{
tree init;
tree bound;
tree tmptype;
+ HOST_WIDE_INT idx = 0;
p = c;
list = NULL_TREE;
(gfc_get_pchar_type (p->expr->ts.kind),
se.expr);
- list = tree_cons (NULL_TREE, se.expr, list);
+ list = tree_cons (build_int_cst (gfc_array_index_type,
+ idx++), se.expr, list);
c = p;
p = p->next;
}
tmp = gfc_conv_descriptor_data_get (desc);
tmp = build_fold_indirect_ref (tmp);
tmp = gfc_build_array_ref (tmp, *poffset, NULL);
- tmp = build_fold_addr_expr (tmp);
- init = build_fold_addr_expr (init);
+ tmp = gfc_build_addr_expr (NULL_TREE, tmp);
+ init = gfc_build_addr_expr (NULL_TREE, init);
size = TREE_INT_CST_LOW (TYPE_SIZE_UNIT (type));
bound = build_int_cst (NULL_TREE, n * size);
if (c->expr->ts.type == BT_CHARACTER && POINTER_TYPE_P (type))
se.expr = gfc_build_addr_expr (gfc_get_pchar_type (c->expr->ts.kind),
se.expr);
- list = tree_cons (NULL_TREE, se.expr, list);
+ list = tree_cons (build_int_cst (gfc_array_index_type, nelem),
+ se.expr, list);
c = c->next;
nelem++;
}
info = &ss->data.info;
info->descriptor = tmp;
- info->data = build_fold_addr_expr (tmp);
+ info->data = gfc_build_addr_expr (NULL_TREE, tmp);
info->offset = gfc_index_zero_node;
for (i = 0; i < info->dimen; i++)
typespec_chararray_ctor = (ss->expr->ts.cl
&& ss->expr->ts.cl->length_from_typespec);
- if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER
- && !typespec_chararray_ctor)
+ if ((gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+ && ss->expr->ts.type == BT_CHARACTER && !typespec_chararray_ctor)
{
first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
first_len = true;
gcc_assert (INTEGER_CST_P (offset));
#if 0
/* Disable bound checking for now because it's probably broken. */
- if (flag_bounds_check)
+ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
gcc_unreachable ();
}
else
{
/* Descriptorless arrays. */
- return build_fold_addr_expr (descriptor);
+ return gfc_build_addr_expr (NULL_TREE, descriptor);
}
}
else
char *msg;
const char * name = NULL;
- if (!flag_bounds_check)
+ if (!(gfc_option.rtcheck & GFC_RTCHECK_BOUNDS))
return index;
index = gfc_evaluate_now (index, &se->pre);
gfc_conv_expr_type (&indexse, ar->start[n], gfc_array_index_type);
gfc_add_block_to_block (&se->pre, &indexse.pre);
- if (flag_bounds_check)
+ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
/* Check array bounds. */
tree cond;
}
/* The rest is just runtime bound checking. */
- if (flag_bounds_check)
+ if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
{
stmtblock_t block;
tree lbound, ubound;
CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
break;
+
default:
- gcc_unreachable ();
+ /* Catch those occasional beasts that do not simplify
+ for one reason or another, assuming that if they are
+ standard defying the frontend will catch them. */
+ gfc_conv_expr (&se, c->expr);
+ if (range == NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ else
+ {
+ if (index != NULL_TREE)
+ CONSTRUCTOR_APPEND_ELT (v, index, se.expr);
+ CONSTRUCTOR_APPEND_ELT (v, range, se.expr);
+ }
+ break;
}
}
break;
&& TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
gfc_conv_string_length (sym->ts.cl, NULL, &block);
- checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check);
+ checkparm = (sym->as->type == AS_EXPLICIT
+ && (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS));
no_repack = !(GFC_DECL_PACKED_ARRAY (tmpdesc)
|| GFC_DECL_PARTIAL_PACKED_ARRAY (tmpdesc));
{
/* We pass full arrays directly. This means that pointers and
allocatable arrays should also work. */
- se->expr = build_fold_addr_expr (desc);
+ se->expr = gfc_build_addr_expr (NULL_TREE, desc);
}
else
{
/* For pointer assignments pass the descriptor directly. */
se->ss = secss;
- se->expr = build_fold_addr_expr (se->expr);
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
gfc_conv_expr (se, expr);
return;
}
{
/* Get a pointer to the new descriptor. */
if (se->want_pointer)
- se->expr = build_fold_addr_expr (desc);
+ se->expr = gfc_build_addr_expr (NULL_TREE, desc);
else
se->expr = desc;
}
stmtblock_t block;
full_array_var = (expr->expr_type == EXPR_VARIABLE
- && expr->ref->u.ar.type == AR_FULL);
+ && expr->ref->type == REF_ARRAY
+ && expr->ref->u.ar.type == AR_FULL);
sym = full_array_var ? expr->symtree->n.sym : NULL;
/* The symbol should have an array specification. */
if (sym->attr.dummy || POINTER_TYPE_P (TREE_TYPE (tmp)))
se->expr = tmp;
else
- se->expr = build_fold_addr_expr (tmp);
+ se->expr = gfc_build_addr_expr (NULL_TREE, tmp);
return;
}
if (sym->attr.allocatable)
{
/* Result of the enclosing function. */
gfc_conv_expr_descriptor (se, expr, ss);
- se->expr = build_fold_addr_expr (se->expr);
+ se->expr = gfc_build_addr_expr (NULL_TREE, se->expr);
if (g77 && TREE_TYPE (TREE_TYPE (se->expr)) != NULL_TREE
&& GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (se->expr))))
gfc_conv_expr_descriptor (se, expr, ss);
}
-
/* Deallocate the allocatable components of structures that are
not variable. */
if (expr->ts.type == BT_DERIVED
se->expr = ptr;
- if (gfc_option.flag_check_array_temporaries)
+ if (gfc_option.rtcheck & GFC_RTCHECK_ARRAY_TEMPS)
{
char * msg;
if (purpose == COPY_ALLOC_COMP)
{
- tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
- gfc_add_expr_to_block (&fnblock, tmp);
-
- tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (dest));
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+ {
+ tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
+ gfc_add_expr_to_block (&fnblock, tmp);
+ }
+ tmp = build_fold_indirect_ref (gfc_conv_array_data (dest));
dref = gfc_build_array_ref (tmp, index, NULL);
tmp = structure_alloc_comps (der_type, vref, dref, rank, purpose);
}
OSDN Git Service
