Skip to content

R
riscv-gcc-1
Commit 636dff67 by Steven G. Kargl
Options

decl.c, [...]: Update Copyright dates. 

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

    * decl.c, dump-parse-tree.c, error.c, data.c, expr.c, dependency.c,
    convert.c:  Update Copyright dates.  Fix whitespace.

From-SVN: r120552
parent cd85e27a
Showing with 349 additions and 421 deletions
gcc/fortran/ChangeLog
2007-01-07 Steven G. Kargl <kargl@gcc.gnu.org>
* decl.c, dump-parse-tree.c, error.c, data.c, expr.c, dependency.c,
convert.c: Update Copyright dates. Fix whitespace.
2007-01-07 Bernhard Fischer <aldot@gcc.gnu.org>
* data.c (gfc_assign_data_value): Fix whitespace.
......
gcc/fortran/convert.c
/* Language-level data type conversion for GNU C.
Copyright (C) 1987, 1988, 1991, 1998, 2002 Free Software Foundation, Inc.
Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007
Free Software Foundation, Inc.
This file is part of GCC.
......@@ -61,7 +62,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
/* Subroutines of `convert'. */
/* Create an expression whose value is that of EXPR,
converted to type TYPE. The TREE_TYPE of the value
is always TYPE. This function implements all reasonable
......
gcc/fortran/data.c
/* Supporting functions for resolving DATA statement.
Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
This file is part of GCC.
......@@ -42,7 +42,7 @@ static void formalize_init_expr (gfc_expr *);
/* Calculate the array element offset. */
static void
get_array_index (gfc_array_ref * ar, mpz_t * offset)
get_array_index (gfc_array_ref *ar, mpz_t *offset)
{
gfc_expr *e;
int i;
......@@ -62,6 +62,7 @@ get_array_index (gfc_array_ref * ar, mpz_t * offset)
|| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
|| (gfc_is_constant_expr (e) == 0))
gfc_error ("non-constant array in DATA statement %L", &ar->where);
mpz_set (tmp, e->value.integer);
mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
mpz_mul (tmp, tmp, delta);
......@@ -87,15 +88,15 @@ find_con_by_offset (splay_tree spt, mpz_t offset)
gfc_constructor *con;
splay_tree_node sptn;
/* The complexity is due to needing quick access to the linked list of
constructors. Both a linked list and a splay tree are used, and both are
kept up to date if they are array elements (which is the only time that
a specific constructor has to be found). */
/* The complexity is due to needing quick access to the linked list of
constructors. Both a linked list and a splay tree are used, and both
are kept up to date if they are array elements (which is the only time
that a specific constructor has to be found). */
gcc_assert (spt != NULL);
mpz_init (tmp);
sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si(offset));
sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si (offset));
if (sptn)
ret = (gfc_constructor*) sptn->value;
......@@ -103,7 +104,8 @@ find_con_by_offset (splay_tree spt, mpz_t offset)
{
/* Need to check and see if we match a range, so we will pull
the next lowest index and see if the range matches. */
sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
sptn = splay_tree_predecessor (spt,
(splay_tree_key) mpz_get_si (offset));
if (sptn)
{
con = (gfc_constructor*) sptn->value;
......@@ -146,8 +148,8 @@ find_con_by_component (gfc_component *com, gfc_constructor *con)
according to normal assignment rules. */
static gfc_expr *
create_character_intializer (gfc_expr * init, gfc_typespec * ts,
gfc_ref * ref, gfc_expr * rvalue)
create_character_intializer (gfc_expr *init, gfc_typespec *ts,
gfc_ref *ref, gfc_expr *rvalue)
{
int len;
int start;
......@@ -188,7 +190,7 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
|| (gfc_simplify_expr (end_expr, 1)) == FAILURE)
{
gfc_error ("failure to simplify substring reference in DATA"
gfc_error ("failure to simplify substring reference in DATA "
"statement at %L", &ref->u.ss.start->where);
return NULL;
}
......@@ -225,12 +227,13 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
return init;
}
/* Assign the initial value RVALUE to LVALUE's symbol->value. If the
LVALUE already has an initialization, we extend this, otherwise we
create a new one. */
void
gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
{
gfc_ref *ref;
gfc_expr *init;
......@@ -294,7 +297,7 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
if (spt == NULL)
{
spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
expr->con_by_offset = spt;
con = NULL;
}
......@@ -303,13 +306,15 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
if (con == NULL)
{
splay_tree_key j;
/* Create a new constructor. */
con = gfc_get_constructor ();
mpz_set (con->n.offset, offset);
sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
(splay_tree_value) con);
j = (splay_tree_key) mpz_get_si (offset);
sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
/* Fix up the linked list. */
sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
sptn = splay_tree_predecessor (spt, j);
if (sptn == NULL)
{ /* Insert at the head. */
con->next = expr->value.constructor;
......@@ -374,16 +379,16 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
provokes a warning from other compilers. */
if (init != NULL)
{
/* Order in which the expressions arrive here depends on whether they
are from data statements or F95 style declarations. Therefore,
check which is the most recent. */
/* Order in which the expressions arrive here depends on whether
they are from data statements or F95 style declarations.
Therefore, check which is the most recent. */
#ifdef USE_MAPPED_LOCATION
expr = (LOCATION_LINE (init->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
? init : rvalue;
#else
expr = (init->where.lb->linenum > rvalue->where.lb->linenum) ?
init : rvalue;
expr = (init->where.lb->linenum > rvalue->where.lb->linenum)
? init : rvalue;
#endif
gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
"of '%s' at %L", symbol->name, &expr->where);
......@@ -400,12 +405,13 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
last_con->expr = expr;
}
/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
value in RVALUE. For the nonce, LVALUE must refer to a full array, not
an array section. */
void
gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
mpz_t index, mpz_t repeat)
{
gfc_ref *ref;
......@@ -476,7 +482,7 @@ gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
if (spt == NULL)
{
spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
expr->con_by_offset = spt;
con = NULL;
}
......@@ -485,15 +491,17 @@ gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
if (con == NULL)
{
splay_tree_key j;
/* Create a new constructor. */
con = gfc_get_constructor ();
mpz_set (con->n.offset, offset);
j = (splay_tree_key) mpz_get_si (offset);
if (ref->next == NULL)
mpz_set (con->repeat, repeat);
sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
(splay_tree_value) con);
sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
/* Fix up the linked list. */
sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
sptn = splay_tree_predecessor (spt, j);
if (sptn == NULL)
{ /* Insert at the head. */
con->next = expr->value.constructor;
......@@ -612,8 +620,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
else
cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
if ((cmp > 0 && forwards)
|| (cmp < 0 && ! forwards))
if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
{
/* Reset index to start, then loop to advance the next index. */
if (ar->start[i])
......@@ -648,7 +655,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
order. Also insert NULL entries if necessary. */
static void
formalize_structure_cons (gfc_expr * expr)
formalize_structure_cons (gfc_expr *expr)
{
gfc_constructor *head;
gfc_constructor *tail;
......@@ -710,7 +717,7 @@ formalize_structure_cons (gfc_expr * expr)
elements of the constructors are in the correct order. */
static void
formalize_init_expr (gfc_expr * expr)
formalize_init_expr (gfc_expr *expr)
{
expr_t type;
gfc_constructor *c;
......
gcc/fortran/decl.c
/* Declaration statement matcher
Copyright (C) 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
Copyright (C) 2002, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
......@@ -19,14 +20,12 @@ along with GCC; see the file COPYING. If not, write to the Free
Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA. */
#include "config.h"
#include "system.h"
#include "gfortran.h"
#include "match.h"
#include "parse.h"
/* This flag is set if an old-style length selector is matched
during a type-declaration statement. */
......@@ -91,7 +90,7 @@ gfc_set_in_match_data (bool set_value)
/* Free a gfc_data_variable structure and everything beneath it. */
static void
free_variable (gfc_data_variable * p)
free_variable (gfc_data_variable *p)
{
gfc_data_variable *q;
......@@ -101,7 +100,6 @@ free_variable (gfc_data_variable * p)
gfc_free_expr (p->expr);
gfc_free_iterator (&p->iter, 0);
free_variable (p->list);
gfc_free (p);
}
}
......@@ -110,7 +108,7 @@ free_variable (gfc_data_variable * p)
/* Free a gfc_data_value structure and everything beneath it. */
static void
free_value (gfc_data_value * p)
free_value (gfc_data_value *p)
{
gfc_data_value *q;
......@@ -126,23 +124,22 @@ free_value (gfc_data_value * p)
/* Free a list of gfc_data structures. */
void
gfc_free_data (gfc_data * p)
gfc_free_data (gfc_data *p)
{
gfc_data *q;
for (; p; p = q)
{
q = p->next;
free_variable (p->var);
free_value (p->value);
gfc_free (p);
}
}
/* Free all data in a namespace. */
static void
gfc_free_data_all (gfc_namespace * ns)
{
......@@ -163,7 +160,7 @@ static match var_element (gfc_data_variable *);
parenthesis. */
static match
var_list (gfc_data_variable * parent)
var_list (gfc_data_variable *parent)
{
gfc_data_variable *tail, var;
match m;
......@@ -216,7 +213,7 @@ syntax:
variable-iterator list. */
static match
var_element (gfc_data_variable * new)
var_element (gfc_data_variable *new)
{
match m;
gfc_symbol *sym;
......@@ -232,7 +229,8 @@ var_element (gfc_data_variable * new)
sym = new->expr->symtree->n.sym;
if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns)
if (!sym->attr.function && gfc_current_ns->parent
&& gfc_current_ns->parent == sym->ns)
{
gfc_error ("Host associated variable '%s' may not be in the DATA "
"statement at %C", sym->name);
......@@ -256,7 +254,7 @@ var_element (gfc_data_variable * new)
/* Match the top-level list of data variables. */
static match
top_var_list (gfc_data * d)
top_var_list (gfc_data *d)
{
gfc_data_variable var, *tail, *new;
match m;
......@@ -297,7 +295,7 @@ syntax:
static match
match_data_constant (gfc_expr ** result)
match_data_constant (gfc_expr **result)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
......@@ -344,7 +342,7 @@ match_data_constant (gfc_expr ** result)
already been seen at this point. */
static match
top_val_list (gfc_data * data)
top_val_list (gfc_data *data)
{
gfc_data_value *new, *tail;
gfc_expr *expr;
......@@ -458,6 +456,7 @@ match_old_style_init (const char *name)
return m;
}
/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
we are matching a DATA statement and are therefore issuing an error
if we encounter something unexpected, if not, we're trying to match
......@@ -535,9 +534,8 @@ match_intent_spec (void)
specification expression or a '*'. */
static match
char_len_param_value (gfc_expr ** expr)
char_len_param_value (gfc_expr **expr)
{
if (gfc_match_char ('*') == MATCH_YES)
{
*expr = NULL;
......@@ -552,7 +550,7 @@ char_len_param_value (gfc_expr ** expr)
char_len_param_value in parenthesis. */
static match
match_char_length (gfc_expr ** expr)
match_char_length (gfc_expr **expr)
{
int length;
match m;
......@@ -602,13 +600,13 @@ syntax:
(located in another namespace). */
static int
find_special (const char *name, gfc_symbol ** result)
find_special (const char *name, gfc_symbol **result)
{
gfc_state_data *s;
int i;
i = gfc_get_symbol (name, NULL, result);
if (i==0)
if (i == 0)
goto end;
if (gfc_current_state () != COMP_SUBROUTINE
......@@ -642,8 +640,7 @@ end:
parent, then the symbol is just created in the current unit. */
static int
get_proc_name (const char *name, gfc_symbol ** result,
bool module_fcn_entry)
get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
{
gfc_symtree *st;
gfc_symbol *sym;
......@@ -686,8 +683,8 @@ get_proc_name (const char *name, gfc_symbol ** result,
&& gfc_current_ns->parent != NULL
&& sym->attr.access == 0
&& !module_fcn_entry)
gfc_error_now ("Procedure '%s' at %C has an explicit interface"
" and must not have attributes declared at %L",
gfc_error_now ("Procedure '%s' at %C has an explicit interface "
"and must not have attributes declared at %L",
name, &sym->declared_at);
}
......@@ -721,20 +718,19 @@ get_proc_name (const char *name, gfc_symbol ** result,
table. */
static try
build_sym (const char *name, gfc_charlen * cl,
gfc_array_spec ** as, locus * var_locus)
build_sym (const char *name, gfc_charlen *cl,
gfc_array_spec **as, locus *var_locus)
{
symbol_attribute attr;
gfc_symbol *sym;
/* if (find_special (name, &sym)) */
if (gfc_get_symbol (name, NULL, &sym))
return FAILURE;
/* Start updating the symbol table. Add basic type attribute
if present. */
if (current_ts.type != BT_UNKNOWN
&&(sym->attr.implicit_type == 0
&& (sym->attr.implicit_type == 0
|| !gfc_compare_types (&sym->ts, &current_ts))
&& gfc_add_type (sym, &current_ts, var_locus) == FAILURE)
return FAILURE;
......@@ -758,13 +754,14 @@ build_sym (const char *name, gfc_charlen * cl,
return SUCCESS;
}
/* Set character constant to the given length. The constant will be padded or
truncated. */
void
gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
{
char * s;
char *s;
int slen;
gcc_assert (expr->expr_type == EXPR_CONSTANT);
......@@ -806,7 +803,7 @@ gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
INIT points to its enumerator value. */
static void
create_enum_history(gfc_symbol *sym, gfc_expr *init)
create_enum_history (gfc_symbol *sym, gfc_expr *init)
{
enumerator_history *new_enum_history;
gcc_assert (sym != NULL && init != NULL);
......@@ -837,7 +834,7 @@ create_enum_history(gfc_symbol *sym, gfc_expr *init)
/* Function to free enum kind history. */
void
gfc_free_enum_history(void)
gfc_free_enum_history (void)
{
enumerator_history *current = enum_history;
enumerator_history *next;
......@@ -857,8 +854,8 @@ gfc_free_enum_history(void)
expression to a symbol. */
static try
add_init_expr_to_sym (const char *name, gfc_expr ** initp,
locus * var_locus)
add_init_expr_to_sym (const char *name, gfc_expr **initp,
locus *var_locus)
{
symbol_attribute attr;
gfc_symbol *sym;
......@@ -905,9 +902,8 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
initializer. */
if (sym->attr.data)
{
gfc_error
("Variable '%s' at %C with an initializer already appears "
"in a DATA statement", sym->name);
gfc_error ("Variable '%s' at %C with an initializer already "
"appears in a DATA statement", sym->name);
return FAILURE;
}
......@@ -971,8 +967,8 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
being built. */
static try
build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
gfc_array_spec ** as)
build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
gfc_array_spec **as)
{
gfc_component *c;
......@@ -986,8 +982,7 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
return FAILURE;
}
if (gfc_current_block ()->attr.pointer
&& (*as)->rank != 0)
if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)
{
if ((*as)->type != AS_DEFERRED && (*as)->type != AS_EXPLICIT)
{
......@@ -1046,9 +1041,8 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
{
if (c->as->type != AS_EXPLICIT)
{
gfc_error
("Array component of structure at %C must have an explicit "
"shape");
gfc_error ("Array component of structure at %C must have an "
"explicit shape");
return FAILURE;
}
}
......@@ -1060,7 +1054,7 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
/* Match a 'NULL()', and possibly take care of some side effects. */
match
gfc_match_null (gfc_expr ** result)
gfc_match_null (gfc_expr **result)
{
gfc_symbol *sym;
gfc_expr *e;
......@@ -1298,7 +1292,6 @@ variable_decl (int elem)
{
if (gfc_match (" =>") == MATCH_YES)
{
if (!current_attr.pointer)
{
gfc_error ("Initialization at %C isn't for a pointer variable");
......@@ -1315,9 +1308,8 @@ variable_decl (int elem)
if (gfc_pure (NULL))
{
gfc_error
("Initialization of pointer at %C is not allowed in a "
"PURE procedure");
gfc_error ("Initialization of pointer at %C is not allowed in "
"a PURE procedure");
m = MATCH_ERROR;
}
......@@ -1329,8 +1321,8 @@ variable_decl (int elem)
{
if (current_attr.pointer)
{
gfc_error
("Pointer initialization at %C requires '=>', not '='");
gfc_error ("Pointer initialization at %C requires '=>', "
"not '='");
m = MATCH_ERROR;
goto cleanup;
}
......@@ -1344,9 +1336,8 @@ variable_decl (int elem)
if (current_attr.flavor != FL_PARAMETER && gfc_pure (NULL))
{
gfc_error
("Initialization of variable at %C is not allowed in a "
"PURE procedure");
gfc_error ("Initialization of variable at %C is not allowed in "
"a PURE procedure");
m = MATCH_ERROR;
}
......@@ -1358,7 +1349,8 @@ variable_decl (int elem)
if (initializer != NULL && current_attr.allocatable
&& gfc_current_state () == COMP_DERIVED)
{
gfc_error ("Initialization of allocatable component at %C is not allowed");
gfc_error ("Initialization of allocatable component at %C is not "
"allowed");
m = MATCH_ERROR;
goto cleanup;
}
......@@ -1395,8 +1387,7 @@ variable_decl (int elem)
else
{
if (current_ts.type == BT_DERIVED
&& !current_attr.pointer
&& !initializer)
&& !current_attr.pointer && !initializer)
initializer = gfc_default_initializer (&current_ts);
t = build_struct (name, cl, &initializer, &as);
}
......@@ -1415,7 +1406,7 @@ cleanup:
/* Match an extended-f77 kind specification. */
match
gfc_match_old_kind_spec (gfc_typespec * ts)
gfc_match_old_kind_spec (gfc_typespec *ts)
{
match m;
int original_kind;
......@@ -1461,7 +1452,7 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
string is found, then we know we have an error. */
match
gfc_match_kind_spec (gfc_typespec * ts)
gfc_match_kind_spec (gfc_typespec *ts)
{
locus where;
gfc_expr *e;
......@@ -1532,7 +1523,7 @@ no_match:
declaration. We don't return MATCH_NO. */
static match
match_char_spec (gfc_typespec * ts)
match_char_spec (gfc_typespec *ts)
{
int i, kind, seen_length;
gfc_charlen *cl;
......@@ -1584,7 +1575,7 @@ match_char_spec (gfc_typespec * ts)
goto rparen;
}
/* Try to match ( LEN = <len-param> ) or ( LEN = <len-param>, KIND = <int> ) */
/* Try to match "LEN = <len-param>" or "LEN = <len-param>, KIND = <int>" */
if (gfc_match (" len =") == MATCH_YES)
{
m = char_len_param_value (&len);
......@@ -1691,7 +1682,7 @@ done:
statement correctly. */
static match
match_type_spec (gfc_typespec * ts, int implicit_flag)
match_type_spec (gfc_typespec *ts, int implicit_flag)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
......@@ -1827,7 +1818,6 @@ get_kind:
match
gfc_match_implicit_none (void)
{
return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
}
......@@ -2053,8 +2043,7 @@ gfc_match_import (void)
return MATCH_ERROR;
}
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: IMPORT statement at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IMPORT statement at %C")
== FAILURE)
return MATCH_ERROR;
......@@ -2141,7 +2130,6 @@ syntax:
static match
match_attr_spec (void)
{
/* Modifiers that can exist in a type statement. */
typedef enum
{ GFC_DECL_BEGIN = 0,
......@@ -2326,10 +2314,9 @@ match_attr_spec (void)
{
if (d == DECL_ALLOCATABLE)
{
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: ALLOCATABLE "
"attribute at %C in a TYPE "
"definition") == FAILURE)
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
"attribute at %C in a TYPE definition")
== FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
......@@ -2409,8 +2396,8 @@ match_attr_spec (void)
break;
}
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: PROTECTED attribute at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED "
"attribute at %C")
== FAILURE)
t = FAILURE;
else
......@@ -2436,8 +2423,8 @@ match_attr_spec (void)
break;
case DECL_VALUE:
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VALUE attribute at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE attribute "
"at %C")
== FAILURE)
t = FAILURE;
else
......@@ -2574,7 +2561,7 @@ cleanup:
returned (the null string was matched). */
static match
match_prefix (gfc_typespec * ts)
match_prefix (gfc_typespec *ts)
{
int seen_type;
......@@ -2623,9 +2610,8 @@ loop:
/* Copy attributes matched by match_prefix() to attributes on a symbol. */
static try
copy_prefix (symbol_attribute * dest, locus * where)
copy_prefix (symbol_attribute *dest, locus *where)
{
if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE)
return FAILURE;
......@@ -2642,7 +2628,7 @@ copy_prefix (symbol_attribute * dest, locus * where)
/* Match a formal argument list. */
match
gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag)
gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
{
gfc_formal_arglist *head, *tail, *p, *q;
char name[GFC_MAX_SYMBOL_LEN + 1];
......@@ -2733,9 +2719,8 @@ ok:
for (q = p->next; q; q = q->next)
if (p->sym == q->sym)
{
gfc_error
("Duplicate symbol '%s' in formal argument list at %C",
p->sym->name);
gfc_error ("Duplicate symbol '%s' in formal argument list "
"at %C", p->sym->name);
m = MATCH_ERROR;
goto cleanup;
......@@ -2762,7 +2747,7 @@ cleanup:
ENTRY statement. Also matches the end-of-statement. */
static match
match_result (gfc_symbol * function, gfc_symbol ** result)
match_result (gfc_symbol * function, gfc_symbol **result)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *r;
......@@ -2783,8 +2768,7 @@ match_result (gfc_symbol * function, gfc_symbol ** result)
if (strcmp (function->name, name) == 0)
{
gfc_error
("RESULT variable at %C must be different than function name");
gfc_error ("RESULT variable at %C must be different than function name");
return MATCH_ERROR;
}
......@@ -2874,8 +2858,7 @@ gfc_match_function_decl (void)
|| copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
goto cleanup;
if (current_ts.type != BT_UNKNOWN
&& sym->ts.type != BT_UNKNOWN
if (current_ts.type != BT_UNKNOWN && sym->ts.type != BT_UNKNOWN
&& !sym->attr.implicit_type)
{
gfc_error ("Function '%s' at %C already has a type of %s", name,
......@@ -2901,19 +2884,21 @@ cleanup:
return m;
}
/* This is mostly a copy of parse.c(add_global_procedure) but modified to pass the
name of the entry, rather than the gfc_current_block name, and to return false
upon finding an existing global entry. */
/* This is mostly a copy of parse.c(add_global_procedure) but modified to
pass the name of the entry, rather than the gfc_current_block name, and
to return false upon finding an existing global entry. */
static bool
add_global_entry (const char * name, int sub)
add_global_entry (const char *name, int sub)
{
gfc_gsymbol *s;
s = gfc_get_gsymbol(name);
if (s->defined
|| (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
|| (s->type != GSYM_UNKNOWN
&& s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
global_used(s, NULL);
else
{
......@@ -2925,6 +2910,7 @@ add_global_entry (const char * name, int sub)
return false;
}
/* Match an ENTRY statement. */
match
......@@ -2956,42 +2942,40 @@ gfc_match_entry (void)
gfc_error ("ENTRY statement at %C cannot appear within a MODULE");
break;
case COMP_BLOCK_DATA:
gfc_error
("ENTRY statement at %C cannot appear within a BLOCK DATA");
gfc_error ("ENTRY statement at %C cannot appear within "
"a BLOCK DATA");
break;
case COMP_INTERFACE:
gfc_error
("ENTRY statement at %C cannot appear within an INTERFACE");
gfc_error ("ENTRY statement at %C cannot appear within "
"an INTERFACE");
break;
case COMP_DERIVED:
gfc_error
("ENTRY statement at %C cannot appear "
"within a DERIVED TYPE block");
gfc_error ("ENTRY statement at %C cannot appear within "
"a DERIVED TYPE block");
break;
case COMP_IF:
gfc_error
("ENTRY statement at %C cannot appear within an IF-THEN block");
gfc_error ("ENTRY statement at %C cannot appear within "
"an IF-THEN block");
break;
case COMP_DO:
gfc_error
("ENTRY statement at %C cannot appear within a DO block");
gfc_error ("ENTRY statement at %C cannot appear within "
"a DO block");
break;
case COMP_SELECT:
gfc_error
("ENTRY statement at %C cannot appear within a SELECT block");
gfc_error ("ENTRY statement at %C cannot appear within "
"a SELECT block");
break;
case COMP_FORALL:
gfc_error
("ENTRY statement at %C cannot appear within a FORALL block");
gfc_error ("ENTRY statement at %C cannot appear within "
"a FORALL block");
break;
case COMP_WHERE:
gfc_error
("ENTRY statement at %C cannot appear within a WHERE block");
gfc_error ("ENTRY statement at %C cannot appear within "
"a WHERE block");
break;
case COMP_CONTAINS:
gfc_error
("ENTRY statement at %C cannot appear "
"within a contained subprogram");
gfc_error ("ENTRY statement at %C cannot appear within "
"a contained subprogram");
break;
default:
gfc_internal_error ("gfc_match_entry(): Bad state");
......@@ -3001,7 +2985,8 @@ gfc_match_entry (void)
module_procedure = gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
&& gfc_current_ns->parent->proc_name->attr.flavor == FL_MODULE;
&& gfc_current_ns->parent->proc_name->attr.flavor
== FL_MODULE;
if (gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
......@@ -3085,8 +3070,8 @@ gfc_match_entry (void)
if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
|| gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
|| gfc_add_function (&entry->attr, result->name,
NULL) == FAILURE)
|| gfc_add_function (&entry->attr, result->name, NULL)
== FAILURE)
return MATCH_ERROR;
entry->result = result;
......@@ -3179,8 +3164,7 @@ contained_procedure (void)
for (s=gfc_state_stack; s; s=s->previous)
if ((s->state == COMP_SUBROUTINE || s->state == COMP_FUNCTION)
&& s->previous != NULL
&& s->previous->state == COMP_CONTAINS)
&& s->previous != NULL && s->previous->state == COMP_CONTAINS)
return 1;
return 0;
......@@ -3220,12 +3204,13 @@ set_enum_kind(void)
}
}
/* Match any of the various end-block statements. Returns the type of
END to the caller. The END INTERFACE, END IF, END DO and END
SELECT statements cannot be replaced by a single END statement. */
match
gfc_match_end (gfc_statement * st)
gfc_match_end (gfc_statement *st)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_compile_state state;
......@@ -3240,14 +3225,14 @@ gfc_match_end (gfc_statement * st)
return MATCH_NO;
state = gfc_current_state ();
block_name =
gfc_current_block () == NULL ? NULL : gfc_current_block ()->name;
block_name = gfc_current_block () == NULL
? NULL : gfc_current_block ()->name;
if (state == COMP_CONTAINS)
{
state = gfc_state_stack->previous->state;
block_name = gfc_state_stack->previous->sym == NULL ? NULL
: gfc_state_stack->previous->sym->name;
block_name = gfc_state_stack->previous->sym == NULL
? NULL : gfc_state_stack->previous->sym->name;
}
switch (state)
......@@ -3448,9 +3433,8 @@ attr_decl1 (void)
if (current_attr.dimension && m == MATCH_NO)
{
gfc_error
("Missing array specification at %L in DIMENSION statement",
&var_locus);
gfc_error ("Missing array specification at %L in DIMENSION "
"statement", &var_locus);
m = MATCH_ERROR;
goto cleanup;
}
......@@ -3458,14 +3442,14 @@ attr_decl1 (void)
if ((current_attr.allocatable || current_attr.pointer)
&& (m == MATCH_YES) && (as->type != AS_DEFERRED))
{
gfc_error ("Array specification must be deferred at %L",
&var_locus);
gfc_error ("Array specification must be deferred at %L", &var_locus);
m = MATCH_ERROR;
goto cleanup;
}
}
/* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */
/* Update symbol table. DIMENSION attribute is set
in gfc_set_array_spec(). */
if (current_attr.dimension == 0
&& gfc_copy_attr (&sym->attr, &current_attr, NULL) == FAILURE)
{
......@@ -3608,8 +3592,7 @@ cray_pointer_decl (void)
else if (cptr->ts.kind < gfc_index_integer_kind)
gfc_warning ("Cray pointer at %C has %d bytes of precision;"
" memory addresses require %d bytes",
cptr->ts.kind,
gfc_index_integer_kind);
cptr->ts.kind, gfc_index_integer_kind);
if (gfc_match_char (',') != MATCH_YES)
{
......@@ -3706,7 +3689,6 @@ gfc_match_external (void)
}
match
gfc_match_intent (void)
{
......@@ -3753,8 +3735,8 @@ gfc_match_pointer (void)
{
if (!gfc_option.flag_cray_pointer)
{
gfc_error ("Cray pointer declaration at %C requires -fcray-pointer"
" flag");
gfc_error ("Cray pointer declaration at %C requires -fcray-pointer "
"flag");
return MATCH_ERROR;
}
return cray_pointer_decl ();
......@@ -3772,7 +3754,6 @@ gfc_match_pointer (void)
match
gfc_match_allocatable (void)
{
gfc_clear_attr (&current_attr);
current_attr.allocatable = 1;
......@@ -3783,7 +3764,6 @@ gfc_match_allocatable (void)
match
gfc_match_dimension (void)
{
gfc_clear_attr (&current_attr);
current_attr.dimension = 1;
......@@ -3794,7 +3774,6 @@ gfc_match_dimension (void)
match
gfc_match_target (void)
{
gfc_clear_attr (&current_attr);
current_attr.target = 1;
......@@ -3835,9 +3814,8 @@ access_attr_decl (gfc_statement st)
if (gfc_get_symbol (name, NULL, &sym))
goto done;
if (gfc_add_access (&sym->attr,
(st ==
ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE,
if (gfc_add_access (&sym->attr, (st == ST_PUBLIC)
? ACCESS_PUBLIC : ACCESS_PRIVATE,
sym->name, NULL) == FAILURE)
return MATCH_ERROR;
......@@ -3863,14 +3841,13 @@ access_attr_decl (gfc_statement st)
if (uop->access == ACCESS_UNKNOWN)
{
uop->access =
(st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
uop->access = (st == ST_PUBLIC)
? ACCESS_PUBLIC : ACCESS_PRIVATE;
}
else
{
gfc_error
("Access specification of the .%s. operator at %C has "
"already been specified", sym->name);
gfc_error ("Access specification of the .%s. operator at %C "
"has already been specified", sym->name);
goto done;
}
......@@ -3907,8 +3884,7 @@ gfc_match_protected (void)
}
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: PROTECTED statement at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED statement at %C")
== FAILURE)
return MATCH_ERROR;
......@@ -3926,8 +3902,8 @@ gfc_match_protected (void)
switch (m)
{
case MATCH_YES:
if (gfc_add_protected (&sym->attr, sym->name,
&gfc_current_locus) == FAILURE)
if (gfc_add_protected (&sym->attr, sym->name, &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
goto next_item;
......@@ -3953,13 +3929,12 @@ syntax:
}
/* The PRIVATE statement is a bit weird in that it can be a attribute
declaration, but also works as a standlone statement inside of a
type declaration or a module. */
match
gfc_match_private (gfc_statement * st)
gfc_match_private (gfc_statement *st)
{
if (gfc_match ("private") != MATCH_YES)
......@@ -3989,7 +3964,7 @@ gfc_match_private (gfc_statement * st)
match
gfc_match_public (gfc_statement * st)
gfc_match_public (gfc_statement *st)
{
if (gfc_match ("public") != MATCH_YES)
......@@ -4112,9 +4087,8 @@ gfc_match_save (void)
{
if (gfc_current_ns->seen_save)
{
if (gfc_notify_std (GFC_STD_LEGACY,
"Blanket SAVE statement at %C follows previous "
"SAVE statement")
if (gfc_notify_std (GFC_STD_LEGACY, "Blanket SAVE statement at %C "
"follows previous SAVE statement")
== FAILURE)
return MATCH_ERROR;
}
......@@ -4125,8 +4099,8 @@ gfc_match_save (void)
if (gfc_current_ns->save_all)
{
if (gfc_notify_std (GFC_STD_LEGACY,
"SAVE statement at %C follows blanket SAVE statement")
if (gfc_notify_std (GFC_STD_LEGACY, "SAVE statement at %C follows "
"blanket SAVE statement")
== FAILURE)
return MATCH_ERROR;
}
......@@ -4139,8 +4113,8 @@ gfc_match_save (void)
switch (m)
{
case MATCH_YES:
if (gfc_add_save (&sym->attr, sym->name,
&gfc_current_locus) == FAILURE)
if (gfc_add_save (&sym->attr, sym->name, &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
goto next_item;
......@@ -4183,8 +4157,7 @@ gfc_match_value (void)
gfc_symbol *sym;
match m;
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VALUE statement at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE statement at %C")
== FAILURE)
return MATCH_ERROR;
......@@ -4202,8 +4175,8 @@ gfc_match_value (void)
switch (m)
{
case MATCH_YES:
if (gfc_add_value (&sym->attr, sym->name,
&gfc_current_locus) == FAILURE)
if (gfc_add_value (&sym->attr, sym->name, &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
goto next_item;
......@@ -4234,8 +4207,7 @@ gfc_match_volatile (void)
gfc_symbol *sym;
match m;
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: VOLATILE statement at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VOLATILE statement at %C")
== FAILURE)
return MATCH_ERROR;
......@@ -4253,8 +4225,8 @@ gfc_match_volatile (void)
switch (m)
{
case MATCH_YES:
if (gfc_add_volatile (&sym->attr, sym->name,
&gfc_current_locus) == FAILURE)
if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
== FAILURE)
return MATCH_ERROR;
goto next_item;
......@@ -4296,8 +4268,8 @@ gfc_match_modproc (void)
|| gfc_state_stack->previous == NULL
|| current_interface.type == INTERFACE_NAMELESS)
{
gfc_error
("MODULE PROCEDURE at %C must be in a generic module interface");
gfc_error ("MODULE PROCEDURE at %C must be in a generic module "
"interface");
return MATCH_ERROR;
}
......@@ -4358,8 +4330,7 @@ loop:
{
if (gfc_find_state (COMP_MODULE) == FAILURE)
{
gfc_error
("Derived type at %C can only be PRIVATE within a MODULE");
gfc_error ("Derived type at %C can only be PRIVATE within a MODULE");
return MATCH_ERROR;
}
......@@ -4399,9 +4370,8 @@ loop:
|| strcmp (name, "logical") == 0
|| strcmp (name, "complex") == 0)
{
gfc_error
("Type name '%s' at %C cannot be the same as an intrinsic type",
name);
gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
"type", name);
return MATCH_ERROR;
}
......@@ -4426,9 +4396,8 @@ loop:
if (sym->components != NULL)
{
gfc_error
("Derived type definition of '%s' at %C has already been defined",
sym->name);
gfc_error ("Derived type definition of '%s' at %C has already been "
"defined", sym->name);
return MATCH_ERROR;
}
......@@ -4481,8 +4450,7 @@ gfc_match_enum (void)
if (m != MATCH_YES)
return m;
if (gfc_notify_std (GFC_STD_F2003,
"Fortran 2003: ENUM AND ENUMERATOR at %C")
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM AND ENUMERATOR at %C")
== FAILURE)
return MATCH_ERROR;
......
gcc/fortran/dependency.c
/* Dependency analysis
Copyright (C) 2000, 2001, 2002, 2005, 2006 Free Software Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of GCC.
......@@ -24,7 +25,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
have different dependency checking functions for different types
if dependencies. Ideally these would probably be merged. */
#include "config.h"
#include "gfortran.h"
#include "dependency.h"
......@@ -52,7 +52,7 @@ gfc_dependency;
def if the value could not be determined. */
int
gfc_expr_is_one (gfc_expr * expr, int def)
gfc_expr_is_one (gfc_expr *expr, int def)
{
gcc_assert (expr != NULL);
......@@ -70,7 +70,7 @@ gfc_expr_is_one (gfc_expr * expr, int def)
and -2 if the relationship could not be determined. */
int
gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
{
gfc_actual_arglist *args1;
gfc_actual_arglist *args2;
......@@ -85,8 +85,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
|| e2->value.op.operator == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1, e2->value.op.op1);
if (e1->expr_type == EXPR_OP
&& e1->value.op.operator == INTRINSIC_PLUS)
if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_PLUS)
{
/* Compare X+C vs. X. */
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
......@@ -95,8 +94,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
return mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P+Q vs. R+S. */
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == INTRINSIC_PLUS)
if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS)
{
int l, r;
......@@ -129,8 +127,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X vs. X+C. */
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == INTRINSIC_PLUS)
if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
......@@ -139,8 +136,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X-C vs. X. */
if (e1->expr_type == EXPR_OP
&& e1->value.op.operator == INTRINSIC_MINUS)
if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_MINUS)
{
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
&& e1->value.op.op2->ts.type == BT_INTEGER
......@@ -148,8 +144,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
return -mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P-Q vs. R-S. */
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == INTRINSIC_MINUS)
if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS)
{
int l, r;
......@@ -169,8 +164,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X vs. X-C. */
if (e2->expr_type == EXPR_OP
&& e2->value.op.operator == INTRINSIC_MINUS)
if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
......@@ -218,8 +212,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
case EXPR_FUNCTION:
/* We can only compare calls to the same intrinsic function. */
if (e1->value.function.isym == 0
|| e2->value.function.isym == 0
if (e1->value.function.isym == 0 || e2->value.function.isym == 0
|| e1->value.function.isym != e2->value.function.isym)
return -2;
......@@ -275,7 +268,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
if the results are indeterminate. N is the dimension to compare. */
int
gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
{
gfc_expr *e1;
gfc_expr *e2;
......@@ -375,7 +368,7 @@ gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
whose data can be reused, otherwise return NULL. */
gfc_expr *
gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
{
if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
return NULL;
......@@ -439,8 +432,8 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
temporary. */
static int
gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
gfc_expr * expr)
gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
gfc_expr *expr)
{
gcc_assert (var->expr_type == EXPR_VARIABLE);
gcc_assert (var->rank > 0);
......@@ -472,8 +465,8 @@ gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
array expression OTHER, not just variables. */
static int
gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
gfc_expr * expr)
gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
gfc_expr *expr)
{
switch (other->expr_type)
{
......@@ -498,8 +491,8 @@ gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
FNSYM is the function being called, or NULL if not known. */
int
gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
gfc_symbol * fnsym, gfc_actual_arglist * actual)
gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
gfc_symbol *fnsym, gfc_actual_arglist *actual)
{
gfc_formal_arglist *formal;
gfc_expr *expr;
......@@ -518,8 +511,7 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
continue;
/* Skip intent(in) arguments if OTHER itself is intent(in). */
if (formal
&& intent == INTENT_IN
if (formal && intent == INTENT_IN
&& formal->sym->attr.intent == INTENT_IN)
continue;
......@@ -553,9 +545,7 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
&& e2->expr_type == EXPR_VARIABLE);
if (!e1->symtree->n.sym->attr.in_equivalence
|| !e2->symtree->n.sym->attr.in_equivalence
|| !e1->rank
|| !e2->rank)
|| !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
return 0;
/* Go through the equiv_lists and return 1 if the variables
......@@ -607,7 +597,7 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
temporary. */
int
gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
{
gfc_ref *ref;
int n;
......@@ -637,13 +627,10 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
return 1;
/* Symbols can only alias if they have the same type. */
if (ts1->type != BT_UNKNOWN
&& ts2->type != BT_UNKNOWN
&& ts1->type != BT_DERIVED
&& ts2->type != BT_DERIVED)
if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
&& ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
{
if (ts1->type != ts2->type
|| ts1->kind != ts2->kind)
if (ts1->type != ts2->type || ts1->kind != ts2->kind)
return 0;
}
......@@ -710,7 +697,7 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
/* Determines overlapping for two array sections. */
static gfc_dependency
gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref l_ar;
gfc_expr *l_start;
......@@ -874,7 +861,7 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
/* Determines overlapping for a single element and a section. */
static gfc_dependency
gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref *ref;
gfc_expr *elem;
......@@ -999,7 +986,7 @@ gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
return true, and assume a dependency. */
static bool
contains_forall_index_p (gfc_expr * expr)
contains_forall_index_p (gfc_expr *expr)
{
gfc_actual_arglist *arg;
gfc_constructor *c;
......@@ -1074,7 +1061,7 @@ contains_forall_index_p (gfc_expr * expr)
/* Determines overlapping for two single element array references. */
static gfc_dependency
gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref l_ar;
gfc_array_ref r_ar;
......@@ -1099,8 +1086,7 @@ gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
/* However, we need to be careful when either scalar expression
contains a FORALL index, as these can potentially change value
during the scalarization/traversal of this array reference. */
if (contains_forall_index_p (r_start)
|| contains_forall_index_p (l_start))
if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
return GFC_DEP_OVERLAP;
if (i != -2)
......@@ -1141,8 +1127,7 @@ gfc_full_array_ref_p (gfc_ref *ref)
ref->u.ar.as->upper[i])))
return false;
/* Check the stride. */
if (ref->u.ar.stride[i]
&& !gfc_expr_is_one (ref->u.ar.stride[i], 0))
if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
......@@ -1155,13 +1140,12 @@ gfc_full_array_ref_p (gfc_ref *ref)
0 : array references are identical or not overlapping. */
int
gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref)
{
int n;
gfc_dependency fin_dep;
gfc_dependency this_dep;
fin_dep = GFC_DEP_ERROR;
/* Dependencies due to pointers should already have been identified.
We only need to check for overlapping array references. */
......
gcc/fortran/dump-parse-tree.c
/* Parse tree dumper
Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
Copyright (C) 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Steven Bosscher
This file is part of GCC.
......@@ -40,7 +41,7 @@ static int show_level = 0;
/* Do indentation for a specific level. */
static inline void
code_indent (int level, gfc_st_label * label)
code_indent (int level, gfc_st_label *label)
{
int i;
......@@ -68,9 +69,8 @@ show_indent (void)
/* Show type-specific information. */
void
gfc_show_typespec (gfc_typespec * ts)
gfc_show_typespec (gfc_typespec *ts)
{
gfc_status ("(%s ", gfc_basic_typename (ts->type));
switch (ts->type)
......@@ -95,9 +95,8 @@ gfc_show_typespec (gfc_typespec * ts)
/* Show an actual argument list. */
void
gfc_show_actual_arglist (gfc_actual_arglist * a)
gfc_show_actual_arglist (gfc_actual_arglist *a)
{
gfc_status ("(");
for (; a; a = a->next)
......@@ -122,7 +121,7 @@ gfc_show_actual_arglist (gfc_actual_arglist * a)
/* Show a gfc_array_spec array specification structure. */
void
gfc_show_array_spec (gfc_array_spec * as)
gfc_show_array_spec (gfc_array_spec *as)
{
const char *c;
int i;
......@@ -144,8 +143,8 @@ gfc_show_array_spec (gfc_array_spec * as)
case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
default:
gfc_internal_error
("gfc_show_array_spec(): Unhandled array shape type.");
gfc_internal_error ("gfc_show_array_spec(): Unhandled array shape "
"type.");
}
gfc_status (" %s ", c);
......@@ -233,9 +232,8 @@ gfc_show_array_ref (gfc_array_ref * ar)
/* Show a list of gfc_ref structures. */
void
gfc_show_ref (gfc_ref * p)
gfc_show_ref (gfc_ref *p)
{
for (; p; p = p->next)
switch (p->type)
{
......@@ -264,9 +262,8 @@ gfc_show_ref (gfc_ref * p)
/* Display a constructor. Works recursively for array constructors. */
void
gfc_show_constructor (gfc_constructor * c)
gfc_show_constructor (gfc_constructor *c)
{
for (; c; c = c->next)
{
if (c->iterator == NULL)
......@@ -297,7 +294,7 @@ gfc_show_constructor (gfc_constructor * c)
/* Show an expression. */
void
gfc_show_expr (gfc_expr * p)
gfc_show_expr (gfc_expr *p)
{
const char *c;
int i;
......@@ -530,7 +527,7 @@ gfc_show_expr (gfc_expr * p)
whatever single bit attributes are present. */
void
gfc_show_attr (symbol_attribute * attr)
gfc_show_attr (symbol_attribute *attr)
{
gfc_status ("(%s %s %s %s", gfc_code2string (flavors, attr->flavor),
......@@ -601,7 +598,7 @@ gfc_show_attr (symbol_attribute * attr)
/* Show components of a derived type. */
void
gfc_show_components (gfc_symbol * sym)
gfc_show_components (gfc_symbol *sym)
{
gfc_component *c;
......@@ -628,7 +625,7 @@ gfc_show_components (gfc_symbol * sym)
that symbol. */
void
gfc_show_symbol (gfc_symbol * sym)
gfc_show_symbol (gfc_symbol *sym)
{
gfc_formal_arglist *formal;
gfc_interface *intr;
......@@ -706,7 +703,7 @@ gfc_show_symbol (gfc_symbol * sym)
and the name of the associated subroutine, really. */
static void
show_uop (gfc_user_op * uop)
show_uop (gfc_user_op *uop)
{
gfc_interface *intr;
......@@ -721,9 +718,8 @@ show_uop (gfc_user_op * uop)
/* Workhorse function for traversing the user operator symtree. */
static void
traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
{
if (st == NULL)
return;
......@@ -737,9 +733,8 @@ traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
/* Traverse the tree of user operator nodes. */
void
gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
{
traverse_uop (ns->uop_root, func);
}
......@@ -747,7 +742,7 @@ gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
/* Function to display a common block. */
static void
show_common (gfc_symtree * st)
show_common (gfc_symtree *st)
{
gfc_symbol *s;
......@@ -769,9 +764,8 @@ show_common (gfc_symtree * st)
/* Worker function to display the symbol tree. */
static void
show_symtree (gfc_symtree * st)
show_symtree (gfc_symtree *st)
{
show_indent ();
gfc_status ("symtree: %s Ambig %d", st->name, st->ambiguous);
......@@ -786,15 +780,14 @@ show_symtree (gfc_symtree * st)
static void gfc_show_code_node (int level, gfc_code * c);
static void gfc_show_code_node (int, gfc_code *);
/* Show a list of code structures. Mutually recursive with
gfc_show_code_node(). */
void
gfc_show_code (int level, gfc_code * c)
gfc_show_code (int level, gfc_code *c)
{
for (; c; c = c->next)
gfc_show_code_node (level, c);
}
......@@ -811,7 +804,7 @@ gfc_show_namelist (gfc_namelist *n)
if necessary. */
static void
gfc_show_omp_node (int level, gfc_code * c)
gfc_show_omp_node (int level, gfc_code *c)
{
gfc_omp_clauses *omp_clauses = NULL;
const char *name = NULL;
......@@ -996,10 +989,11 @@ gfc_show_omp_node (int level, gfc_code * c)
gfc_status (" (%s)", c->ext.omp_name);
}
/* Show a single code node and everything underneath it if necessary. */
static void
gfc_show_code_node (int level, gfc_code * c)
gfc_show_code_node (int level, gfc_code *c)
{
gfc_forall_iterator *fa;
gfc_open *open;
......@@ -1709,7 +1703,7 @@ gfc_show_equiv (gfc_equiv *eq)
/* Show a freakin' whole namespace. */
void
gfc_show_namespace (gfc_namespace * ns)
gfc_show_namespace (gfc_namespace *ns)
{
gfc_interface *intr;
gfc_namespace *save;
......
gcc/fortran/error.c
/* Handle errors.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught & Niels Kristian Bech Jensen
This file is part of GCC.
......@@ -69,11 +69,9 @@ error_char (char c)
{
if (cur_error_buffer->index >= cur_error_buffer->allocated)
{
cur_error_buffer->allocated =
cur_error_buffer->allocated
cur_error_buffer->allocated = cur_error_buffer->allocated
? cur_error_buffer->allocated * 2 : 1000;
cur_error_buffer->message
= xrealloc (cur_error_buffer->message,
cur_error_buffer->message = xrealloc (cur_error_buffer->message,
cur_error_buffer->allocated);
}
cur_error_buffer->message[cur_error_buffer->index++] = c;
......@@ -152,7 +150,7 @@ error_integer (int i)
static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
static void
show_locus (locus * loc, int c1, int c2)
show_locus (locus *loc, int c1, int c2)
{
gfc_linebuf *lb;
gfc_file *f;
......@@ -308,7 +306,7 @@ show_locus (locus * loc, int c1, int c2)
loci may or may not be on the same source line. */
static void
show_loci (locus * l1, locus * l2)
show_loci (locus *l1, locus *l2)
{
int m, c1, c2;
......@@ -349,7 +347,6 @@ show_loci (locus * l1, locus * l2)
show_locus (l1, c1, c2);
return;
}
......@@ -545,10 +542,10 @@ error_print (const char *type, const char *format0, va_list argp)
}
format++;
if (ISDIGIT(*format))
if (ISDIGIT (*format))
{
/* This is a position specifier. See comment above. */
while (ISDIGIT(*format))
while (ISDIGIT (*format))
format++;
/* Skip over the dollar sign. */
......@@ -663,10 +660,8 @@ gfc_notify_std (int std, const char *nocmsgid, ...)
va_list argp;
bool warning;
warning = ((gfc_option.warn_std & std) != 0)
&& !inhibit_warnings;
if ((gfc_option.allow_std & std) != 0
&& !warning)
warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
if ((gfc_option.allow_std & std) != 0 && !warning)
return SUCCESS;
if (gfc_suppress_error)
......@@ -889,7 +884,7 @@ gfc_error_check (void)
/* Save the existing error state. */
void
gfc_push_error (gfc_error_buf * err)
gfc_push_error (gfc_error_buf *err)
{
err->flag = error_buffer.flag;
if (error_buffer.flag)
......@@ -902,7 +897,7 @@ gfc_push_error (gfc_error_buf * err)
/* Restore a previous pushed error state. */
void
gfc_pop_error (gfc_error_buf * err)
gfc_pop_error (gfc_error_buf *err)
{
error_buffer.flag = err->flag;
if (error_buffer.flag)
......@@ -918,7 +913,7 @@ gfc_pop_error (gfc_error_buf * err)
/* Free a pushed error state, but keep the current error state. */
void
gfc_free_error (gfc_error_buf * err)
gfc_free_error (gfc_error_buf *err)
{
if (err->flag)
gfc_free (err->message);
......
gcc/fortran/expr.c
/* Routines for manipulation of expression nodes.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
Foundation, Inc.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
......@@ -34,7 +34,6 @@ gfc_get_expr (void)
gfc_expr *e;
e = gfc_getmem (sizeof (gfc_expr));
gfc_clear_ts (&e->ts);
e->shape = NULL;
e->ref = NULL;
......@@ -47,7 +46,7 @@ gfc_get_expr (void)
/* Free an argument list and everything below it. */
void
gfc_free_actual_arglist (gfc_actual_arglist * a1)
gfc_free_actual_arglist (gfc_actual_arglist *a1)
{
gfc_actual_arglist *a2;
......@@ -64,7 +63,7 @@ gfc_free_actual_arglist (gfc_actual_arglist * a1)
/* Copy an arglist structure and all of the arguments. */
gfc_actual_arglist *
gfc_copy_actual_arglist (gfc_actual_arglist * p)
gfc_copy_actual_arglist (gfc_actual_arglist *p)
{
gfc_actual_arglist *head, *tail, *new;
......@@ -93,7 +92,7 @@ gfc_copy_actual_arglist (gfc_actual_arglist * p)
/* Free a list of reference structures. */
void
gfc_free_ref_list (gfc_ref * p)
gfc_free_ref_list (gfc_ref *p)
{
gfc_ref *q;
int i;
......@@ -134,7 +133,7 @@ gfc_free_ref_list (gfc_ref * p)
something else or the expression node belongs to another structure. */
static void
free_expr0 (gfc_expr * e)
free_expr0 (gfc_expr *e)
{
int n;
......@@ -221,9 +220,8 @@ free_expr0 (gfc_expr * e)
/* Free an expression node and everything beneath it. */
void
gfc_free_expr (gfc_expr * e)
gfc_free_expr (gfc_expr *e)
{
if (e == NULL)
return;
if (e->con_by_offset)
......@@ -236,12 +234,10 @@ gfc_free_expr (gfc_expr * e)
/* Graft the *src expression onto the *dest subexpression. */
void
gfc_replace_expr (gfc_expr * dest, gfc_expr * src)
gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
{
free_expr0 (dest);
*dest = *src;
gfc_free (src);
}
......@@ -252,9 +248,8 @@ gfc_replace_expr (gfc_expr * dest, gfc_expr * src)
failure is OK for some callers. */
const char *
gfc_extract_int (gfc_expr * expr, int *result)
gfc_extract_int (gfc_expr *expr, int *result)
{
if (expr->expr_type != EXPR_CONSTANT)
return _("Constant expression required at %C");
......@@ -276,7 +271,7 @@ gfc_extract_int (gfc_expr * expr, int *result)
/* Recursively copy a list of reference structures. */
static gfc_ref *
copy_ref (gfc_ref * src)
copy_ref (gfc_ref *src)
{
gfc_array_ref *ar;
gfc_ref *dest;
......@@ -312,13 +307,12 @@ copy_ref (gfc_ref * src)
}
/* Detect whether an expression has any vector index array
references. */
/* Detect whether an expression has any vector index array references. */
int
gfc_has_vector_index (gfc_expr *e)
{
gfc_ref * ref;
gfc_ref *ref;
int i;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY)
......@@ -332,7 +326,7 @@ gfc_has_vector_index (gfc_expr *e)
/* Copy a shape array. */
mpz_t *
gfc_copy_shape (mpz_t * shape, int rank)
gfc_copy_shape (mpz_t *shape, int rank)
{
mpz_t *new_shape;
int n;
......@@ -363,7 +357,7 @@ gfc_copy_shape (mpz_t * shape, int rank)
*/
mpz_t *
gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim)
{
mpz_t *new_shape, *s;
int i, n;
......@@ -380,7 +374,7 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
if (n < 0 || n >= rank)
return NULL;
s = new_shape = gfc_get_shape (rank-1);
s = new_shape = gfc_get_shape (rank - 1);
for (i = 0; i < rank; i++)
{
......@@ -393,11 +387,12 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
return new_shape;
}
/* Given an expression pointer, return a copy of the expression. This
subroutine is recursive. */
gfc_expr *
gfc_copy_expr (gfc_expr * p)
gfc_copy_expr (gfc_expr *p)
{
gfc_expr *q;
char *s;
......@@ -423,8 +418,7 @@ gfc_copy_expr (gfc_expr * p)
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
memcpy (s, p->value.character.string,
p->value.character.length + 1);
memcpy (s, p->value.character.string, p->value.character.length + 1);
break;
}
switch (q->ts.type)
......@@ -452,8 +446,7 @@ gfc_copy_expr (gfc_expr * p)
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
memcpy (s, p->value.character.string,
p->value.character.length + 1);
memcpy (s, p->value.character.string, p->value.character.length + 1);
break;
case BT_LOGICAL:
......@@ -512,9 +505,8 @@ gfc_copy_expr (gfc_expr * p)
kind numbers mean more precision for numeric types. */
int
gfc_kind_max (gfc_expr * e1, gfc_expr * e2)
gfc_kind_max (gfc_expr *e1, gfc_expr *e2)
{
return (e1->ts.kind > e2->ts.kind) ? e1->ts.kind : e2->ts.kind;
}
......@@ -524,7 +516,6 @@ gfc_kind_max (gfc_expr * e1, gfc_expr * e2)
static int
numeric_type (bt type)
{
return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER;
}
......@@ -532,9 +523,8 @@ numeric_type (bt type)
/* Returns nonzero if the typespec is a numeric type, zero otherwise. */
int
gfc_numeric_ts (gfc_typespec * ts)
gfc_numeric_ts (gfc_typespec *ts)
{
return numeric_type (ts->type);
}
......@@ -562,7 +552,7 @@ gfc_int_expr (int i)
/* Returns an expression node that is a logical constant. */
gfc_expr *
gfc_logical_expr (int i, locus * where)
gfc_logical_expr (int i, locus *where)
{
gfc_expr *p;
......@@ -586,7 +576,7 @@ gfc_logical_expr (int i, locus * where)
argument list with a NULL pointer terminating the list. */
gfc_expr *
gfc_build_conversion (gfc_expr * e)
gfc_build_conversion (gfc_expr *e)
{
gfc_expr *p;
......@@ -612,7 +602,7 @@ gfc_build_conversion (gfc_expr * e)
1.0**2 stays as it is. */
void
gfc_type_convert_binary (gfc_expr * e)
gfc_type_convert_binary (gfc_expr *e)
{
gfc_expr *op1, *op2;
......@@ -628,7 +618,6 @@ gfc_type_convert_binary (gfc_expr * e)
/* Kind conversions of same type. */
if (op1->ts.type == op2->ts.type)
{
if (op1->ts.kind == op2->ts.kind)
{
/* No type conversions. */
......@@ -685,7 +674,7 @@ done:
function expects that the expression has already been simplified. */
int
gfc_is_constant_expr (gfc_expr * e)
gfc_is_constant_expr (gfc_expr *e)
{
gfc_constructor *c;
gfc_actual_arglist *arg;
......@@ -757,7 +746,7 @@ gfc_is_constant_expr (gfc_expr * e)
/* Try to collapse intrinsic expressions. */
static try
simplify_intrinsic_op (gfc_expr * p, int type)
simplify_intrinsic_op (gfc_expr *p, int type)
{
gfc_expr *op1, *op2, *result;
......@@ -882,9 +871,8 @@ simplify_intrinsic_op (gfc_expr * p, int type)
with gfc_simplify_expr(). */
static try
simplify_constructor (gfc_constructor * c, int type)
simplify_constructor (gfc_constructor *c, int type)
{
for (; c; c = c->next)
{
if (c->iterator
......@@ -904,8 +892,8 @@ simplify_constructor (gfc_constructor * c, int type)
/* Pull a single array element out of an array constructor. */
static try
find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
gfc_constructor ** rval)
find_array_element (gfc_constructor *cons, gfc_array_ref *ar,
gfc_constructor **rval)
{
unsigned long nelemen;
int i;
......@@ -930,8 +918,7 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
/* Check the bounds. */
if (ar->as->upper[i]
&& (mpz_cmp (e->value.integer,
ar->as->upper[i]->value.integer) > 0
&& (mpz_cmp (e->value.integer, ar->as->upper[i]->value.integer) > 0
|| mpz_cmp (e->value.integer,
ar->as->lower[i]->value.integer) < 0))
{
......@@ -942,8 +929,7 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
goto depart;
}
mpz_sub (delta, e->value.integer,
ar->as->lower[i]->value.integer);
mpz_sub (delta, e->value.integer, ar->as->lower[i]->value.integer);
mpz_add (offset, offset, delta);
}
......@@ -973,7 +959,7 @@ depart:
/* Find a component of a structure constructor. */
static gfc_constructor *
find_component_ref (gfc_constructor * cons, gfc_ref * ref)
find_component_ref (gfc_constructor *cons, gfc_ref *ref)
{
gfc_component *comp;
gfc_component *pick;
......@@ -994,7 +980,7 @@ find_component_ref (gfc_constructor * cons, gfc_ref * ref)
the subobject reference in the process. */
static void
remove_subobject_ref (gfc_expr * p, gfc_constructor * cons)
remove_subobject_ref (gfc_expr *p, gfc_constructor *cons)
{
gfc_expr *e;
......@@ -1076,10 +1062,10 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */
{
gcc_assert(begin);
gcc_assert(begin->expr_type == EXPR_ARRAY);
gcc_assert(begin->rank == 1);
gcc_assert(begin->shape);
gcc_assert (begin);
gcc_assert (begin->expr_type == EXPR_ARRAY);
gcc_assert (begin->rank == 1);
gcc_assert (begin->shape);
vecsub[d] = begin->value.constructor;
mpz_set (ctr[d], vecsub[d]->expr->value.integer);
......@@ -1090,7 +1076,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
for (c = vecsub[d]; c; c = c->next)
{
if (mpz_cmp (c->expr->value.integer, upper->value.integer) > 0
|| mpz_cmp (c->expr->value.integer, lower->value.integer) < 0)
|| mpz_cmp (c->expr->value.integer,
lower->value.integer) < 0)
{
gfc_error ("index in dimension %d is out of bounds "
"at %L", d + 1, &ref->u.ar.c_where[d]);
......@@ -1157,8 +1144,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
mpz_div (tmp_mpz, tmp_mpz, stride[d]);
mpz_mul (nelts, nelts, tmp_mpz);
/* An element reference reduces the rank of the expression; don't add
anything to the shape array. */
/* An element reference reduces the rank of the expression; don't
add anything to the shape array. */
if (ref->u.ar.dimen_type[d] != DIMEN_ELEMENT)
mpz_set (expr->shape[shape_i++], tmp_mpz);
}
......@@ -1178,7 +1165,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
/* Now clock through the array reference, calculating the index in
the source constructor and transferring the elements to the new
constructor. */
for (idx = 0; idx < (int)mpz_get_si (nelts); idx++)
for (idx = 0; idx < (int) mpz_get_si (nelts); idx++)
{
if (ref->u.ar.offset)
mpz_set (ptr, ref->u.ar.offset->value.integer);
......@@ -1189,8 +1176,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
for (d = 0; d < rank; d++)
{
mpz_set (tmp_mpz, ctr[d]);
mpz_sub (tmp_mpz, tmp_mpz,
ref->u.ar.as->lower[d]->value.integer);
mpz_sub (tmp_mpz, tmp_mpz, ref->u.ar.as->lower[d]->value.integer);
mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
mpz_add (ptr, ptr, tmp_mpz);
......@@ -1213,9 +1199,9 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
{
mpz_add (ctr[d], ctr[d], stride[d]);
if (mpz_cmp_ui (stride[d], 0) > 0 ?
mpz_cmp (ctr[d], end[d]) > 0 :
mpz_cmp (ctr[d], end[d]) < 0)
if (mpz_cmp_ui (stride[d], 0) > 0
? mpz_cmp (ctr[d], end[d]) > 0
: mpz_cmp (ctr[d], end[d]) < 0)
mpz_set (ctr[d], start[d]);
else
incr_ctr = false;
......@@ -1274,8 +1260,8 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
*newp = gfc_copy_expr (p);
chr = p->value.character.string;
end = (int)mpz_get_ui (p->ref->u.ss.end->value.integer);
start = (int)mpz_get_ui (p->ref->u.ss.start->value.integer);
end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer);
start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
(*newp)->value.character.length = end - start + 1;
strncpy ((*newp)->value.character.string, &chr[start - 1],
......@@ -1289,7 +1275,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
parameter variable values are substituted. */
static try
simplify_const_ref (gfc_expr * p)
simplify_const_ref (gfc_expr *p)
{
gfc_constructor *cons;
gfc_expr *newp;
......@@ -1302,8 +1288,7 @@ simplify_const_ref (gfc_expr * p)
switch (p->ref->u.ar.type)
{
case AR_ELEMENT:
if (find_array_element (p->value.constructor,
&p->ref->u.ar,
if (find_array_element (p->value.constructor, &p->ref->u.ar,
&cons) == FAILURE)
return FAILURE;
......@@ -1364,7 +1349,7 @@ simplify_const_ref (gfc_expr * p)
/* Simplify a chain of references. */
static try
simplify_ref_chain (gfc_ref * ref, int type)
simplify_ref_chain (gfc_ref *ref, int type)
{
int n;
......@@ -1375,16 +1360,12 @@ simplify_ref_chain (gfc_ref * ref, int type)
case REF_ARRAY:
for (n = 0; n < ref->u.ar.dimen; n++)
{
if (gfc_simplify_expr (ref->u.ar.start[n], type)
== FAILURE)
if (gfc_simplify_expr (ref->u.ar.start[n], type) == FAILURE)
return FAILURE;
if (gfc_simplify_expr (ref->u.ar.end[n], type)
== FAILURE)
if (gfc_simplify_expr (ref->u.ar.end[n], type) == FAILURE)
return FAILURE;
if (gfc_simplify_expr (ref->u.ar.stride[n], type)
== FAILURE)
if (gfc_simplify_expr (ref->u.ar.stride[n], type) == FAILURE)
return FAILURE;
}
break;
......@@ -1405,7 +1386,7 @@ simplify_ref_chain (gfc_ref * ref, int type)
/* Try to substitute the value of a parameter variable. */
static try
simplify_parameter_variable (gfc_expr * p, int type)
simplify_parameter_variable (gfc_expr *p, int type)
{
gfc_expr *e;
try t;
......@@ -1423,7 +1404,7 @@ simplify_parameter_variable (gfc_expr * p, int type)
/* Only use the simplification if it eliminated all subobject
references. */
if (t == SUCCESS && ! e->ref)
if (t == SUCCESS && !e->ref)
gfc_replace_expr (p, e);
else
gfc_free_expr (e);
......@@ -1451,7 +1432,7 @@ simplify_parameter_variable (gfc_expr * p, int type)
NOTE: Will return SUCCESS even if the expression can not be simplified. */
try
gfc_simplify_expr (gfc_expr * p, int type)
gfc_simplify_expr (gfc_expr *p, int type)
{
gfc_actual_arglist *ap;
......@@ -1489,7 +1470,7 @@ gfc_simplify_expr (gfc_expr * p, int type)
gfc_extract_int (p->ref->u.ss.end, &end);
s = gfc_getmem (end - start + 2);
memcpy (s, p->value.character.string + start, end - start);
s[end-start+1] = '\0'; /* TODO: C-style string for debugging. */
s[end - start + 1] = '\0'; /* TODO: C-style string. */
gfc_free (p->value.character.string);
p->value.character.string = s;
p->value.character.length = end - start;
......@@ -1539,8 +1520,7 @@ gfc_simplify_expr (gfc_expr * p, int type)
if (simplify_constructor (p->value.constructor, type) == FAILURE)
return FAILURE;
if (p->expr_type == EXPR_ARRAY
&& p->ref && p->ref->type == REF_ARRAY
if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY
&& p->ref->u.ar.type == AR_FULL)
gfc_expand_constructor (p);
......@@ -1559,9 +1539,8 @@ gfc_simplify_expr (gfc_expr * p, int type)
be declared as. */
static bt
et0 (gfc_expr * e)
et0 (gfc_expr *e)
{
if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e) == SUCCESS)
return BT_INTEGER;
......@@ -1575,7 +1554,7 @@ et0 (gfc_expr * e)
static try check_init_expr (gfc_expr *);
static try
check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
check_intrinsic_op (gfc_expr *e, try (*check_function) (gfc_expr *))
{
gfc_expr *op1 = e->value.op.op1;
gfc_expr *op2 = e->value.op.op2;
......@@ -1703,7 +1682,7 @@ not_numeric:
this problem here. */
static try
check_inquiry (gfc_expr * e, int not_restricted)
check_inquiry (gfc_expr *e, int not_restricted)
{
const char *name;
......@@ -1770,7 +1749,7 @@ check_inquiry (gfc_expr * e, int not_restricted)
FAILURE is returned an error message has been generated. */
static try
check_init_expr (gfc_expr * e)
check_init_expr (gfc_expr *e)
{
gfc_actual_arglist *ap;
match m;
......@@ -1882,7 +1861,7 @@ check_init_expr (gfc_expr * e)
expression, then reducing it to a constant. */
match
gfc_match_init_expr (gfc_expr ** result)
gfc_match_init_expr (gfc_expr **result)
{
gfc_expr *expr;
match m;
......@@ -1914,8 +1893,7 @@ gfc_match_init_expr (gfc_expr ** result)
/* Not all inquiry functions are simplified to constant expressions
so it is necessary to call check_inquiry again. */
if (!gfc_is_constant_expr (expr)
&& check_inquiry (expr, 1) == FAILURE
if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) == FAILURE
&& !gfc_in_match_data ())
{
gfc_error ("Initialization expression didn't reduce %C");
......@@ -1928,7 +1906,6 @@ gfc_match_init_expr (gfc_expr ** result)
}
static try check_restricted (gfc_expr *);
/* Given an actual argument list, test to see that each argument is a
......@@ -1936,7 +1913,7 @@ static try check_restricted (gfc_expr *);
integer or character. */
static try
restricted_args (gfc_actual_arglist * a)
restricted_args (gfc_actual_arglist *a)
{
for (; a; a = a->next)
{
......@@ -1954,7 +1931,7 @@ restricted_args (gfc_actual_arglist * a)
/* Make sure a non-intrinsic function is a specification function. */
static try
external_spec_function (gfc_expr * e)
external_spec_function (gfc_expr *e)
{
gfc_symbol *f;
......@@ -1996,7 +1973,7 @@ external_spec_function (gfc_expr * e)
restricted expression. */
static try
restricted_intrinsic (gfc_expr * e)
restricted_intrinsic (gfc_expr *e)
{
/* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */
if (check_inquiry (e, 0) == SUCCESS)
......@@ -2011,7 +1988,7 @@ restricted_intrinsic (gfc_expr * e)
return FAILURE. */
static try
check_restricted (gfc_expr * e)
check_restricted (gfc_expr *e)
{
gfc_symbol *sym;
try t;
......@@ -2029,8 +2006,8 @@ check_restricted (gfc_expr * e)
break;
case EXPR_FUNCTION:
t = e->value.function.esym ?
external_spec_function (e) : restricted_intrinsic (e);
t = e->value.function.esym ? external_spec_function (e)
: restricted_intrinsic (e);
break;
......@@ -2052,10 +2029,11 @@ check_restricted (gfc_expr * e)
break;
}
/* gfc_is_formal_arg broadcasts that a formal argument list is being processed
in resolve.c(resolve_formal_arglist). This is done so that host associated
dummy array indices are accepted (PR23446). This mechanism also does the
same for the specification expressions of array-valued functions. */
/* gfc_is_formal_arg broadcasts that a formal argument list is being
processed in resolve.c(resolve_formal_arglist). This is done so
that host associated dummy array indices are accepted (PR23446).
This mechanism also does the same for the specification expressions
of array-valued functions. */
if (sym->attr.in_common
|| sym->attr.use_assoc
|| sym->attr.dummy
......@@ -2109,7 +2087,7 @@ check_restricted (gfc_expr * e)
we return FAILURE, an error has been generated. */
try
gfc_specification_expr (gfc_expr * e)
gfc_specification_expr (gfc_expr *e)
{
if (e == NULL)
return SUCCESS;
......@@ -2138,8 +2116,7 @@ gfc_specification_expr (gfc_expr * e)
/* Given two expressions, make sure that the arrays are conformable. */
try
gfc_check_conformance (const char *optype_msgid,
gfc_expr * op1, gfc_expr * op2)
gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2)
{
int op1_flag, op2_flag, d;
mpz_t op1_size, op2_size;
......@@ -2189,7 +2166,7 @@ gfc_check_conformance (const char *optype_msgid,
sure that the assignment can take place. */
try
gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
{
gfc_symbol *sym;
gfc_ref *ref;
......@@ -2219,9 +2196,8 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
variable local to a function subprogram. Its existence begins when
execution of the function is initiated and ends when execution of the
function is terminated.....
Therefore, the left hand side is no longer a varaiable, when it is:*/
if (sym->attr.flavor == FL_PROCEDURE
&& sym->attr.proc != PROC_ST_FUNCTION
Therefore, the left hand side is no longer a varaiable, when it is: */
if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_ST_FUNCTION
&& !sym->attr.external)
{
bool bad_proc;
......@@ -2285,8 +2261,8 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
&& lvalue->ref->u.ar.type == AR_FULL
&& lvalue->ref->u.ar.as->cp_was_assumed)
{
gfc_error ("Vector assignment to assumed-size Cray Pointee at %L"
" is illegal", &lvalue->where);
gfc_error ("Vector assignment to assumed-size Cray Pointee at %L "
"is illegal", &lvalue->where);
return FAILURE;
}
......@@ -2332,7 +2308,7 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
NULLIFY statement. */
try
gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
{
symbol_attribute attr;
gfc_ref *ref;
......@@ -2387,8 +2363,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym))
{
gfc_error ("Bad pointer object in PURE procedure at %L",
&lvalue->where);
gfc_error ("Bad pointer object in PURE procedure at %L", &lvalue->where);
return FAILURE;
}
......@@ -2469,7 +2444,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
symbol. Used for initialization assignments. */
try
gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue)
gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
{
gfc_expr lvalue;
try r;
......@@ -2480,7 +2455,7 @@ gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue)
lvalue.ts = sym->ts;
if (sym->as)
lvalue.rank = sym->as->rank;
lvalue.symtree = (gfc_symtree *)gfc_getmem (sizeof (gfc_symtree));
lvalue.symtree = (gfc_symtree *) gfc_getmem (sizeof (gfc_symtree));
lvalue.symtree->n.sym = sym;
lvalue.where = sym->declared_at;
......@@ -2550,7 +2525,7 @@ gfc_default_initializer (gfc_typespec *ts)
whole array. */
gfc_expr *
gfc_get_variable_expr (gfc_symtree * var)
gfc_get_variable_expr (gfc_symtree *var)
{
gfc_expr *e;
......@@ -2574,7 +2549,7 @@ gfc_get_variable_expr (gfc_symtree * var)
/* Traverse expr, marking all EXPR_VARIABLE symbols referenced. */
void
gfc_expr_set_symbols_referenced (gfc_expr * expr)
gfc_expr_set_symbols_referenced (gfc_expr *expr)
{
gfc_actual_arglist *arg;
gfc_constructor *c;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment