FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

decl.c: Miscellaneous whitespace fixes.

Browse source 
* decl.c: Miscellaneous whitespace fixes.
* expr.c: Likewise.
* gfortran.h: Likewise.
* interface.c : Likewise.
* io.c: Likewise.
* match.c: Likewise.
* match.h: Likewise.
* module.c: Likewise.
* parse.c: Likewise.
* resolve.c: Likewise.
* symbol.c: Likewise.
* trans-array.c: Likewise.
* trans-common.c: Likewise.
* trans-decl.c: Likewise.
* trans-intrinsic.c: Likewise.
* trans-io.c: Likewise.
* trans-stmt.c: Likewise.
* trans-types.c: Likewise.

From-SVN: r125533
This commit is contained in:
Steven G. Kargl 2007-06-07 18:10:31 +00:00 • committed by Brooks Moses
parent bb27eeda7d
commit 66e4ab3127
19 changed files with 339 additions and 310 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
gcc/fortran/ChangeLog
View file

@ -1,3 +1,24 @@
2007-06-06 Steven G. Kargl <kargl@gcc.gnu.org>
* decl.c: Miscellaneous whitespace fixes.
* expr.c: Likewise.
* gfortran.h: Likewise.
* interface.c : Likewise.
* io.c: Likewise.
* match.c: Likewise.
* match.h: Likewise.
* module.c: Likewise.
* parse.c: Likewise.
* resolve.c: Likewise.
* symbol.c: Likewise.
* trans-array.c: Likewise.
* trans-common.c: Likewise.
* trans-decl.c: Likewise.
* trans-intrinsic.c: Likewise.
* trans-io.c: Likewise.
* trans-stmt.c: Likewise.
* trans-types.c: Likewise.
2007-06-05 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/18923

63
gcc/fortran/decl.c
View file

