OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2007-01-06  Steven G. Kargl  <kargl@gcc.gnu.org>

        * array.c, bbt.c, check.c:  Update copyright years.  Whitespace.


2006-01-06  Steven G. Kargl  <kargl@gcc.gnu.org>

        * gfortran.dg/present_1.f90:  Update error message.

From-SVN: r120542
This commit is contained in:
Steven G. Kargl 2007-01-07 00:28:29 +00:00
parent ae82248d45
commit 65f8144a80
6 changed files with 478 additions and 471 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,4 +1,8 @@
2007-01-05 Steven G. Kargl <kargl@gcc.gnu.org>
2007-01-06 Steven G. Kargl <kargl@gcc.gnu.org>
* array.c, bbt.c, check.c: Update copyright years. Whitespace.
2007-01-06 Steven G. Kargl <kargl@gcc.gnu.org>
* arith.c: Update copyright years. Whitespace.

264
gcc/fortran/array.c
View File

@ -1,6 +1,6 @@
/* Array things
Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@ -37,7 +37,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
/* Copy an array reference structure. */
gfc_array_ref *
gfc_copy_array_ref (gfc_array_ref * src)
gfc_copy_array_ref (gfc_array_ref *src)
{
gfc_array_ref *dest;
int i;
@ -69,7 +69,7 @@ gfc_copy_array_ref (gfc_array_ref * src)
expression. */
static match
match_subscript (gfc_array_ref * ar, int init)
match_subscript (gfc_array_ref *ar, int init)
{
match m;
int i;
@ -119,7 +119,7 @@ end_element:
if (gfc_match_char (':') == MATCH_YES)
{
m = init ? gfc_match_init_expr (&ar->stride[i])
: gfc_match_expr (&ar->stride[i]);
: gfc_match_expr (&ar->stride[i]);
if (m == MATCH_NO)
gfc_error ("Expected array subscript stride at %C");
@ -136,7 +136,7 @@ end_element:
to consist of init expressions. */
match
gfc_match_array_ref (gfc_array_ref * ar, gfc_array_spec * as, int init)
gfc_match_array_ref (gfc_array_ref *ar, gfc_array_spec *as, int init)
{
match m;
@ -189,7 +189,7 @@ matched:
specifications. */
void
gfc_free_array_spec (gfc_array_spec * as)
gfc_free_array_spec (gfc_array_spec *as)
{
int i;
@ -210,9 +210,8 @@ gfc_free_array_spec (gfc_array_spec * as)
shape and check associated constraints. */
static try
resolve_array_bound (gfc_expr * e, int check_constant)
resolve_array_bound (gfc_expr *e, int check_constant)
{
if (e == NULL)
return SUCCESS;
@ -235,7 +234,7 @@ resolve_array_bound (gfc_expr * e, int check_constant)
the shape and make sure everything is integral. */
try
gfc_resolve_array_spec (gfc_array_spec * as, int check_constant)
gfc_resolve_array_spec (gfc_array_spec *as, int check_constant)
{
gfc_expr *e;
int i;
@ -264,14 +263,14 @@ gfc_resolve_array_spec (gfc_array_spec * as, int check_constant)
individual specifications make sense as a whole.
Parsed Lower Upper Returned
------------------------------------
: NULL NULL AS_DEFERRED (*)
x 1 x AS_EXPLICIT
x: x NULL AS_ASSUMED_SHAPE
x:y x y AS_EXPLICIT
x:* x NULL AS_ASSUMED_SIZE
* 1 NULL AS_ASSUMED_SIZE
Parsed Lower Upper Returned
------------------------------------
: NULL NULL AS_DEFERRED (*)
x 1 x AS_EXPLICIT
x: x NULL AS_ASSUMED_SHAPE
x:y x y AS_EXPLICIT
x:* x NULL AS_ASSUMED_SIZE
* 1 NULL AS_ASSUMED_SIZE
(*) For non-pointer dummy arrays this is AS_ASSUMED_SHAPE. This
is fixed during the resolution of formal interfaces.
@ -279,7 +278,7 @@ gfc_resolve_array_spec (gfc_array_spec * as, int check_constant)
Anything else AS_UNKNOWN. */
static array_type
match_array_element_spec (gfc_array_spec * as)
match_array_element_spec (gfc_array_spec *as)
{
gfc_expr **upper, **lower;
match m;
@ -328,7 +327,7 @@ match_array_element_spec (gfc_array_spec * as)
it is. */
match
gfc_match_array_spec (gfc_array_spec ** asp)
gfc_match_array_spec (gfc_array_spec **asp)
{
array_type current_type;
gfc_array_spec *as;
@ -362,7 +361,7 @@ gfc_match_array_spec (gfc_array_spec ** asp)
}
else
switch (as->type)
{ /* See how current spec meshes with the existing */
{ /* See how current spec meshes with the existing. */
case AS_UNKNOWN:
goto cleanup;
@ -376,9 +375,8 @@ gfc_match_array_spec (gfc_array_spec ** asp)
if (current_type == AS_EXPLICIT)
break;
gfc_error
("Bad array specification for an explicitly shaped array"
" at %C");
gfc_error ("Bad array specification for an explicitly shaped "
"array at %C");
goto cleanup;
@ -387,8 +385,8 @@ gfc_match_array_spec (gfc_array_spec ** asp)
|| (current_type == AS_DEFERRED))
break;
gfc_error
("Bad array specification for assumed shape array at %C");
gfc_error ("Bad array specification for assumed shape "
"array at %C");
goto cleanup;
case AS_DEFERRED:
@ -452,9 +450,8 @@ cleanup:
something goes wrong. On failure, the caller must free the spec. */
try
gfc_set_array_spec (gfc_symbol * sym, gfc_array_spec * as, locus * error_loc)
gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
{
if (as == NULL)
return SUCCESS;
@ -470,7 +467,7 @@ gfc_set_array_spec (gfc_symbol * sym, gfc_array_spec * as, locus * error_loc)
/* Copy an array specification. */
gfc_array_spec *
gfc_copy_array_spec (gfc_array_spec * src)
gfc_copy_array_spec (gfc_array_spec *src)
{
gfc_array_spec *dest;
int i;
@ -491,11 +488,12 @@ gfc_copy_array_spec (gfc_array_spec * src)
return dest;
}
/* Returns nonzero if the two expressions are equal. Only handles integer
constants. */
static int
compare_bounds (gfc_expr * bound1, gfc_expr * bound2)
compare_bounds (gfc_expr *bound1, gfc_expr *bound2)
{
if (bound1 == NULL || bound2 == NULL
|| bound1->expr_type != EXPR_CONSTANT
@ -510,11 +508,12 @@ compare_bounds (gfc_expr * bound1, gfc_expr * bound2)
return 0;
}
/* Compares two array specifications. They must be constant or deferred
shape. */
int
gfc_compare_array_spec (gfc_array_spec * as1, gfc_array_spec * as2)
gfc_compare_array_spec (gfc_array_spec *as1, gfc_array_spec *as2)
{
int i;
@ -553,7 +552,7 @@ gfc_compare_array_spec (gfc_array_spec * as1, gfc_array_spec * as2)
elements and should be appended to by gfc_append_constructor(). */
gfc_expr *
gfc_start_constructor (bt type, int kind, locus * where)
gfc_start_constructor (bt type, int kind, locus *where)
{
gfc_expr *result;
@ -573,7 +572,7 @@ gfc_start_constructor (bt type, int kind, locus * where)
node onto the constructor. */
void
gfc_append_constructor (gfc_expr * base, gfc_expr * new)
gfc_append_constructor (gfc_expr *base, gfc_expr *new)
{
gfc_constructor *c;
@ -600,7 +599,7 @@ gfc_append_constructor (gfc_expr * base, gfc_expr * new)
constructor onto the base's one according to the offset. */
void
gfc_insert_constructor (gfc_expr * base, gfc_constructor * c1)
gfc_insert_constructor (gfc_expr *base, gfc_constructor *c1)
{
gfc_constructor *c, *pre;
expr_t type;
@ -614,40 +613,40 @@ gfc_insert_constructor (gfc_expr * base, gfc_constructor * c1)
{
c = pre = base->value.constructor;
while (c)
{
if (type == EXPR_ARRAY)
{
{
if (type == EXPR_ARRAY)
{
t = mpz_cmp (c->n.offset, c1->n.offset);
if (t < 0)
{
pre = c;
c = c->next;
}
else if (t == 0)
{
gfc_error ("duplicated initializer");
break;
}
else
break;
}
else
{
pre = c;
c = c->next;
}
}
if (t < 0)
{
pre = c;
c = c->next;
}
else if (t == 0)
{
gfc_error ("duplicated initializer");
break;
}
else
break;
}
else
{
pre = c;
c = c->next;
}
}
if (pre != c)
{
pre->next = c1;
c1->next = c;
}
{
pre->next = c1;
c1->next = c;
}
else
{
c1->next = c;
base->value.constructor = c1;
}
{
c1->next = c;
base->value.constructor = c1;
}
}
}
@ -672,7 +671,7 @@ gfc_get_constructor (void)
/* Free chains of gfc_constructor structures. */
void
gfc_free_constructor (gfc_constructor * p)
gfc_free_constructor (gfc_constructor *p)
{
gfc_constructor *next;
@ -684,7 +683,7 @@ gfc_free_constructor (gfc_constructor * p)
next = p->next;
if (p->expr)
gfc_free_expr (p->expr);
gfc_free_expr (p->expr);
if (p->iterator != NULL)
gfc_free_iterator (p->iterator, 1);
mpz_clear (p->n.offset);
@ -700,7 +699,7 @@ gfc_free_constructor (gfc_constructor * p)
duplicate was found. */
static int
check_duplicate_iterator (gfc_constructor * c, gfc_symbol * master)
check_duplicate_iterator (gfc_constructor *c, gfc_symbol *master)
{
gfc_expr *e;
@ -717,9 +716,8 @@ check_duplicate_iterator (gfc_constructor * c, gfc_symbol * master)
if (c->iterator->var->symtree->n.sym == master)
{
gfc_error
("DO-iterator '%s' at %L is inside iterator of the same name",
master->name, &c->where);
gfc_error ("DO-iterator '%s' at %L is inside iterator of the "
"same name", master->name, &c->where);
return 1;
}
@ -735,7 +733,7 @@ static match match_array_cons_element (gfc_constructor **);
/* Match a list of array elements. */
static match
match_array_list (gfc_constructor ** result)
match_array_list (gfc_constructor **result)
{
gfc_constructor *p, *head, *tail, *new;
gfc_iterator iter;
@ -835,7 +833,7 @@ cleanup:
single expression or a list of elements. */
static match
match_array_cons_element (gfc_constructor ** result)
match_array_cons_element (gfc_constructor **result)
{
gfc_constructor *p;
gfc_expr *expr;
@ -861,7 +859,7 @@ match_array_cons_element (gfc_constructor ** result)
/* Match an array constructor. */
match
gfc_match_array_constructor (gfc_expr ** result)
gfc_match_array_constructor (gfc_expr **result)
{
gfc_constructor *head, *tail, *new;
gfc_expr *expr;
@ -872,14 +870,14 @@ gfc_match_array_constructor (gfc_expr ** result)
if (gfc_match (" (/") == MATCH_NO)
{
if (gfc_match (" [") == MATCH_NO)
return MATCH_NO;
return MATCH_NO;
else
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: [...] "
"style array constructors at %C") == FAILURE)
return MATCH_ERROR;
end_delim = " ]";
}
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: [...] "
"style array constructors at %C") == FAILURE)
return MATCH_ERROR;
end_delim = " ]";
}
}
else
end_delim = " /)";
@ -952,9 +950,8 @@ static enum
cons_state;
static int
check_element_type (gfc_expr * expr)
check_element_type (gfc_expr *expr)
{
if (cons_state == CONS_BAD)
return 0; /* Suppress further errors */
@ -986,7 +983,7 @@ check_element_type (gfc_expr * expr)
/* Recursive work function for gfc_check_constructor_type(). */
static try
check_constructor_type (gfc_constructor * c)
check_constructor_type (gfc_constructor *c)
{
gfc_expr *e;
@ -1014,7 +1011,7 @@ check_constructor_type (gfc_constructor * c)
On FAILURE, an error has been generated. */
try
gfc_check_constructor_type (gfc_expr * e)
gfc_check_constructor_type (gfc_expr *e)
{
try t;
@ -1039,15 +1036,14 @@ cons_stack;
static cons_stack *base;
static try check_constructor (gfc_constructor *, try (*)(gfc_expr *));
static try check_constructor (gfc_constructor *, try (*) (gfc_expr *));
/* Check an EXPR_VARIABLE expression in a constructor to make sure
that that variable is an iteration variables. */
try
gfc_check_iter_variable (gfc_expr * expr)
gfc_check_iter_variable (gfc_expr *expr)
{
gfc_symbol *sym;
cons_stack *c;
@ -1066,7 +1062,7 @@ gfc_check_iter_variable (gfc_expr * expr)
constructor, giving variables with the names of iterators a pass. */
static try
check_constructor (gfc_constructor * c, try (*check_function) (gfc_expr *))
check_constructor (gfc_constructor *c, try (*check_function) (gfc_expr *))
{
cons_stack element;
gfc_expr *e;
@ -1104,7 +1100,7 @@ check_constructor (gfc_constructor * c, try (*check_function) (gfc_expr *))
determined by the check_function. */
try
gfc_check_constructor (gfc_expr * expr, try (*check_function) (gfc_expr *))
gfc_check_constructor (gfc_expr *expr, try (*check_function) (gfc_expr *))
{
cons_stack *base_save;
try t;
@ -1148,7 +1144,7 @@ static try expand_constructor (gfc_constructor *);
constructor. */
static try
count_elements (gfc_expr * e)
count_elements (gfc_expr *e)
{
mpz_t result;
@ -1175,7 +1171,7 @@ count_elements (gfc_expr * e)
constructor, freeing the rest. */
static try
extract_element (gfc_expr * e)
extract_element (gfc_expr *e)
{
if (e->rank != 0)
@ -1198,9 +1194,8 @@ extract_element (gfc_expr * e)
stringing new elements together. */
static try
expand (gfc_expr * e)
expand (gfc_expr *e)
{
if (current_expand.new_head == NULL)
current_expand.new_head = current_expand.new_tail =
gfc_get_constructor ();
@ -1224,7 +1219,7 @@ expand (gfc_expr * e)
substitute the current value of the iteration variable. */
void
gfc_simplify_iterator_var (gfc_expr * e)
gfc_simplify_iterator_var (gfc_expr *e)
{
iterator_stack *p;
@ -1247,9 +1242,8 @@ gfc_simplify_iterator_var (gfc_expr * e)
recursing into other constructors if present. */
static try
expand_expr (gfc_expr * e)
expand_expr (gfc_expr *e)
{
if (e->expr_type == EXPR_ARRAY)
return expand_constructor (e->value.constructor);
@ -1266,7 +1260,7 @@ expand_expr (gfc_expr * e)
static try
expand_iterator (gfc_constructor * c)
expand_iterator (gfc_constructor *c)
{
gfc_expr *start, *end, *step;
iterator_stack frame;
@ -1349,7 +1343,7 @@ cleanup:
passed expression. */
static try
expand_constructor (gfc_constructor * c)
expand_constructor (gfc_constructor *c)
{
gfc_expr *e;
@ -1392,7 +1386,7 @@ expand_constructor (gfc_constructor * c)
constructor if they are small enough. */
try
gfc_expand_constructor (gfc_expr * e)
gfc_expand_constructor (gfc_expr *e)
{
expand_info expand_save;
gfc_expr *f;
@ -1436,7 +1430,7 @@ done:
FAILURE if not so. */
static try
constant_element (gfc_expr * e)
constant_element (gfc_expr *e)
{
int rv;
@ -1454,7 +1448,7 @@ constant_element (gfc_expr * e)
function that traverses the expression tree. FIXME. */
int
gfc_constant_ac (gfc_expr * e)
gfc_constant_ac (gfc_expr *e)
{
expand_info expand_save;
try rc;
@ -1477,7 +1471,7 @@ gfc_constant_ac (gfc_expr * e)
expanded (no iterators) and zero if iterators are present. */
int
gfc_expanded_ac (gfc_expr * e)
gfc_expanded_ac (gfc_expr *e)
{
gfc_constructor *p;
@ -1496,7 +1490,7 @@ gfc_expanded_ac (gfc_expr * e)
be of the same type. */
static try
resolve_array_list (gfc_constructor * p)
resolve_array_list (gfc_constructor *p)
{
try t;
@ -1520,9 +1514,9 @@ resolve_array_list (gfc_constructor * p)
its element constructors' length. */
void
gfc_resolve_character_array_constructor (gfc_expr * expr)
gfc_resolve_character_array_constructor (gfc_expr *expr)
{
gfc_constructor * p;
gfc_constructor *p;
int max_length;
gcc_assert (expr->expr_type == EXPR_ARRAY);
@ -1550,32 +1544,35 @@ got_charlen:
if (expr->ts.cl->length == NULL)
{
/* Find the maximum length of the elements. Do nothing for variable array
constructor, unless the character length is constant or there is a
constant substring reference. */
/* Find the maximum length of the elements. Do nothing for variable
array constructor, unless the character length is constant or
there is a constant substring reference. */
for (p = expr->value.constructor; p; p = p->next)
{
gfc_ref *ref;
for (ref = p->expr->ref; ref; ref = ref->next)
if (ref->type == REF_SUBSTRING
&& ref->u.ss.start->expr_type == EXPR_CONSTANT
&& ref->u.ss.end->expr_type == EXPR_CONSTANT)
&& ref->u.ss.start->expr_type == EXPR_CONSTANT
&& ref->u.ss.end->expr_type == EXPR_CONSTANT)
break;
if (p->expr->expr_type == EXPR_CONSTANT)
max_length = MAX (p->expr->value.character.length, max_length);
else if (ref)
max_length = MAX ((int)(mpz_get_ui (ref->u.ss.end->value.integer)
- mpz_get_ui (ref->u.ss.start->value.integer))
+ 1, max_length);
{
long j;
j = mpz_get_ui (ref->u.ss.end->value.integer)
- mpz_get_ui (ref->u.ss.start->value.integer) + 1;
max_length = MAX ((int) j, max_length);
}
else if (p->expr->ts.cl && p->expr->ts.cl->length
&& p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
max_length = MAX ((int)mpz_get_si (p->expr->ts.cl->length->value.integer),
max_length);
&& p->expr->ts.cl->length->expr_type == EXPR_CONSTANT)
{
long j;
j = mpz_get_si (p->expr->ts.cl->length->value.integer);
max_length = MAX ((int) j, max_length);
}
else
return;
}
@ -1592,10 +1589,11 @@ got_charlen:
}
}
/* Resolve all of the expressions in an array list. */
try
gfc_resolve_array_constructor (gfc_expr * expr)
gfc_resolve_array_constructor (gfc_expr *expr)
{
try t;
@ -1612,7 +1610,7 @@ gfc_resolve_array_constructor (gfc_expr * expr)
/* Copy an iterator structure. */
static gfc_iterator *
copy_iterator (gfc_iterator * src)
copy_iterator (gfc_iterator *src)
{
gfc_iterator *dest;
@ -1633,7 +1631,7 @@ copy_iterator (gfc_iterator * src)
/* Copy a constructor structure. */
gfc_constructor *
gfc_copy_constructor (gfc_constructor * src)
gfc_copy_constructor (gfc_constructor *src)
{
gfc_constructor *dest;
gfc_constructor *tail;
@ -1672,7 +1670,7 @@ gfc_copy_constructor (gfc_constructor * src)
have to be particularly fast. */
gfc_expr *
gfc_get_array_element (gfc_expr * array, int element)
gfc_get_array_element (gfc_expr *array, int element)
{
expand_info expand_save;
gfc_expr *e;
@ -1708,9 +1706,8 @@ gfc_get_array_element (gfc_expr * array, int element)
array is guaranteed to be one dimensional. */
static try
spec_dimen_size (gfc_array_spec * as, int dimen, mpz_t * result)
spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result)
{
if (as == NULL)
return FAILURE;
@ -1734,7 +1731,7 @@ spec_dimen_size (gfc_array_spec * as, int dimen, mpz_t * result)
try
spec_size (gfc_array_spec * as, mpz_t * result)
spec_size (gfc_array_spec *as, mpz_t *result)
{
mpz_t size;
int d;
@ -1760,7 +1757,7 @@ spec_size (gfc_array_spec * as, mpz_t * result)
/* Get the number of elements in an array section. */
static try
ref_dimen_size (gfc_array_ref * ar, int dimen, mpz_t * result)
ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result)
{
mpz_t upper, lower, stride;
try t;
@ -1848,7 +1845,7 @@ ref_dimen_size (gfc_array_ref * ar, int dimen, mpz_t * result)
static try
ref_size (gfc_array_ref * ar, mpz_t * result)
ref_size (gfc_array_ref *ar, mpz_t *result)
{
mpz_t size;
int d;
@ -1877,7 +1874,7 @@ ref_size (gfc_array_ref * ar, mpz_t * result)
otherwise. */
try
gfc_array_dimen_size (gfc_expr * array, int dimen, mpz_t * result)
gfc_array_dimen_size (gfc_expr *array, int dimen, mpz_t *result)
{
gfc_ref *ref;
int i;
@ -1945,7 +1942,7 @@ gfc_array_dimen_size (gfc_expr * array, int dimen, mpz_t * result)
variable. Otherwise returns FAILURE. */
try
gfc_array_size (gfc_expr * array, mpz_t * result)
gfc_array_size (gfc_expr *array, mpz_t *result)
{
expand_info expand_save;
gfc_ref *ref;
@ -2010,7 +2007,7 @@ gfc_array_size (gfc_expr * array, mpz_t * result)
array of mpz_t integers. */
try
gfc_array_ref_shape (gfc_array_ref * ar, mpz_t * shape)
gfc_array_ref_shape (gfc_array_ref *ar, mpz_t *shape)
{
int d;
int i;
@ -2055,14 +2052,13 @@ cleanup:
characterizes the reference. */
gfc_array_ref *
gfc_find_array_ref (gfc_expr * e)
gfc_find_array_ref (gfc_expr *e)
{
gfc_ref *ref;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY
&& (ref->u.ar.type == AR_FULL
|| ref->u.ar.type == AR_SECTION))
&& (ref->u.ar.type == AR_FULL || ref->u.ar.type == AR_SECTION))
break;
if (ref == NULL)

17
gcc/fortran/bbt.c
View File

@ -1,5 +1,6 @@
/* Balanced binary trees using treaps.
Copyright (C) 2000, 2002, 2003 Free Software Foundation, Inc.
Copyright (C) 2000, 2002, 2003, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@ -62,7 +63,7 @@ pseudo_random (void)
/* Rotate the treap left. */
static gfc_bbt *
rotate_left (gfc_bbt * t)
rotate_left (gfc_bbt *t)
{
gfc_bbt *temp;
@ -77,7 +78,7 @@ rotate_left (gfc_bbt * t)
/* Rotate the treap right. */
static gfc_bbt *
rotate_right (gfc_bbt * t)
rotate_right (gfc_bbt *t)
{
gfc_bbt *temp;
@ -93,7 +94,7 @@ rotate_right (gfc_bbt * t)
aborts if we find a duplicate key. */
static gfc_bbt *
insert (gfc_bbt * new, gfc_bbt * t, compare_fn compare)
insert (gfc_bbt *new, gfc_bbt *t, compare_fn compare)
{
int c;
@ -108,14 +109,12 @@ insert (gfc_bbt * new, gfc_bbt * t, compare_fn compare)
if (t->priority < t->left->priority)
t = rotate_right (t);
}
else if (c > 0)
{
t->right = insert (new, t->right, compare);
if (t->priority < t->right->priority)
t = rotate_left (t);
}
else /* if (c == 0) */
gfc_internal_error("insert_bbt(): Duplicate key found!");
@ -134,13 +133,12 @@ gfc_insert_bbt (void *root, void *new, compare_fn compare)
r = (gfc_bbt **) root;
n = (gfc_bbt *) new;
n->priority = pseudo_random ();
*r = insert (n, *r, compare);
}
static gfc_bbt *
delete_root (gfc_bbt * t)
delete_root (gfc_bbt *t)
{
gfc_bbt *temp;
@ -170,7 +168,7 @@ delete_root (gfc_bbt * t)
Returns the new root node of the tree. */
static gfc_bbt *
delete_treap (gfc_bbt * old, gfc_bbt * t, compare_fn compare)
delete_treap (gfc_bbt *old, gfc_bbt *t, compare_fn compare)
{
int c;
@ -196,6 +194,5 @@ gfc_delete_bbt (void *root, void *old, compare_fn compare)
gfc_bbt **t;
t = (gfc_bbt **) root;
*t = delete_treap ((gfc_bbt *) old, *t, compare);
}

654
gcc/fortran/check.c
View File

File diff suppressed because it is too large Load Diff

4
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,7 @@
2006-01-06 Steven G. Kargl <kargl@gcc.gnu.org>
* gfortran.dg/present_1.f90: Update error message.
2006-01-06 Lee Millward <lee.millward@codesourcery.com>
PR c++/19439

4
gcc/testsuite/gfortran.dg/present_1.f90
View File

@ -11,8 +11,8 @@
CONTAINS
SUBROUTINE S1(D1)
TYPE(T1), OPTIONAL :: D1(4)
write(6,*) PRESENT(D1%I) ! { dg-error "must not be a sub-object" }
write(6,*) PRESENT(D1(1)) ! { dg-error "must not be a sub-object" }
write(6,*) PRESENT(D1%I) ! { dg-error "must not be a subobject" }
write(6,*) PRESENT(D1(1)) ! { dg-error "must not be a subobject" }
write(6,*) PRESENT(D1)
END SUBROUTINE S1
END MODULE