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. * arith.c: Update copyright years. Whitespace.

264
gcc/fortran/array.c
View File

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

17
gcc/fortran/bbt.c
View File

@ -1,5 +1,6 @@
/* Balanced binary trees using treaps. /* 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 Contributed by Andy Vaught
This file is part of GCC. This file is part of GCC.
@ -62,7 +63,7 @@ pseudo_random (void)
/* Rotate the treap left. */ /* Rotate the treap left. */
static gfc_bbt * static gfc_bbt *
rotate_left (gfc_bbt * t) rotate_left (gfc_bbt *t)
{ {
gfc_bbt *temp; gfc_bbt *temp;
@ -77,7 +78,7 @@ rotate_left (gfc_bbt * t)
/* Rotate the treap right. */ /* Rotate the treap right. */
static gfc_bbt * static gfc_bbt *
rotate_right (gfc_bbt * t) rotate_right (gfc_bbt *t)
{ {
gfc_bbt *temp; gfc_bbt *temp;
@ -93,7 +94,7 @@ rotate_right (gfc_bbt * t)
aborts if we find a duplicate key. */ aborts if we find a duplicate key. */
static gfc_bbt * 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; int c;
@ -108,14 +109,12 @@ insert (gfc_bbt * new, gfc_bbt * t, compare_fn compare)
if (t->priority < t->left->priority) if (t->priority < t->left->priority)
t = rotate_right (t); t = rotate_right (t);
} }
else if (c > 0) else if (c > 0)
{ {
t->right = insert (new, t->right, compare); t->right = insert (new, t->right, compare);
if (t->priority < t->right->priority) if (t->priority < t->right->priority)
t = rotate_left (t); t = rotate_left (t);
} }
else /* if (c == 0) */ else /* if (c == 0) */
gfc_internal_error("insert_bbt(): Duplicate key found!"); 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; r = (gfc_bbt **) root;
n = (gfc_bbt *) new; n = (gfc_bbt *) new;
n->priority = pseudo_random (); n->priority = pseudo_random ();
*r = insert (n, *r, compare); *r = insert (n, *r, compare);
} }
static gfc_bbt * static gfc_bbt *
delete_root (gfc_bbt * t) delete_root (gfc_bbt *t)
{ {
gfc_bbt *temp; gfc_bbt *temp;
@ -170,7 +168,7 @@ delete_root (gfc_bbt * t)
Returns the new root node of the tree. */ Returns the new root node of the tree. */
static gfc_bbt * 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; int c;
@ -196,6 +194,5 @@ gfc_delete_bbt (void *root, void *old, compare_fn compare)
gfc_bbt **t; gfc_bbt **t;
t = (gfc_bbt **) root; t = (gfc_bbt **) root;
*t = delete_treap ((gfc_bbt *) old, *t, compare); *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> 2006-01-06 Lee Millward <lee.millward@codesourcery.com>
PR c++/19439 PR c++/19439

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

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