@ -141,7 +141,7 @@ gfc_free_data (gfc_data *p)
/* Free all data in a namespace. */
static void
gfc_free_data_all (gfc_namespace * ns)
gfc_free_data_all (gfc_namespace *ns)
{
gfc_data *d;
@ -444,8 +444,7 @@ match_old_style_init (const char *name)
newdata->var->expr = gfc_get_variable_expr (st);
newdata->where = gfc_current_locus;
/* Match initial value list. This also eats the terminal
'/'. */
/* Match initial value list. This also eats the terminal '/'. */
m = top_val_list (newdata);
if (m != MATCH_YES)
{
@ -638,7 +637,7 @@ find_special (const char *name, gfc_symbol **result)
if (s->state != COMP_INTERFACE)
goto end;
if (s->sym == NULL)
goto end; /* Nameless interface */
goto end; /* Nameless interface. */
if (strcmp (name, s->sym->name) == 0)
{
@ -729,7 +728,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
st->n.sym = sym;
sym->refs++;
/* See if the procedure should be a module procedure */
/* See if the procedure should be a module procedure. */
if (((sym->ns->proc_name != NULL
&& sym->ns->proc_name->attr.flavor == FL_MODULE
@ -756,8 +755,7 @@ build_sym (const char *name, gfc_charlen *cl,
if (gfc_get_symbol (name, NULL, &sym))
return FAILURE;
/* Start updating the symbol table. Add basic type attribute
if present. */
/* Start updating the symbol table. Add basic type attribute if present. */
if (current_ts.type != BT_UNKNOWN
&& (sym->attr.implicit_type == 0
|| !gfc_compare_types (&sym->ts, &current_ts))
@ -831,7 +829,7 @@ gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
enum history node containing largest initializer.
SYM points to the symbol node of enumerator.
INIT points to its enumerator value. */
INIT points to its enumerator value. */
static void
create_enum_history (gfc_symbol *sym, gfc_expr *init)
@ -885,8 +883,7 @@ 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;
@ -949,9 +946,8 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp,
/* Update symbol character length according initializer. */
if (sym->ts.cl->length == NULL)
{
/* If there are multiple CHARACTER variables declared on
the same line, we don't want them to share the same
length. */
/* If there are multiple CHARACTER variables declared on the
same line, we don't want them to share the same length. */
sym->ts.cl = gfc_get_charlen ();
sym->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = sym->ts.cl;
@ -1239,7 +1235,7 @@ variable_decl (int elem)
}
/* If this symbol has already shown up in a Cray Pointer declaration,
then we want to set the type & bail out. */
then we want to set the type & bail out. */
if (gfc_option.flag_cray_pointer)
{
gfc_find_symbol (name, gfc_current_ns, 1, &sym);
@ -1615,7 +1611,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);
@ -1642,7 +1638,7 @@ match_char_spec (gfc_typespec *ts)
goto rparen;
}
/* Try to match ( <len-param> ) or ( <len-param> , [ KIND = ] <int> ) */
/* Try to match ( <len-param> ) or ( <len-param> , [ KIND = ] <int> ). */
m = char_len_param_value (&len);
if (m == MATCH_NO)
goto syntax;
@ -1895,7 +1891,7 @@ match_implicit_range (void)
switch (c)
{
case ')':
inner = 0; /* Fall through */
inner = 0; /* Fall through. */
case ',':
c2 = c1;
@ -2068,6 +2064,7 @@ error:
return MATCH_ERROR;
}
match
gfc_match_import (void)
{
@ -2076,8 +2073,8 @@ gfc_match_import (void)
gfc_symbol *sym;
gfc_symtree *st;
if (gfc_current_ns->proc_name == NULL ||
gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)
if (gfc_current_ns->proc_name == NULL
|| gfc_current_ns->proc_name->attr.if_source != IFSRC_IFBODY)
{
gfc_error ("IMPORT statement at %C only permitted in "
"an INTERFACE body");
@ -2111,16 +2108,15 @@ gfc_match_import (void)
{
case MATCH_YES:
if (gfc_current_ns->parent != NULL
&& gfc_find_symbol (name, gfc_current_ns->parent,
1, &sym))
&& gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
{
gfc_error ("Type name '%s' at %C is ambiguous", name);
return MATCH_ERROR;
}
else if (gfc_current_ns->proc_name->ns->parent != NULL
&& gfc_find_symbol (name,
gfc_current_ns->proc_name->ns->parent,
1, &sym))
&& gfc_find_symbol (name,
gfc_current_ns->proc_name->ns->parent,
1, &sym))
{
gfc_error ("Type name '%s' at %C is ambiguous", name);
return MATCH_ERROR;
@ -2168,6 +2164,7 @@ syntax:
return MATCH_ERROR;
}
/* Matches an attribute specification including array specs. If
successful, leaves the variables current_attr and current_as
holding the specification. Also sets the colon_seen variable for
@ -2326,7 +2323,7 @@ match_attr_spec (void)
attr = "VOLATILE";
break;
default:
attr = NULL; /* This shouldn't happen */
attr = NULL; /* This shouldn't happen. */
}
gfc_error ("Duplicate %s attribute at %L", attr, &seen_at[d]);
@ -2777,8 +2774,8 @@ ok:
}
}
if (gfc_add_explicit_interface (progname, IFSRC_DECL, head, NULL) ==
FAILURE)
if (gfc_add_explicit_interface (progname, IFSRC_DECL, head, NULL)
== FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
@ -2796,7 +2793,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;
@ -2865,7 +2862,6 @@ gfc_match_function_decl (void)
gfc_current_locus = old_loc;
return MATCH_NO;
}
if (get_proc_name (name, &sym, false))
return MATCH_ERROR;
gfc_new_block = sym;
@ -3371,7 +3367,7 @@ gfc_match_end (gfc_statement *st)
{
if (!eos_ok)
{
/* We would have required END [something] */
/* We would have required END [something]. */
gfc_error ("%s statement expected at %L",
gfc_ascii_statement (*st), &old_loc);
goto cleanup;
@ -3408,7 +3404,8 @@ gfc_match_end (gfc_statement *st)
if (*st == ST_END_INTERFACE)
return gfc_match_end_interface ();
/* We haven't hit the end of statement, so what is left must be an end-name. */
/* We haven't hit the end of statement, so what is left must be an
end-name. */
m = gfc_match_space ();
if (m == MATCH_YES)
m = gfc_match_name (name);
@ -4262,6 +4259,7 @@ syntax:
return MATCH_ERROR;
}
match
gfc_match_volatile (void)
{
@ -4315,7 +4313,6 @@ syntax:
}
/* Match a module procedure statement. Note that we have to modify
symbols in the parent's namespace because the current one was there
to receive symbols that are in an interface's formal argument list. */
@ -4627,7 +4624,7 @@ cleanup:
}
/* Match the enumerator definition statement. */
/* Match the enumerator definition statement. */
match
gfc_match_enumerator_def (void)

38
gcc/fortran/expr.c
View file

@ -352,8 +352,7 @@ gfc_copy_shape (mpz_t *shape, int rank)
{ s1 ... sN-1 sN+1 ... sR-1}
If anything goes wrong -- N is not a constant, its value is out
of range -- or anything else, just returns NULL.
*/
of range -- or anything else, just returns NULL. */
mpz_t *
gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim)
@ -369,7 +368,7 @@ gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim)
return NULL;
n = mpz_get_si (dim->value.integer);
n--; /* Convert to zero based index */
n--; /* Convert to zero based index. */
if (n < 0 || n >= rank)
return NULL;
@ -477,7 +476,7 @@ gfc_copy_expr (gfc_expr *p)
q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
break;
default: /* Binary operators */
default: /* Binary operators. */
q->value.op.op1 = gfc_copy_expr (p->value.op.op1);
q->value.op.op2 = gfc_copy_expr (p->value.op.op2);
break;
@ -696,7 +695,6 @@ gfc_is_constant_expr (gfc_expr *e)
rv = (gfc_is_constant_expr (e->value.op.op1)
&& (e->value.op.op2 == NULL
|| gfc_is_constant_expr (e->value.op.op2)));
break;
case EXPR_VARIABLE:
@ -772,7 +770,7 @@ simplify_intrinsic_op (gfc_expr *p, int type)
|| (op2 != NULL && !gfc_is_constant_expr (op2)))
return SUCCESS;
/* Rip p apart */
/* Rip p apart. */
p->value.op.op1 = NULL;
p->value.op.op2 = NULL;
@ -1330,7 +1328,7 @@ simplify_const_ref (gfc_expr *p)
return FAILURE;
p->ref->u.ar.type = AR_FULL;
/* FALLTHROUGH */
/* Fall through. */
case AR_FULL:
if (p->ref->next != NULL
@ -1412,6 +1410,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)
{
@ -1429,8 +1428,7 @@ simplify_parameter_variable (gfc_expr *p, int type)
e->ref = copy_ref (p->ref);
t = gfc_simplify_expr (e, type);
/* Only use the simplification if it eliminated all subobject
references. */
/* Only use the simplification if it eliminated all subobject references. */
if (t == SUCCESS && !e->ref)
gfc_replace_expr (p, e);
else
@ -2168,7 +2166,6 @@ check_restricted (gfc_expr *e)
case EXPR_FUNCTION:
t = e->value.function.esym ? external_spec_function (e)
: restricted_intrinsic (e);
break;
case EXPR_VARIABLE:
@ -2249,6 +2246,7 @@ check_restricted (gfc_expr *e)
try
gfc_specification_expr (gfc_expr *e)
{
if (e == NULL)
return SUCCESS;
@ -2352,18 +2350,18 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
return FAILURE;
}
/* 12.5.2.2, Note 12.26: The result variable is very similar to any other
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: */
/* 12.5.2.2, Note 12.26: The result variable is very similar to any other
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 variable, when it is: */
if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_ST_FUNCTION
&& !sym->attr.external)
{
bool bad_proc;
bad_proc = false;
/* (i) Use associated; */
/* (i) Use associated; */
if (sym->attr.use_assoc)
bad_proc = true;
@ -2371,7 +2369,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
if (gfc_current_ns->proc_name->attr.is_main_program)
bad_proc = true;
/* (iii) A module or internal procedure.... */
/* (iii) A module or internal procedure... */
if ((gfc_current_ns->proc_name->attr.proc == PROC_INTERNAL
|| gfc_current_ns->proc_name->attr.proc == PROC_MODULE)
&& gfc_current_ns->parent
@ -2379,11 +2377,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
|| gfc_current_ns->parent->proc_name->attr.subroutine)
|| gfc_current_ns->parent->proc_name->attr.is_main_program))
{
/* .... that is not a function.... */
/* ... that is not a function... */
if (!gfc_current_ns->proc_name->attr.function)
bad_proc = true;
/* .... or is not an entry and has a different name. */
/* ... or is not an entry and has a different name. */
if (!sym->attr.entry && sym->name != gfc_current_ns->proc_name->name)
bad_proc = true;
}
@ -2426,7 +2424,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
return FAILURE;
}
/* This is possibly a typo: x = f() instead of x => f() */
/* This is possibly a typo: x = f() instead of x => f(). */
if (gfc_option.warn_surprising
&& rvalue->expr_type == EXPR_FUNCTION
&& rvalue->symtree->n.sym->attr.pointer)

23
gcc/fortran/gfortran.h
View file

@ -619,8 +619,8 @@ typedef struct
/* Special attributes for Cray pointers, pointees. */
unsigned cray_pointer:1, cray_pointee:1;
/* The symbol is a derived type with allocatable components, possibly nested.
*/
/* The symbol is a derived type with allocatable components, possibly
nested. */
unsigned alloc_comp:1;
/* The namespace where the VOLATILE attribute has been set. */
@ -1263,8 +1263,7 @@ gfc_simplify_f;
/* Again like gfc_check_f, these specify the type of the resolution
function associated with an intrinsic. The fX are just like in
gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort().
*/
gfc_check_f. f1m is used for MIN and MAX, s1 is used for abort(). */
typedef union
{
@ -1847,7 +1846,7 @@ extern locus gfc_current_locus;
/* misc.c */
void *gfc_getmem (size_t) ATTRIBUTE_MALLOC;
void gfc_free (void *);
int gfc_terminal_width(void);
int gfc_terminal_width (void);
void gfc_clear_ts (gfc_typespec *);
FILE *gfc_open_file (const char *);
const char *gfc_basic_typename (bt);
@ -1949,7 +1948,7 @@ try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);
void gfc_set_component_attr (gfc_component *, symbol_attribute *);
void gfc_get_component_attr (symbol_attribute *, gfc_component *);
void gfc_set_sym_referenced (gfc_symbol * sym);
void gfc_set_sym_referenced (gfc_symbol *);
try gfc_add_attribute (symbol_attribute *, locus *);
try gfc_add_allocatable (symbol_attribute *, locus *);
@ -1960,7 +1959,7 @@ try gfc_add_optional (symbol_attribute *, locus *);
try gfc_add_pointer (symbol_attribute *, locus *);
try gfc_add_cray_pointer (symbol_attribute *, locus *);
try gfc_add_cray_pointee (symbol_attribute *, locus *);
try gfc_mod_pointee_as (gfc_array_spec *as);
try gfc_mod_pointee_as (gfc_array_spec *);
try gfc_add_protected (symbol_attribute *, const char *, locus *);
try gfc_add_result (symbol_attribute *, const char *, locus *);
try gfc_add_save (symbol_attribute *, const char *, locus *);
@ -2025,7 +2024,7 @@ int gfc_symbols_could_alias (gfc_symbol *, gfc_symbol *);
void gfc_undo_symbols (void);
void gfc_commit_symbols (void);
void gfc_commit_symbol (gfc_symbol * sym);
void gfc_commit_symbol (gfc_symbol *);
void gfc_free_namespace (gfc_namespace *);
void gfc_symbol_init_2 (void);
@ -2121,7 +2120,7 @@ try gfc_check_assign_symbol (gfc_symbol *, gfc_expr *);
gfc_expr *gfc_default_initializer (gfc_typespec *);
gfc_expr *gfc_get_variable_expr (gfc_symtree *);
void gfc_expr_set_symbols_referenced (gfc_expr * expr);
void gfc_expr_set_symbols_referenced (gfc_expr *);
/* st.c */
extern gfc_code new_st;
@ -2166,7 +2165,7 @@ try gfc_resolve_array_constructor (gfc_expr *);
try gfc_check_constructor_type (gfc_expr *);
try gfc_check_iter_variable (gfc_expr *);
try gfc_check_constructor (gfc_expr *, try (*)(gfc_expr *));
gfc_constructor *gfc_copy_constructor (gfc_constructor * src);
gfc_constructor *gfc_copy_constructor (gfc_constructor *);
gfc_expr *gfc_get_array_element (gfc_expr *, int);
try gfc_array_size (gfc_expr *, mpz_t *);
try gfc_array_dimen_size (gfc_expr *, int, mpz_t *);
@ -2174,7 +2173,7 @@ try gfc_array_ref_shape (gfc_array_ref *, mpz_t *);
gfc_array_ref *gfc_find_array_ref (gfc_expr *);
void gfc_insert_constructor (gfc_expr *, gfc_constructor *);
gfc_constructor *gfc_get_constructor (void);
tree gfc_conv_array_initializer (tree type, gfc_expr * expr);
tree gfc_conv_array_initializer (tree type, gfc_expr *);
try spec_size (gfc_array_spec *, mpz_t *);
try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
int gfc_is_compile_time_shape (gfc_array_spec *);
@ -2190,7 +2189,7 @@ gfc_symbol *gfc_search_interface (gfc_interface *, int,
try gfc_extend_expr (gfc_expr *);
void gfc_free_formal_arglist (gfc_formal_arglist *);
try gfc_extend_assign (gfc_code *, gfc_namespace *);
try gfc_add_interface (gfc_symbol * sym);
try gfc_add_interface (gfc_symbol *);
/* io.c */
extern gfc_st_label format_asterisk;

27
gcc/fortran/interface.c
View file

@ -423,7 +423,7 @@ compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
r2 = (s2->as != NULL) ? s2->as->rank : 0;
if (r1 != r2)
return 0; /* Ranks differ */
return 0; /* Ranks differ. */
return gfc_compare_types (&s1->ts, &s2->ts);
}
@ -750,7 +750,7 @@ count_types_test (gfc_formal_arglist *f1, gfc_formal_arglist *f2)
continue;
if (arg[i].sym && arg[i].sym->attr.optional)
continue; /* Skip optional arguments */
continue; /* Skip optional arguments. */
arg[i].flag = k;
@ -899,13 +899,13 @@ compare_interfaces (gfc_symbol *s1, gfc_symbol *s2, int generic_flag)
if (s1->attr.function != s2->attr.function
&& s1->attr.subroutine != s2->attr.subroutine)
return 0; /* disagreement between function/subroutine */
return 0; /* Disagreement between function/subroutine. */
f1 = s1->formal;
f2 = s2->formal;
if (f1 == NULL && f2 == NULL)
return 1; /* Special case */
return 1; /* Special case. */
if (count_types_test (f1, f2))
return 0;
@ -965,7 +965,7 @@ check_interface0 (gfc_interface *p, const char *interface_name)
}
else
{
/* Duplicate interface */
/* Duplicate interface. */
qlast->next = q->next;
gfc_free (q);
q = qlast->next;
@ -978,8 +978,7 @@ check_interface0 (gfc_interface *p, const char *interface_name)
/* Check lists of interfaces to make sure that no two interfaces are
ambiguous. Duplicate interfaces (from the same symbol) are OK
here. */
ambiguous. Duplicate interfaces (from the same symbol) are OK here. */
static int
check_interface1 (gfc_interface *p, gfc_interface *q0,
@ -991,7 +990,7 @@ check_interface1 (gfc_interface *p, gfc_interface *q0,
for (q = q0; q; q = q->next)
{
if (p->sym == q->sym)
continue; /* Duplicates OK here */
continue; /* Duplicates OK here. */
if (p->sym->name == q->sym->name && p->sym->module == q->sym->module)
continue;
@ -1193,7 +1192,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
if (formal->attr.if_source == IFSRC_UNKNOWN
|| actual->symtree->n.sym->attr.external)
return 1; /* Assume match */
return 1; /* Assume match. */
return compare_interfaces (formal, actual->symtree->n.sym, 0);
}
@ -1226,7 +1225,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
break;
if (ref == NULL)
return 0; /* Not an array element */
return 0; /* Not an array element. */
return 1;
}
@ -1905,7 +1904,7 @@ find_sym_in_symtree (gfc_symbol *sym)
if (st && st->n.sym == sym)
return st;
/* if it's been renamed, resort to a brute-force search. */
/* If it's been renamed, resort to a brute-force search. */
/* TODO: avoid having to do this search. If the symbol doesn't exist
in the symtree for the current namespace, it should probably be added. */
for (ns = gfc_current_ns; ns; ns = ns->parent)
@ -1915,7 +1914,7 @@ find_sym_in_symtree (gfc_symbol *sym)
return st;
}
gfc_internal_error ("Unable to find symbol %s", sym->name);
/* Not reached */
/* Not reached. */
}
@ -1974,7 +1973,7 @@ gfc_extend_expr (gfc_expr *e)
if (sym == NULL)
{
/* Don't use gfc_free_actual_arglist() */
/* Don't use gfc_free_actual_arglist(). */
if (actual->next != NULL)
gfc_free (actual->next);
gfc_free (actual);
@ -2063,7 +2062,7 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns)
procedures can be present without interfaces. */
static try
check_new_interface (gfc_interface * base, gfc_symbol * new)
check_new_interface (gfc_interface *base, gfc_symbol *new)
{
gfc_interface *ip;

2
gcc/fortran/io.c
View file

@ -196,7 +196,7 @@ unget_char (void)
use_last_char = 1;
}
/* Eat up the spaces and return a character. */
/* Eat up the spaces and return a character. */
static char
next_char_not_space (void)

