aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSteven G. Kargl <kargl@gcc.gnu.org>2007-06-07 18:10:31 +0000
committerBrooks Moses <brooks@gcc.gnu.org>2007-06-07 11:10:31 -0700
commit66e4ab31274a1e661befd9534463d158c54a55a2 (patch)
treea5d4d0d32adbc5ce952e0f81a156f8590ce3ee2f
parentbb27eeda7dc859c9d1c9a69baea30f9cf273ec4a (diff)
downloadgcc-66e4ab31274a1e661befd9534463d158c54a55a2.zip
gcc-66e4ab31274a1e661befd9534463d158c54a55a2.tar.gz
gcc-66e4ab31274a1e661befd9534463d158c54a55a2.tar.bz2
decl.c: Miscellaneous whitespace fixes.
* 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
Diffstat
-rw-r--r--gcc/fortran/ChangeLog21
-rw-r--r--gcc/fortran/decl.c63
-rw-r--r--gcc/fortran/expr.c38
-rw-r--r--gcc/fortran/gfortran.h23
-rw-r--r--gcc/fortran/interface.c27
-rw-r--r--gcc/fortran/io.c2
-rw-r--r--gcc/fortran/match.c64
-rw-r--r--gcc/fortran/match.h27
-rw-r--r--gcc/fortran/module.c53
-rw-r--r--gcc/fortran/parse.c2
-rw-r--r--gcc/fortran/resolve.c12
-rw-r--r--gcc/fortran/symbol.c266
-rw-r--r--gcc/fortran/trans-array.c6
-rw-r--r--gcc/fortran/trans-common.c30
-rw-r--r--gcc/fortran/trans-decl.c2
-rw-r--r--gcc/fortran/trans-intrinsic.c4
-rw-r--r--gcc/fortran/trans-io.c4
-rw-r--r--gcc/fortran/trans-stmt.c2
-rw-r--r--gcc/fortran/trans-types.c3
19 files changed, 339 insertions, 310 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cdf96cd..4a7edfd 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 9eeacc0..82d3e66 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -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)
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 849b406..00ed9a0 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -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)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index cd0dfd1..aa4c035 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 22a39b5..c30b4d6 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -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;
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 19a4437..8e81d6a 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -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)
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index c2c239d..0f99a52 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -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)
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index 3ed673f..ffba102 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -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);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 132de38..876255f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -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);
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 761e631..0daac0c 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -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)
{
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8a9f167..74aa915 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index ba48e54..5215c3e 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -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);
}
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 08ce144..8b13e67 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -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)
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index a96c474..bde7ea5 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -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);
}
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 8c564cb..0ab2d74 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -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)
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index a6cdc4f..6bd867b 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -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);
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index e543f4c..a1a0570 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -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,
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index b1cd029..51586c8 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -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
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 0cd284b..20d1718 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -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;
}
generated by cgit v1.1 at 2024-10-02 06:16:38 +0000