64
gcc/fortran/match.c
View file

@ -118,7 +118,7 @@ gfc_match_eos (void)
}
while (c != '\n');
/* Fall through */
/* Fall through. */
case '\n':
return MATCH_YES;
@ -441,7 +441,7 @@ gfc_match_sym_tree (gfc_symtree **matched_symbol, int host_assoc)
if (host_assoc)
return (gfc_get_ha_sym_tree (buffer, matched_symbol))
? MATCH_ERROR : MATCH_YES;
? MATCH_ERROR : MATCH_YES;
if (gfc_get_sym_tree (buffer, NULL, matched_symbol))
return MATCH_ERROR;
@ -741,7 +741,7 @@ loop:
goto not_yes;
case '%':
break; /* Fall through to character matcher */
break; /* Fall through to character matcher. */
default:
gfc_internal_error ("gfc_match(): Bad match code %c", c);
@ -771,7 +771,7 @@ not_yes:
{
case '%':
matches++;
break; /* Skip */
break; /* Skip. */
/* Matches that don't have to be undone */
case 'o':
@ -911,7 +911,6 @@ gfc_match_pointer_assignment (void)
goto cleanup;
}
new_st.op = EXEC_POINTER_ASSIGN;
new_st.expr = lvalue;
new_st.expr2 = rvalue;
@ -1073,7 +1072,7 @@ gfc_match_if (gfc_statement *if_type)
if (m == MATCH_ERROR)
return MATCH_ERROR;
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match */
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match. */
m = gfc_match_pointer_assignment ();
if (m == MATCH_YES)
@ -1083,7 +1082,7 @@ gfc_match_if (gfc_statement *if_type)
gfc_undo_symbols ();
gfc_current_locus = old_loc;
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match */
gfc_match (" if ( %e ) ", &expr); /* Guaranteed to match. */
/* Look at the next keyword to see which matcher to call. Matching
the keyword doesn't affect the symbol table, so we don't have to
@ -1249,6 +1248,7 @@ cleanup:
void
gfc_free_iterator (gfc_iterator *iter, int flag)
{
if (iter == NULL)
return;
@ -1288,7 +1288,7 @@ gfc_match_do (void)
if (m == MATCH_ERROR)
goto cleanup;
/* Match an infinite DO, make it like a DO WHILE(.TRUE.) */
/* Match an infinite DO, make it like a DO WHILE(.TRUE.). */
if (gfc_match_eos () == MATCH_YES)
{
@ -1297,8 +1297,8 @@ gfc_match_do (void)
goto done;
}
/* match an optional comma, if no comma is found a space is obligatory. */
if (gfc_match_char(',') != MATCH_YES && gfc_match ("% ") != MATCH_YES)
/* Match an optional comma, if no comma is found, a space is obligatory. */
if (gfc_match_char (',') != MATCH_YES && gfc_match ("% ") != MATCH_YES)
return MATCH_NO;
/* See if we have a DO WHILE. */
@ -1309,15 +1309,15 @@ gfc_match_do (void)
}
/* The abortive DO WHILE may have done something to the symbol
table, so we start over: */
table, so we start over. */
gfc_undo_symbols ();
gfc_current_locus = old_loc;
gfc_match_label (); /* This won't error */
gfc_match (" do "); /* This will work */
gfc_match_label (); /* This won't error. */
gfc_match (" do "); /* This will work. */
gfc_match_st_label (&label); /* Can't error out */
gfc_match_char (','); /* Optional comma */
gfc_match_st_label (&label); /* Can't error out. */
gfc_match_char (','); /* Optional comma. */
m = gfc_match_iterator (&iter, 0);
if (m == MATCH_NO)
@ -1389,8 +1389,7 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
}
}
/* Find the loop mentioned specified by the label (or lack of a
label). */
/* Find the loop mentioned specified by the label (or lack of a label). */
for (o = NULL, p = gfc_state_stack; p; p = p->previous)
if (p->state == COMP_DO && (sym == NULL || sym == p->sym))
break;
@ -1432,7 +1431,6 @@ match_exit_cycle (gfc_statement st, gfc_exec_op op)
new_st.ext.whichloop = p->head;
new_st.op = op;
/* new_st.sym = sym;*/
return MATCH_YES;
}
@ -1519,6 +1517,7 @@ cleanup:
return MATCH_ERROR;
}
/* Match the (deprecated) PAUSE statement. */
match
@ -1890,7 +1889,7 @@ gfc_match_nullify (void)
if (m == MATCH_NO)
goto syntax;
if (gfc_check_do_variable(p->symtree))
if (gfc_check_do_variable (p->symtree))
goto cleanup;
if (gfc_pure (NULL) && gfc_impure_variable (p->symtree->n.sym))
@ -1899,13 +1898,13 @@ gfc_match_nullify (void)
goto cleanup;
}
/* build ' => NULL() ' */
/* build ' => NULL() '. */
e = gfc_get_expr ();
e->where = gfc_current_locus;
e->expr_type = EXPR_NULL;
e->ts.type = BT_UNKNOWN;
/* Chain to list */
/* Chain to list. */
if (tail == NULL)
tail = &new_st;
else
@ -2145,7 +2144,7 @@ gfc_match_call (void)
i = 0;
for (a = arglist; a; a = a->next)
if (a->expr == NULL)
i = 1;
i = 1;
if (i)
{
@ -2156,7 +2155,7 @@ gfc_match_call (void)
new_st.next = c = gfc_get_code ();
c->op = EXEC_SELECT;
sprintf (name, "_result_%s", sym->name);
gfc_get_ha_sym_tree (name, &select_st); /* Can't fail */
gfc_get_ha_sym_tree (name, &select_st); /* Can't fail. */
select_sym = select_st->n.sym;
select_sym->ts.type = BT_INTEGER;
@ -2565,11 +2564,11 @@ gfc_match_namelist (void)
}
if (group_name->attr.flavor == FL_NAMELIST
&& group_name->attr.use_assoc
&& gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
"at %C already is USE associated and can"
"not be respecified.", group_name->name)
== FAILURE)
&& group_name->attr.use_assoc
&& gfc_notify_std (GFC_STD_GNU, "Namelist group name '%s' "
"at %C already is USE associated and can"
"not be respecified.", group_name->name)
== FAILURE)
return MATCH_ERROR;
if (group_name->attr.flavor != FL_NAMELIST
@ -2776,7 +2775,7 @@ gfc_match_equivalence (void)
/* If one of the members of an equivalence is in common, then
mark them all as being in common. Before doing this, check
that members of the equivalence group are not in different
common blocks. */
common blocks. */
if (common_flag)
for (set = eq; set; set = set->eq)
{
@ -3217,6 +3216,7 @@ cleanup:
return MATCH_ERROR;
}
/* Match a WHERE statement. */
match
@ -3308,7 +3308,7 @@ gfc_match_elsewhere (void)
m = MATCH_ERROR;
goto cleanup;
}
/* Better be a name at this point */
/* Better be a name at this point. */
m = gfc_match_name (name);
if (m == MATCH_NO)
goto syntax;
@ -3383,7 +3383,7 @@ match_forall_iterator (gfc_forall_iterator **result)
goto cleanup;
if (gfc_match_char ('=') != MATCH_YES
|| iter->var->expr_type != EXPR_VARIABLE)
|| iter->var->expr_type != EXPR_VARIABLE)
{
m = MATCH_NO;
goto cleanup;
@ -3472,7 +3472,7 @@ match_forall_header (gfc_forall_iterator **phead, gfc_expr **mask)
continue;
}
/* Have to have a mask expression */
/* Have to have a mask expression. */
m = gfc_match_expr (&msk);
if (m == MATCH_NO)

27
gcc/fortran/match.h
View file

@ -1,5 +1,6 @@
/* All matcher functions.
Copyright (C) 2003, 2005 Free Software Foundation, Inc.
Copyright (C) 2003, 2005, 2007
Free Software Foundation, Inc.
Contributed by Steven Bosscher
This file is part of GCC.
@ -35,9 +36,9 @@ extern gfc_st_label *gfc_statement_label;
/****************** All gfc_match* routines *****************/
/* match.c */
/* match.c. */
/* Generic match subroutines */
/* Generic match subroutines. */
match gfc_match_space (void);
match gfc_match_eos (void);
match gfc_match_small_literal_int (int *, int *);
@ -53,7 +54,7 @@ match gfc_match_char (char);
match gfc_match (const char *, ...);
match gfc_match_iterator (gfc_iterator *, int);
/* Statement matchers */
/* Statement matchers. */
match gfc_match_program (void);
match gfc_match_pointer_assignment (void);
match gfc_match_assignment (void);
@ -90,9 +91,9 @@ match gfc_match_forall (gfc_statement *);
gfc_common_head *gfc_get_common (const char *, int);
/* openmp.c */
/* openmp.c. */
/* OpenMP directive matchers */
/* OpenMP directive matchers. */
match gfc_match_omp_eos (void);
match gfc_match_omp_atomic (void);
match gfc_match_omp_barrier (void);
@ -112,7 +113,7 @@ match gfc_match_omp_workshare (void);
match gfc_match_omp_end_nowait (void);
match gfc_match_omp_end_single (void);
/* decl.c */
/* decl.c. */
match gfc_match_data (void);
match gfc_match_null (gfc_expr **);
@ -132,7 +133,7 @@ match gfc_match_implicit (void);
void gfc_set_constant_character_len (int, gfc_expr *, bool);
/* Matchers for attribute declarations */
/* Matchers for attribute declarations. */
match gfc_match_allocatable (void);
match gfc_match_dimension (void);
match gfc_match_external (void);
@ -163,17 +164,17 @@ match gfc_match_literal_constant (gfc_expr **, int);
only makes sure the init expr. is valid. */
match gfc_match_init_expr (gfc_expr **);
/* array.c */
/* array.c. */
match gfc_match_array_spec (gfc_array_spec **);
match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int);
match gfc_match_array_constructor (gfc_expr **);
/* interface.c */
/* interface.c. */
match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *);
match gfc_match_interface (void);
match gfc_match_end_interface (void);
/* io.c */
/* io.c. */
match gfc_match_format (void);
match gfc_match_open (void);
match gfc_match_close (void);
@ -186,11 +187,11 @@ match gfc_match_read (void);
match gfc_match_write (void);
match gfc_match_print (void);
/* matchexp.c */
/* matchexp.c. */
match gfc_match_defined_op_name (char *, int);
match gfc_match_expr (gfc_expr **);
/* module.c */
/* module.c. */
match gfc_match_use (void);
void gfc_use_module (void);

53
gcc/fortran/module.c
View file

@ -399,6 +399,7 @@ find_pointer2 (void *p)
/* Resolve any fixups using a known pointer. */
static void
resolve_fixups (fixup_t *f, void *gp)
{
@ -599,7 +600,7 @@ gfc_match_use (void)
if (type == INTERFACE_USER_OP && m == MATCH_YES
&& (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Renaming "
"operators in USE statements at %C")
== FAILURE))
== FAILURE))
goto cleanup;
if (only_flag)
@ -986,7 +987,7 @@ parse_string (void)
len = 0;
/* See how long the string is */
/* See how long the string is. */
for ( ; ; )
{
c = module_char ();
@ -1017,11 +1018,11 @@ parse_string (void)
{
c = module_char ();
if (c == '\'')
module_char (); /* Guaranteed to be another \' */
module_char (); /* Guaranteed to be another \'. */
*p++ = c;
}
module_char (); /* Terminating \' */
module_char (); /* Terminating \'. */
*p = '\0'; /* C-style string for debug purposes. */
}
@ -1186,7 +1187,7 @@ parse_atom (void)
bad_module ("Bad name");
}
/* Not reached */
/* Not reached. */
}
@ -1265,7 +1266,7 @@ find_enum (const mstring *m)
bad_module ("find_enum(): Enum not found");
/* Not reached */
/* Not reached. */
}
@ -1436,8 +1437,7 @@ mio_integer (int *ip)
}
/* Read or write a character pointer that points to a string on the
heap. */
/* Read or write a character pointer that points to a string on the heap. */
static const char *
mio_allocated_string (const char *s)
@ -1497,7 +1497,6 @@ mio_internal_string (char *string)
}
typedef enum
{ AB_ALLOCATABLE, AB_DIMENSION, AB_EXTERNAL, AB_INTRINSIC, AB_OPTIONAL,
AB_POINTER, AB_SAVE, AB_TARGET, AB_DUMMY, AB_RESULT, AB_DATA,
@ -2171,7 +2170,6 @@ mio_formal_arglist (gfc_symbol *sym)
{
for (f = sym->formal; f; f = f->next)
mio_symbol_ref (&f->sym);
}
else
{
@ -2271,7 +2269,7 @@ mio_symtree_ref (gfc_symtree **stp)
f->next = p->u.rsym.stfixup;
p->u.rsym.stfixup = f;
f->pointer = (void **)stp;
f->pointer = (void **) stp;
}
}
}
@ -2598,7 +2596,7 @@ fix_mio_expr (gfc_expr *e)
namespace, it has a unique name and we should look in the current
namespace to see if the required, non-contained symbol is available
yet. If so, the latter should be written. */
if (e->symtree->n.sym && check_unique_name(e->symtree->name))
if (e->symtree->n.sym && check_unique_name (e->symtree->name))
ns_st = gfc_find_symtree (gfc_current_ns->sym_root,
e->symtree->n.sym->name);
@ -2801,7 +2799,7 @@ mio_expr (gfc_expr **ep)
}
/* Read and write namelists */
/* Read and write namelists. */
static void
mio_namelist (gfc_symbol *sym)
@ -2982,7 +2980,7 @@ mio_symbol (gfc_symbol *sym)
}
}
/* Save/restore common block links */
/* Save/restore common block links. */
mio_symbol_ref (&sym->common_next);
mio_formal_arglist (sym);
@ -3133,8 +3131,8 @@ load_generic_interfaces (void)
p = p ? p : name;
st = gfc_find_symtree (gfc_current_ns->sym_root, p);
if (!sym->attr.generic
&& sym->module != NULL
&& strcmp(module, sym->module) != 0)
&& sym->module != NULL
&& strcmp(module, sym->module) != 0)
st->ambiguous = 1;
}
if (i == 1)
@ -3187,9 +3185,9 @@ load_commons (void)
}
/* load_equiv()-- Load equivalences. The flag in_load_equiv informs
mio_expr_ref of this so that unused variables are not loaded and
so that the expression can be safely freed.*/
/* Load equivalences. The flag in_load_equiv informs mio_expr_ref of this
so that unused variables are not loaded and so that the expression can
be safely freed. */
static void
load_equiv (void)
@ -3204,7 +3202,7 @@ load_equiv (void)
while (end != NULL && end->next != NULL)
end = end->next;
while (peek_atom() != ATOM_RPAREN) {
while (peek_atom () != ATOM_RPAREN) {
mio_lparen ();
head = tail = NULL;
@ -3258,6 +3256,7 @@ load_equiv (void)
in_load_equiv = false;
}
/* Recursive function to traverse the pointer_info tree and load a
needed symbol. We return nonzero if we load a symbol and stop the
traversal, because the act of loading can alter the tree. */
@ -3315,8 +3314,7 @@ load_needed (pointer_info *p)
}
/* Recursive function for cleaning up things after a module has been
read. */
/* Recursive function for cleaning up things after a module has been read. */
static void
read_cleanup (pointer_info *p)
@ -3391,7 +3389,7 @@ read_module (void)
gfc_symtree *st;
gfc_symbol *sym;
get_module_locus (&operator_interfaces); /* Skip these for now */
get_module_locus (&operator_interfaces); /* Skip these for now. */
skip_list ();
get_module_locus (&user_operators);
@ -3489,8 +3487,7 @@ read_module (void)
p = name;
/* Skip symtree nodes not in an ONLY clause, unless there
is an existing symtree loaded from another USE
statement. */
is an existing symtree loaded from another USE statement. */
if (p == NULL)
{
st = gfc_find_symtree (gfc_current_ns->sym_root, name);
@ -3642,7 +3639,7 @@ gfc_check_access (gfc_access specific_access, gfc_access default_access)
}
/* Write a common block to the module */
/* Write a common block to the module. */
static void
write_common (gfc_symtree *st)
@ -3794,6 +3791,7 @@ write_symbol0 (gfc_symtree *st)
static int
write_symbol1 (pointer_info *p)
{
if (p == NULL)
return 0;
@ -3982,6 +3980,7 @@ read_md5_from_module_file (const char * filename, unsigned char md5[16])
return 0;
}
/* Given module, dump it to disk. If there was an error while
processing the module, dump_flag will be set to zero and we delete
the module file, even if it was already there. */
@ -4039,7 +4038,7 @@ gfc_dump_module (const char *name, int dump_flag)
gfc_source_file, p);
fgetpos (module_fp, &md5_pos);
fputs ("00000000000000000000000000000000 -- "
"If you edit this, you'll get what you deserve.\n\n", module_fp);
"If you edit this, you'll get what you deserve.\n\n", module_fp);
/* Initialize the MD5 context that will be used for output. */
md5_init_ctx (&ctx);

2
gcc/fortran/parse.c
View file

@ -42,6 +42,7 @@ static void check_statement_label (gfc_statement);
static void undo_new_statement (void);
static void reject_statement (void);
/* A sort of half-matching function. We try to match the word on the
input with the passed string. If this succeeds, we call the
keyword-dependent matching function that will match the rest of the
@ -740,7 +741,6 @@ push_state (gfc_state_data *p, gfc_compile_state new_state, gfc_symbol *sym)
/* Pop the current state. */
static void
pop_state (void)
{

12
gcc/fortran/resolve.c
View file

@ -2027,7 +2027,7 @@ resolve_call (gfc_code *c)
if (resolve_actual_arglist (c->ext.actual, ptype) == FAILURE)
return FAILURE;
/* Resume assumed_size checking. */
/* Resume assumed_size checking. */
need_full_assumed_size--;
t = SUCCESS;
@ -5532,7 +5532,7 @@ resolve_charlen (gfc_charlen *cl)
}
/* Test for non-constant shape arrays. */
/* Test for non-constant shape arrays. */
static bool
is_non_constant_shape_array (gfc_symbol *sym)
@ -5632,7 +5632,7 @@ apply_default_init (gfc_symbol *sym)
}
/* Resolution of common features of flavors variable and procedure. */
/* Resolution of common features of flavors variable and procedure. */
static try
resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
@ -5915,7 +5915,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
/* Ensure that derived type for are not of a private type. Internal
module procedures are excluded by 2.2.3.3 - ie. they are not
externally accessible and can access all the objects accessible in
the host. */
the host. */
if (!(sym->ns->parent
&& sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
&& gfc_check_access(sym->attr.access, sym->ns->default_access))
@ -6967,7 +6967,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
return FAILURE;
}
/* Shall not have allocatable components. */
/* Shall not have allocatable components. */
if (derived->attr.alloc_comp)
{
gfc_error ("Derived type variable '%s' at %L cannot have ALLOCATABLE "
@ -7263,7 +7263,7 @@ resolve_equivalence (gfc_equiv *eq)
}
/* Resolve function and ENTRY types, issue diagnostics if needed. */
/* Resolve function and ENTRY types, issue diagnostics if needed. */
static void
resolve_fntype (gfc_namespace *ns)

266
gcc/fortran/symbol.c
View file

@ -167,7 +167,7 @@ gfc_add_new_implicit_range (int c1, int c2)
the new implicit types back into the existing types will work. */
try
gfc_merge_new_implicit (gfc_typespec * ts)
gfc_merge_new_implicit (gfc_typespec *ts)
{
int i;
@ -199,7 +199,7 @@ gfc_merge_new_implicit (gfc_typespec * ts)
/* Given a symbol, return a pointer to the typespec for its default type. */
gfc_typespec *
gfc_get_default_type (gfc_symbol * sym, gfc_namespace * ns)
gfc_get_default_type (gfc_symbol *sym, gfc_namespace *ns)
{
char letter;
@ -225,7 +225,7 @@ gfc_get_default_type (gfc_symbol * sym, gfc_namespace * ns)
type. */
try
gfc_set_default_type (gfc_symbol * sym, int error_flag, gfc_namespace * ns)
gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns)
{
gfc_typespec *ts;
@ -305,7 +305,7 @@ gfc_check_function_type (gfc_namespace *ns)
}
static try
check_conflict (symbol_attribute * attr, const char * name, locus * where)
check_conflict (symbol_attribute *attr, const char *name, locus *where)
{
static const char *dummy = "DUMMY", *save = "SAVE", *pointer = "POINTER",
*target = "TARGET", *external = "EXTERNAL", *intent = "INTENT",
@ -359,8 +359,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
if (a1 != NULL)
{
gfc_error
("%s attribute not allowed in BLOCK DATA program unit at %L", a1,
where);
("%s attribute not allowed in BLOCK DATA program unit at %L",
a1, where);
return FAILURE;
}
}
@ -461,7 +461,8 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
conf (value, dimension)
conf (value, external)
if (attr->value && (attr->intent == INTENT_OUT || attr->intent == INTENT_INOUT))
if (attr->value
&& (attr->intent == INTENT_OUT || attr->intent == INTENT_INOUT))
{
a1 = value;
a2 = attr->intent == INTENT_OUT ? intent_out : intent_inout;
@ -485,7 +486,6 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
&& attr->flavor != FL_PROCEDURE
&& attr->flavor != FL_UNKNOWN)
{
a2 = in_namelist;
goto conflict;
}
@ -520,18 +520,18 @@ check_conflict (symbol_attribute * attr, const char * name, locus * where)
case FL_PROCEDURE:
conf2 (intent);
conf2(save);
conf2 (save);
if (attr->subroutine)
{
conf2(pointer);
conf2(target);
conf2(allocatable);
conf2(result);
conf2(in_namelist);
conf2(dimension);
conf2(function);
conf2(threadprivate);
conf2 (pointer);
conf2 (target);
conf2 (allocatable);
conf2 (result);
conf2 (in_namelist);
conf2 (dimension);
conf2 (function);
conf2 (threadprivate);
}
switch (attr->proc)
@ -637,8 +637,9 @@ conflict_std:
/* Mark a symbol as referenced. */
void
gfc_set_sym_referenced (gfc_symbol * sym)
gfc_set_sym_referenced (gfc_symbol *sym)
{
if (sym->attr.referenced)
return;
@ -656,7 +657,7 @@ gfc_set_sym_referenced (gfc_symbol * sym)
nonzero if not. */
static int
check_used (symbol_attribute * attr, const char * name, locus * where)
check_used (symbol_attribute *attr, const char *name, locus *where)
{
if (attr->use_assoc == 0)
@ -679,7 +680,7 @@ check_used (symbol_attribute * attr, const char * name, locus * where)
/* Generate an error because of a duplicate attribute. */
static void
duplicate_attr (const char *attr, locus * where)
duplicate_attr (const char *attr, locus *where)
{
if (where == NULL)
@ -688,11 +689,14 @@ duplicate_attr (const char *attr, locus * where)
gfc_error ("Duplicate %s attribute specified at %L", attr, where);
}
/* Called from decl.c (attr_decl1) to check attributes, when declared separately. */
/* Called from decl.c (attr_decl1) to check attributes, when declared
separately. */
try
gfc_add_attribute (symbol_attribute * attr, locus * where)
gfc_add_attribute (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
return FAILURE;
@ -700,7 +704,7 @@ gfc_add_attribute (symbol_attribute * attr, locus * where)
}
try
gfc_add_allocatable (symbol_attribute * attr, locus * where)
gfc_add_allocatable (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -718,7 +722,7 @@ gfc_add_allocatable (symbol_attribute * attr, locus * where)
try
gfc_add_dimension (symbol_attribute * attr, const char *name, locus * where)
gfc_add_dimension (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -736,7 +740,7 @@ gfc_add_dimension (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_external (symbol_attribute * attr, locus * where)
gfc_add_external (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -755,7 +759,7 @@ gfc_add_external (symbol_attribute * attr, locus * where)
try
gfc_add_intrinsic (symbol_attribute * attr, locus * where)
gfc_add_intrinsic (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -774,7 +778,7 @@ gfc_add_intrinsic (symbol_attribute * attr, locus * where)
try
gfc_add_optional (symbol_attribute * attr, locus * where)
gfc_add_optional (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -792,7 +796,7 @@ gfc_add_optional (symbol_attribute * attr, locus * where)
try
gfc_add_pointer (symbol_attribute * attr, locus * where)
gfc_add_pointer (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -804,7 +808,7 @@ gfc_add_pointer (symbol_attribute * attr, locus * where)
try
gfc_add_cray_pointer (symbol_attribute * attr, locus * where)
gfc_add_cray_pointer (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -816,7 +820,7 @@ gfc_add_cray_pointer (symbol_attribute * attr, locus * where)
try
gfc_add_cray_pointee (symbol_attribute * attr, locus * where)
gfc_add_cray_pointee (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -833,8 +837,9 @@ gfc_add_cray_pointee (symbol_attribute * attr, locus * where)
return check_conflict (attr, NULL, where);
}
try
gfc_add_protected (symbol_attribute * attr, const char *name, locus * where)
gfc_add_protected (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
return FAILURE;
@ -852,8 +857,9 @@ gfc_add_protected (symbol_attribute * attr, const char *name, locus * where)
return check_conflict (attr, name, where);
}
try
gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
gfc_add_result (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -865,7 +871,7 @@ gfc_add_result (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
gfc_add_save (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -892,8 +898,9 @@ gfc_add_save (symbol_attribute * attr, const char *name, locus * where)
return check_conflict (attr, name, where);
}
try
gfc_add_value (symbol_attribute * attr, const char *name, locus * where)
gfc_add_value (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -912,8 +919,9 @@ gfc_add_value (symbol_attribute * attr, const char *name, locus * where)
return check_conflict (attr, name, where);
}
try
gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
gfc_add_volatile (symbol_attribute *attr, const char *name, locus *where)
{
/* No check_used needed as 11.2.1 of the F2003 standard allows
that the local identifier made accessible by a use statement can be
@ -932,8 +940,9 @@ gfc_add_volatile (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_threadprivate (symbol_attribute * attr, const char *name, locus * where)
gfc_add_threadprivate (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
return FAILURE;
@ -949,7 +958,7 @@ gfc_add_threadprivate (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_target (symbol_attribute * attr, locus * where)
gfc_add_target (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -967,7 +976,7 @@ gfc_add_target (symbol_attribute * attr, locus * where)
try
gfc_add_dummy (symbol_attribute * attr, const char *name, locus * where)
gfc_add_dummy (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -980,7 +989,7 @@ gfc_add_dummy (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
gfc_add_in_common (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -997,8 +1006,9 @@ gfc_add_in_common (symbol_attribute * attr, const char *name, locus * where)
return gfc_add_flavor (attr, FL_VARIABLE, name, where);
}
try
gfc_add_in_equivalence (symbol_attribute * attr, const char *name, locus * where)
gfc_add_in_equivalence (symbol_attribute *attr, const char *name, locus *where)
{
/* Duplicate attribute already checked for. */
@ -1026,8 +1036,7 @@ gfc_add_data (symbol_attribute *attr, const char *name, locus *where)
try
gfc_add_in_namelist (symbol_attribute * attr, const char *name,
locus * where)
gfc_add_in_namelist (symbol_attribute *attr, const char *name, locus *where)
{
attr->in_namelist = 1;
@ -1036,7 +1045,7 @@ gfc_add_in_namelist (symbol_attribute * attr, const char *name,
try
gfc_add_sequence (symbol_attribute * attr, const char *name, locus * where)
gfc_add_sequence (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -1048,7 +1057,7 @@ gfc_add_sequence (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_elemental (symbol_attribute * attr, locus * where)
gfc_add_elemental (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -1060,7 +1069,7 @@ gfc_add_elemental (symbol_attribute * attr, locus * where)
try
gfc_add_pure (symbol_attribute * attr, locus * where)
gfc_add_pure (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -1072,7 +1081,7 @@ gfc_add_pure (symbol_attribute * attr, locus * where)
try
gfc_add_recursive (symbol_attribute * attr, locus * where)
gfc_add_recursive (symbol_attribute *attr, locus *where)
{
if (check_used (attr, NULL, where))
@ -1084,7 +1093,7 @@ gfc_add_recursive (symbol_attribute * attr, locus * where)
try
gfc_add_entry (symbol_attribute * attr, const char *name, locus * where)
gfc_add_entry (symbol_attribute *attr, const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -1102,7 +1111,7 @@ gfc_add_entry (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_function (symbol_attribute * attr, const char *name, locus * where)
gfc_add_function (symbol_attribute *attr, const char *name, locus *where)
{
if (attr->flavor != FL_PROCEDURE
@ -1115,7 +1124,7 @@ gfc_add_function (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_subroutine (symbol_attribute * attr, const char *name, locus * where)
gfc_add_subroutine (symbol_attribute *attr, const char *name, locus *where)
{
if (attr->flavor != FL_PROCEDURE
@ -1128,7 +1137,7 @@ gfc_add_subroutine (symbol_attribute * attr, const char *name, locus * where)
try
gfc_add_generic (symbol_attribute * attr, const char *name, locus * where)
gfc_add_generic (symbol_attribute *attr, const char *name, locus *where)
{
if (attr->flavor != FL_PROCEDURE
@ -1144,8 +1153,8 @@ gfc_add_generic (symbol_attribute * attr, const char *name, locus * where)
considers attributes and can be reaffirmed multiple times. */
try
gfc_add_flavor (symbol_attribute * attr, sym_flavor f, const char *name,
locus * where)
gfc_add_flavor (symbol_attribute *attr, sym_flavor f, const char *name,
locus *where)
{
if ((f == FL_PROGRAM || f == FL_BLOCK_DATA || f == FL_MODULE
@ -1180,8 +1189,8 @@ gfc_add_flavor (symbol_attribute * attr, sym_flavor f, const char *name,
try
gfc_add_procedure (symbol_attribute * attr, procedure_type t,
const char *name, locus * where)
gfc_add_procedure (symbol_attribute *attr, procedure_type t,
const char *name, locus *where)
{
if (check_used (attr, name, where))
@ -1216,7 +1225,7 @@ gfc_add_procedure (symbol_attribute * attr, procedure_type t,
try
gfc_add_intent (symbol_attribute * attr, sym_intent intent, locus * where)
gfc_add_intent (symbol_attribute *attr, sym_intent intent, locus *where)
{
if (check_used (attr, NULL, where))
@ -1242,8 +1251,8 @@ gfc_add_intent (symbol_attribute * attr, sym_intent intent, locus * where)
/* No checks for use-association in public and private statements. */
try
gfc_add_access (symbol_attribute * attr, gfc_access access,
const char *name, locus * where)
gfc_add_access (symbol_attribute *attr, gfc_access access,
const char *name, locus *where)
{
if (attr->access == ACCESS_UNKNOWN)
@ -1289,7 +1298,7 @@ gfc_add_explicit_interface (gfc_symbol * sym, ifsrc source,
/* Add a type to a symbol. */
try
gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where)
gfc_add_type (gfc_symbol *sym, gfc_typespec *ts, locus *where)
{
sym_flavor flavor;
@ -1300,23 +1309,23 @@ gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where)
{
const char *msg = "Symbol '%s' at %L already has basic type of %s";
if (!(sym->ts.type == ts->type
&& (sym->attr.flavor == FL_PROCEDURE || sym->attr.result))
|| gfc_notification_std (GFC_STD_GNU) == ERROR
|| pedantic)
&& (sym->attr.flavor == FL_PROCEDURE || sym->attr.result))
|| gfc_notification_std (GFC_STD_GNU) == ERROR
|| pedantic)
{
gfc_error (msg, sym->name, where, gfc_basic_typename (sym->ts.type));
return FAILURE;
}
else if (gfc_notify_std (GFC_STD_GNU, msg, sym->name, where,
gfc_basic_typename (sym->ts.type)) == FAILURE)
return FAILURE;
return FAILURE;
}
flavor = sym->attr.flavor;
if (flavor == FL_PROGRAM || flavor == FL_BLOCK_DATA || flavor == FL_MODULE
|| flavor == FL_LABEL || (flavor == FL_PROCEDURE
&& sym->attr.subroutine)
|| flavor == FL_LABEL
|| (flavor == FL_PROCEDURE && sym->attr.subroutine)
|| flavor == FL_DERIVED || flavor == FL_NAMELIST)
{
gfc_error ("Symbol '%s' at %L cannot have a type", sym->name, where);
@ -1331,9 +1340,9 @@ gfc_add_type (gfc_symbol * sym, gfc_typespec * ts, locus * where)
/* Clears all attributes. */
void
gfc_clear_attr (symbol_attribute * attr)
gfc_clear_attr (symbol_attribute *attr)
{
memset (attr, 0, sizeof(symbol_attribute));
memset (attr, 0, sizeof (symbol_attribute));
}
@ -1341,8 +1350,8 @@ gfc_clear_attr (symbol_attribute * attr)
nothing, but it's not clear that it is unnecessary yet. */
try
gfc_missing_attr (symbol_attribute * attr ATTRIBUTE_UNUSED,
locus * where ATTRIBUTE_UNUSED)
gfc_missing_attr (symbol_attribute *attr ATTRIBUTE_UNUSED,
locus *where ATTRIBUTE_UNUSED)
{
return SUCCESS;
@ -1374,7 +1383,8 @@ gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
goto fail;
if (src->volatile_ && gfc_add_volatile (dest, NULL, where) == FAILURE)
goto fail;
if (src->threadprivate && gfc_add_threadprivate (dest, NULL, where) == FAILURE)
if (src->threadprivate
&& gfc_add_threadprivate (dest, NULL, where) == FAILURE)
goto fail;
if (src->target && gfc_add_target (dest, where) == FAILURE)
goto fail;
@ -1455,7 +1465,8 @@ fail:
point to the additional component structure. */
try
gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** component)
gfc_add_component (gfc_symbol *sym, const char *name,
gfc_component **component)
{
gfc_component *p, *tail;
@ -1493,7 +1504,7 @@ gfc_add_component (gfc_symbol * sym, const char *name, gfc_component ** componen
namespace. */
static void
switch_types (gfc_symtree * st, gfc_symbol * from, gfc_symbol * to)
switch_types (gfc_symtree *st, gfc_symbol *from, gfc_symbol *to)
{
gfc_symbol *sym;
@ -1528,7 +1539,7 @@ switch_types (gfc_symtree * st, gfc_symbol * from, gfc_symbol * to)
is no translation and we return the node we were passed. */
gfc_symbol *
gfc_use_derived (gfc_symbol * sym)
gfc_use_derived (gfc_symbol *sym)
{
gfc_symbol *s;
gfc_typespec *t;
@ -1586,7 +1597,7 @@ bad:
not found or the components are private. */
gfc_component *
gfc_find_component (gfc_symbol * sym, const char *name)
gfc_find_component (gfc_symbol *sym, const char *name)
{
gfc_component *p;
@ -1623,7 +1634,7 @@ gfc_find_component (gfc_symbol * sym, const char *name)
they point to. */
static void
free_components (gfc_component * p)
free_components (gfc_component *p)
{
gfc_component *q;
@ -1639,11 +1650,10 @@ free_components (gfc_component * p)
}
/* Set component attributes from a standard symbol attribute
structure. */
/* Set component attributes from a standard symbol attribute structure. */
void
gfc_set_component_attr (gfc_component * c, symbol_attribute * attr)
gfc_set_component_attr (gfc_component *c, symbol_attribute *attr)
{
c->dimension = attr->dimension;
@ -1656,7 +1666,7 @@ gfc_set_component_attr (gfc_component * c, symbol_attribute * attr)
structure. */
void
gfc_get_component_attr (symbol_attribute * attr, gfc_component * c)
gfc_get_component_attr (symbol_attribute *attr, gfc_component *c)
{
gfc_clear_attr (attr);
@ -1672,10 +1682,10 @@ gfc_get_component_attr (symbol_attribute * attr, gfc_component * c)
binary tree. */
static int
compare_st_labels (void * a1, void * b1)
compare_st_labels (void *a1, void *b1)
{
int a = ((gfc_st_label *)a1)->value;
int b = ((gfc_st_label *)b1)->value;
int a = ((gfc_st_label *) a1)->value;
int b = ((gfc_st_label *) b1)->value;
return (b - a);
}
@ -1686,8 +1696,9 @@ compare_st_labels (void * a1, void * b1)
occurs. */
void
gfc_free_st_label (gfc_st_label * label)
gfc_free_st_label (gfc_st_label *label)
{
if (label == NULL)
return;
@ -1699,11 +1710,13 @@ gfc_free_st_label (gfc_st_label * label)
gfc_free (label);
}
/* Free a whole tree of gfc_st_label structures. */
static void
free_st_labels (gfc_st_label * label)
free_st_labels (gfc_st_label *label)
{
if (label == NULL)
return;
@ -1755,7 +1768,7 @@ gfc_get_st_label (int labelno)
correctly. */
void
gfc_define_st_label (gfc_st_label * lp, gfc_sl_type type, locus * label_locus)
gfc_define_st_label (gfc_st_label *lp, gfc_sl_type type, locus *label_locus)
{
int labelno;
@ -1802,7 +1815,7 @@ gfc_define_st_label (gfc_st_label * lp, gfc_sl_type type, locus * label_locus)
wrong. */
try
gfc_reference_st_label (gfc_st_label * lp, gfc_sl_type type)
gfc_reference_st_label (gfc_st_label *lp, gfc_sl_type type)
{
gfc_sl_type label_type;
int labelno;
@ -1867,7 +1880,7 @@ done:
PARENT if PARENT_TYPES is set. */
gfc_namespace *
gfc_get_namespace (gfc_namespace * parent, int parent_types)
gfc_get_namespace (gfc_namespace *parent, int parent_types)
{
gfc_namespace *ns;
gfc_typespec *ts;
@ -1891,7 +1904,7 @@ gfc_get_namespace (gfc_namespace * parent, int parent_types)
if (parent_types && ns->parent != NULL)
{
/* Copy parent settings */
/* Copy parent settings. */
*ts = ns->parent->default_type[i - 'a'];
continue;
}
@ -1923,7 +1936,7 @@ gfc_get_namespace (gfc_namespace * parent, int parent_types)
/* Comparison function for symtree nodes. */
static int
compare_symtree (void * _st1, void * _st2)
compare_symtree (void *_st1, void *_st2)
{
gfc_symtree *st1, *st2;
@ -1937,7 +1950,7 @@ compare_symtree (void * _st1, void * _st2)
/* Allocate a new symtree node and associate it with the new symbol. */
gfc_symtree *
gfc_new_symtree (gfc_symtree ** root, const char *name)
gfc_new_symtree (gfc_symtree **root, const char *name)
{
gfc_symtree *st;
@ -1952,7 +1965,7 @@ gfc_new_symtree (gfc_symtree ** root, const char *name)
/* Delete a symbol from the tree. Does not free the symbol itself! */
static void
delete_symtree (gfc_symtree ** root, const char *name)
delete_symtree (gfc_symtree **root, const char *name)
{
gfc_symtree st, *st0;
@ -1969,7 +1982,7 @@ delete_symtree (gfc_symtree ** root, const char *name)
the namespace. Returns NULL if the symbol is not found. */
gfc_symtree *
gfc_find_symtree (gfc_symtree * st, const char *name)
gfc_find_symtree (gfc_symtree *st, const char *name)
{
int c;
@ -2015,7 +2028,7 @@ gfc_get_uop (const char *name)
not exist. */
gfc_user_op *
gfc_find_uop (const char *name, gfc_namespace * ns)
gfc_find_uop (const char *name, gfc_namespace *ns)
{
gfc_symtree *st;
@ -2030,7 +2043,7 @@ gfc_find_uop (const char *name, gfc_namespace * ns)
/* Remove a gfc_symbol structure and everything it points to. */
void
gfc_free_symbol (gfc_symbol * sym)
gfc_free_symbol (gfc_symbol *sym)
{
if (sym == NULL)
@ -2058,7 +2071,7 @@ gfc_free_symbol (gfc_symbol * sym)
/* Allocate and initialize a new symbol node. */
gfc_symbol *
gfc_new_symbol (const char *name, gfc_namespace * ns)
gfc_new_symbol (const char *name, gfc_namespace *ns)
{
gfc_symbol *p;
@ -2081,7 +2094,7 @@ gfc_new_symbol (const char *name, gfc_namespace * ns)
/* Generate an error if a symbol is ambiguous. */
static void
ambiguous_symbol (const char *name, gfc_symtree * st)
ambiguous_symbol (const char *name, gfc_symtree *st)
{
if (st->n.sym->module)
@ -2098,8 +2111,8 @@ ambiguous_symbol (const char *name, gfc_symtree * st)
Returns nonzero if the name is ambiguous. */
int
gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag,
gfc_symtree ** result)
gfc_find_sym_tree (const char *name, gfc_namespace *ns, int parent_flag,
gfc_symtree **result)
{
gfc_symtree *st;
@ -2138,8 +2151,8 @@ gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag,
/* Same, but returns the symbol instead. */
int
gfc_find_symbol (const char *name, gfc_namespace * ns, int parent_flag,
gfc_symbol ** result)
gfc_find_symbol (const char *name, gfc_namespace *ns, int parent_flag,
gfc_symbol **result)
{
gfc_symtree *st;
int i;
@ -2158,7 +2171,7 @@ gfc_find_symbol (const char *name, gfc_namespace * ns, int parent_flag,
/* Save symbol with the information necessary to back it out. */
static void
save_symbol_data (gfc_symbol * sym)
save_symbol_data (gfc_symbol *sym)
{
if (sym->new || sym->old_symbol != NULL)
@ -2184,7 +2197,7 @@ save_symbol_data (gfc_symbol * sym)
So if the return value is nonzero, then an error was issued. */
int
gfc_get_sym_tree (const char *name, gfc_namespace * ns, gfc_symtree ** result)
gfc_get_sym_tree (const char *name, gfc_namespace *ns, gfc_symtree **result)
{
gfc_symtree *st;
gfc_symbol *p;
@ -2246,12 +2259,11 @@ gfc_get_sym_tree (const char *name, gfc_namespace * ns, gfc_symtree ** result)
int
gfc_get_symbol (const char *name, gfc_namespace * ns, gfc_symbol ** result)
gfc_get_symbol (const char *name, gfc_namespace *ns, gfc_symbol **result)
{
gfc_symtree *st;
int i;
i = gfc_get_sym_tree (name, ns, &st);
if (i != 0)
return i;
@ -2268,7 +2280,7 @@ gfc_get_symbol (const char *name, gfc_namespace * ns, gfc_symbol ** result)
exist, but tries to host-associate the symbol if possible. */
int
gfc_get_ha_sym_tree (const char *name, gfc_symtree ** result)
gfc_get_ha_sym_tree (const char *name, gfc_symtree **result)
{
gfc_symtree *st;
int i;
@ -2277,7 +2289,6 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree ** result)
if (st != NULL)
{
save_symbol_data (st->n.sym);
*result = st;
return i;
}
@ -2300,7 +2311,7 @@ gfc_get_ha_sym_tree (const char *name, gfc_symtree ** result)
int
gfc_get_ha_symbol (const char *name, gfc_symbol ** result)
gfc_get_ha_symbol (const char *name, gfc_symbol **result)
{
int i;
gfc_symtree *st;
@ -2319,7 +2330,7 @@ gfc_get_ha_symbol (const char *name, gfc_symbol ** result)
not take account of aliasing due to equivalence statements. */
int
gfc_symbols_could_alias (gfc_symbol * lsym, gfc_symbol * rsym)
gfc_symbols_could_alias (gfc_symbol *lsym, gfc_symbol *rsym)
{
/* Aliasing isn't possible if the symbols have different base types. */
if (gfc_compare_types (&lsym->ts, &rsym->ts) == 0)
@ -2397,7 +2408,6 @@ gfc_undo_symbols (void)
}
else
{
if (p->namelist_tail != old->namelist_tail)
{
gfc_free_namelist (old->namelist_tail);
@ -2429,8 +2439,9 @@ gfc_undo_symbols (void)
because sym->namelist has gotten a few more items. */
static void
free_old_symbol (gfc_symbol * sym)
free_old_symbol (gfc_symbol *sym)
{
if (sym->old_symbol == NULL)
return;
@ -2462,7 +2473,6 @@ gfc_commit_symbols (void)
p->tlink = NULL;
p->mark = 0;
p->new = 0;
free_old_symbol (p);
}
changed_syms = NULL;
@ -2473,7 +2483,7 @@ gfc_commit_symbols (void)
information. */
void
gfc_commit_symbol (gfc_symbol * sym)
gfc_commit_symbol (gfc_symbol *sym)
{
gfc_symbol *p;
@ -2517,7 +2527,7 @@ free_common_tree (gfc_symtree * common_tree)
operator nodes that it contains. */
static void
free_uop_tree (gfc_symtree * uop_tree)
free_uop_tree (gfc_symtree *uop_tree)
{
if (uop_tree == NULL)
@ -2537,7 +2547,7 @@ free_uop_tree (gfc_symtree * uop_tree)
that it contains. */
static void
free_sym_tree (gfc_symtree * sym_tree)
free_sym_tree (gfc_symtree *sym_tree)
{
gfc_namespace *ns;
gfc_symbol *sym;
@ -2592,7 +2602,7 @@ gfc_free_dt_list (void)
/* Free the gfc_equiv_info's. */
static void
gfc_free_equiv_infos (gfc_equiv_info * s)
gfc_free_equiv_infos (gfc_equiv_info *s)
{
if (s == NULL)
return;
@ -2604,7 +2614,7 @@ gfc_free_equiv_infos (gfc_equiv_info * s)
/* Free the gfc_equiv_lists. */
static void
gfc_free_equiv_lists (gfc_equiv_list * l)
gfc_free_equiv_lists (gfc_equiv_list *l)
{
if (l == NULL)
return;
@ -2619,7 +2629,7 @@ gfc_free_equiv_lists (gfc_equiv_list * l)
taken care of when a specific name is freed. */
void
gfc_free_namespace (gfc_namespace * ns)
gfc_free_namespace (gfc_namespace *ns)
{
gfc_charlen *cl, *cl2;
gfc_namespace *p, *q;
@ -2663,7 +2673,6 @@ gfc_free_namespace (gfc_namespace * ns)
{
q = p;
p = p->sibling;
gfc_free_namespace (q);
}
}
@ -2690,7 +2699,7 @@ gfc_symbol_done_2 (void)
/* Clear mark bits from symbol nodes associated with a symtree node. */
static void
clear_sym_mark (gfc_symtree * st)
clear_sym_mark (gfc_symtree *st)
{
st->n.sym->mark = 0;
@ -2700,7 +2709,7 @@ clear_sym_mark (gfc_symtree * st)
/* Recursively traverse the symtree nodes. */
void
gfc_traverse_symtree (gfc_symtree * st, void (*func) (gfc_symtree *))
gfc_traverse_symtree (gfc_symtree *st, void (*func) (gfc_symtree *))
{
if (st != NULL)
{
@ -2715,7 +2724,7 @@ gfc_traverse_symtree (gfc_symtree * st, void (*func) (gfc_symtree *))
/* Recursive namespace traversal function. */
static void
traverse_ns (gfc_symtree * st, void (*func) (gfc_symbol *))
traverse_ns (gfc_symtree *st, void (*func) (gfc_symbol *))
{
if (st == NULL)
@ -2734,7 +2743,7 @@ traverse_ns (gfc_symtree * st, void (*func) (gfc_symbol *))
care that each gfc_symbol node is called exactly once. */
void
gfc_traverse_ns (gfc_namespace * ns, void (*func) (gfc_symbol *))
gfc_traverse_ns (gfc_namespace *ns, void (*func) (gfc_symbol *))
{
gfc_traverse_symtree (ns->sym_root, clear_sym_mark);
@ -2744,8 +2753,9 @@ gfc_traverse_ns (gfc_namespace * ns, void (*func) (gfc_symbol *))
/* Return TRUE if the symbol is an automatic variable. */
static bool
gfc_is_var_automatic (gfc_symbol * sym)
gfc_is_var_automatic (gfc_symbol *sym)
{
/* Pointer and allocatable variables are never automatic. */
if (sym->attr.pointer || sym->attr.allocatable)
@ -2765,7 +2775,7 @@ gfc_is_var_automatic (gfc_symbol * sym)
/* Given a symbol, mark it as SAVEd if it is allowed. */
static void
save_symbol (gfc_symbol * sym)
save_symbol (gfc_symbol *sym)
{
if (sym->attr.use_assoc)
@ -2785,7 +2795,7 @@ save_symbol (gfc_symbol * sym)
/* Mark those symbols which can be SAVEd as such. */
void
gfc_save_all (gfc_namespace * ns)
gfc_save_all (gfc_namespace *ns)
{
gfc_traverse_ns (ns, save_symbol);
@ -2833,13 +2843,13 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, const char *name)
/* Compare two global symbols. Used for managing the BB tree. */
static int
gsym_compare (void * _s1, void * _s2)
gsym_compare (void *_s1, void *_s2)
{
gfc_gsymbol *s1, *s2;
s1 = (gfc_gsymbol *)_s1;
s2 = (gfc_gsymbol *)_s2;
return strcmp(s1->name, s2->name);
s1 = (gfc_gsymbol *) _s1;
s2 = (gfc_gsymbol *) _s2;
return strcmp (s1->name, s2->name);
}

6
gcc/fortran/trans-array.c
View file

@ -5009,7 +5009,7 @@ gfc_duplicate_allocatable(tree dest, tree src, tree type, int rank)
tree null_data;
stmtblock_t block;
/* If the source is null, set the destination to null. */
/* If the source is null, set the destination to null. */
gfc_init_block (&block);
gfc_conv_descriptor_data_set (&block, dest, null_pointer_node);
null_data = gfc_finish_block (&block);
@ -5126,7 +5126,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
gfc_add_expr_to_block (&loopbody, tmp);
/* Build the loop and return. */
/* Build the loop and return. */
gfc_init_loopinfo (&loop);
loop.dimen = 1;
loop.from[0] = gfc_index_zero_node;
@ -5143,7 +5143,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
}
/* Otherwise, act on the components or recursively call self to
act on a chain of components. */
act on a chain of components. */
for (c = der_type->components; c; c = c->next)
{
bool cmp_has_alloc_comps = (c->ts.type == BT_DERIVED)

30
gcc/fortran/trans-common.c
View file

@ -417,7 +417,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
backend declarations for all of the elements. */
static void
create_common (gfc_common_head *com, segment_info * head, bool saw_equiv)
create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
{
segment_info *s, *next_s;
tree union_type;
@ -483,8 +483,10 @@ create_common (gfc_common_head *com, segment_info * head, bool saw_equiv)
}
/* Add the initializer for this field. */
tmp = gfc_conv_initializer (s->sym->value, &s->sym->ts,
TREE_TYPE (s->field), s->sym->attr.dimension,
s->sym->attr.pointer || s->sym->attr.allocatable);
TREE_TYPE (s->field),
s->sym->attr.dimension,
s->sym->attr.pointer
|| s->sym->attr.allocatable);
CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
offset = s->offset + s->length;
@ -785,7 +787,7 @@ find_equivalence (segment_info *n)
}
/* Add all symbols equivalenced within a segment. We need to scan the
/* Add all symbols equivalenced within a segment. We need to scan the
segment list multiple times to include indirect equivalences. Since
a new segment_info can inserted at the beginning of the segment list,
depending on its offset, we have to force a final pass through the
@ -827,7 +829,7 @@ add_equivalences (bool *saw_equiv)
Sets *palign to the required alignment. */
static HOST_WIDE_INT
align_segment (unsigned HOST_WIDE_INT * palign)
align_segment (unsigned HOST_WIDE_INT *palign)
{
segment_info *s;
unsigned HOST_WIDE_INT offset;
@ -864,7 +866,7 @@ align_segment (unsigned HOST_WIDE_INT * palign)
/* Adjust segment offsets by the given amount. */
static void
apply_segment_offset (segment_info * s, HOST_WIDE_INT offset)
apply_segment_offset (segment_info *s, HOST_WIDE_INT offset)
{
for (; s; s = s->next)
s->offset += offset;
@ -999,7 +1001,8 @@ finish_equivalences (gfc_namespace *ns)
sym = z->expr->symtree->n.sym;
current_segment = get_segment_info (sym, 0);
/* All objects directly or indirectly equivalenced with this symbol. */
/* All objects directly or indirectly equivalenced with this
symbol. */
add_equivalences (&dummy);
/* Align the block. */
@ -1010,16 +1013,17 @@ finish_equivalences (gfc_namespace *ns)
apply_segment_offset (current_segment, offset);
/* Create the decl. If this is a module equivalence, it has a unique
name, pointed to by z->module. This is written to a gfc_common_header
to push create_common into using build_common_decl, so that the
equivalence appears as an external symbol. Otherwise, a local
declaration is built using build_equiv_decl.*/
/* Create the decl. If this is a module equivalence, it has a
unique name, pointed to by z->module. This is written to a
gfc_common_header to push create_common into using
build_common_decl, so that the equivalence appears as an
external symbol. Otherwise, a local declaration is built using
build_equiv_decl. */
if (z->module)
{
c = gfc_get_common_head ();
/* We've lost the real location, so use the location of the
enclosing procedure. */
enclosing procedure. */
c->where = ns->proc_name->declared_at;
strcpy (c->name, z->module);
}

2
gcc/fortran/trans-decl.c
View file

@ -2909,7 +2909,7 @@ generate_expr_decls (gfc_symbol *sym, gfc_expr *e)
}
/* Check for dependencies in the character length and array spec. */
/* Check for dependencies in the character length and array spec. */
static void
generate_dependency_declarations (gfc_symbol *sym)

4
gcc/fortran/trans-intrinsic.c
View file

@ -2025,7 +2025,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * se, gfc_expr * expr, int op)
/* We start with the most negative possible value for MAXLOC, and the most
positive possible value for MINLOC. The most negative possible value is
-HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
possible value is HUGE in both cases. */
possible value is HUGE in both cases. */
if (op == GT_EXPR)
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);
gfc_add_modify_expr (&se->pre, limit, tmp);
@ -2191,7 +2191,7 @@ gfc_conv_intrinsic_minmaxval (gfc_se * se, gfc_expr * expr, int op)
/* We start with the most negative possible value for MAXVAL, and the most
positive possible value for MINVAL. The most negative possible value is
-HUGE for BT_REAL and (-HUGE - 1) for BT_INTEGER; the most positive
possible value is HUGE in both cases. */
possible value is HUGE in both cases. */
if (op == GT_EXPR)
tmp = fold_build1 (NEGATE_EXPR, TREE_TYPE (tmp), tmp);

4
gcc/fortran/trans-io.c
View file

@ -1261,7 +1261,7 @@ gfc_new_nml_name_expr (const char * name)
}
/* nml_full_name builds up the fully qualified name of a
derived type component. */
derived type component. */
static char*
nml_full_name (const char* var_name, const char* cmp_name)
@ -1281,7 +1281,7 @@ nml_full_name (const char* var_name, const char* cmp_name)
gfc_symbol or gfc_component backend_decl's. An offset is
provided so that the address of an element of an array of
derived types is returned. This is used in the runtime to
determine that span of the derived type. */
determine that span of the derived type. */
static tree
nml_get_addr_expr (gfc_symbol * sym, gfc_component * c,

2
gcc/fortran/trans-stmt.c
View file

@ -243,7 +243,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
}
/* If there is a dependency, create a temporary and use it
instead of the variable. */
instead of the variable. */
fsym = formal ? formal->sym : NULL;
if (e->expr_type == EXPR_VARIABLE
&& e->rank && fsym

3
gcc/fortran/trans-types.c
View file

@ -77,6 +77,7 @@ gfc_real_info gfc_real_kinds[MAX_REAL_KINDS + 1];
static GTY(()) tree gfc_real_types[MAX_REAL_KINDS + 1];
static GTY(()) tree gfc_complex_types[MAX_REAL_KINDS + 1];
/* The integer kind to use for array indices. This will be set to the
proper value based on target information from the backend. */
@ -1594,7 +1595,7 @@ gfc_return_by_reference (gfc_symbol * sym)
&& sym->ts.type == BT_COMPLEX
&& !sym->attr.intrinsic && !sym->attr.always_explicit)
return 1;
return 0;
}