This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[fortraqn-experiments] More cleanups.
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org
- Date: Wed, 2 May 2007 13:46:29 -0700
- Subject: [fortraqn-experiments] More cleanups.
I committed the next round of clean-up to the
fortran-experiments branch.
2007-05-02 Steven G. Kargl <kargl@gcc.gnu.org>
* interface.c: Whitespace. Fix comment punctuation and grammar.
* module.c: Ditto.
* match.c: Ditto.
* gfortran.h: Whitespace. Fix comment punctuation and grammar.
Remove symbols in prototypes.
* match.h: Ditto.
--
Steve
Index: interface.c
===================================================================
--- interface.c (revision 124352)
+++ interface.c (working copy)
@@ -397,13 +397,12 @@ gfc_compare_derived_types (gfc_symbol *d
int
gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
{
- /* see if one of the typespecs is a BT_VOID, which is what i'm using
- * to allow the funcs like c_f_pointer to accept any pointer type.
- * possibly should narrow this to just the one typespec coming in that
- * is for the formal arg, but oh well.. --Rickett, 12.13.05
- */
- if(ts1->type == BT_VOID || ts2->type == BT_VOID)
- return 1;
+ /* See if one of the typespecs is a BT_VOID, which is what is being used
+ to allow the funcs like c_f_pointer to accept any pointer type.
+ TODO: Possibly should narrow this to just the one typespec coming in
+ that is for the formal arg, but oh well. */
+ if (ts1->type == BT_VOID || ts2->type == BT_VOID)
+ return 1;
if (ts1->type != ts2->type)
return 0;
@@ -431,7 +430,7 @@ compare_type_rank (gfc_symbol *s1, gfc_s
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);
}
@@ -758,7 +757,7 @@ count_types_test (gfc_formal_arglist *f1
continue;
if (arg[i].sym && arg[i].sym->attr.optional)
- continue; /* Skip optional arguments */
+ continue; /* Skip optional arguments. */
arg[i].flag = k;
@@ -907,13 +906,13 @@ compare_interfaces (gfc_symbol *s1, gfc_
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;
@@ -973,7 +972,7 @@ check_interface0 (gfc_interface *p, cons
}
else
{
- /* Duplicate interface */
+ /* Duplicate interface. */
qlast->next = q->next;
gfc_free (q);
q = qlast->next;
@@ -986,8 +985,7 @@ check_interface0 (gfc_interface *p, cons
/* 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,
@@ -999,7 +997,7 @@ check_interface1 (gfc_interface *p, gfc_
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;
@@ -1213,7 +1211,7 @@ compare_parameter (gfc_symbol *formal, g
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);
}
@@ -1246,7 +1244,7 @@ compare_parameter (gfc_symbol *formal, g
break;
if (ref == NULL)
- return 0; /* Not an array element */
+ return 0; /* Not an array element. */
return 1;
}
@@ -1897,7 +1895,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)
@@ -1907,7 +1905,7 @@ find_sym_in_symtree (gfc_symbol *sym)
return st;
}
gfc_internal_error ("Unable to find symbol %s", sym->name);
- /* Not reached */
+ /* Not reached. */
}
@@ -1966,7 +1964,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);
@@ -2055,7 +2053,7 @@ gfc_extend_assign (gfc_code *c, gfc_name
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;
Index: gfortran.h
===================================================================
--- gfortran.h (revision 124352)
+++ gfortran.h (working copy)
@@ -157,13 +157,11 @@ typedef enum
{ FORM_FREE, FORM_FIXED, FORM_UNKNOWN }
gfc_source_form;
+/* Basic types. BT_VOID is used by ISO C BInding so funcs like c_f_pointer
+ can take any arg with the pointer attribute as a param. */
typedef enum
{ BT_UNKNOWN = 1, BT_INTEGER, BT_REAL, BT_COMPLEX,
BT_LOGICAL, BT_CHARACTER, BT_DERIVED, BT_PROCEDURE, BT_HOLLERITH,
- /* this is so funcs like c_f_pointer can take any arg with the
- * pointer attribute as a param.
- * --Rickett, 12.13.05
- */
BT_VOID
}
bt;
@@ -616,8 +614,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. */
@@ -972,12 +970,11 @@ typedef struct gfc_symbol
it uniquely identifies a symbol from an intrinsic module. */
int intmod_sym_id;
- /* this may be repetitive, since the typespec now has a binding
- * label field. --Rickett, 10.17.05
- */
- char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
- /* store a reference to the common_block, if this symbol is in one */
- struct gfc_common_head *common_block;
+ /* This may be repetitive, since the typespec now has a binding
+ label field. */
+ char binding_label[GFC_MAX_BINDING_LABEL_LEN + 1];
+ /* Store a reference to the common_block, if this symbol is in one. */
+ struct gfc_common_head *common_block;
}
gfc_symbol;
@@ -1282,8 +1279,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
{
@@ -1855,7 +1851,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);
@@ -1873,7 +1869,7 @@ void gfc_init_2 (void);
void gfc_done_1 (void);
void gfc_done_2 (void);
-int get_c_kind(const char *c_kind_name, CInteropKind_t kinds_table[]);
+int get_c_kind (const char *, CInteropKind_t *);
/* options.c */
unsigned int gfc_init_options (unsigned int, const char **);
@@ -1931,8 +1927,8 @@ gfc_expr *gfc_enum_initializer (gfc_expr
arith gfc_check_integer_range (mpz_t p, int kind);
/* trans-types.c */
-try gfc_validate_c_kind(gfc_typespec *ts);
-try gfc_check_any_c_kind (gfc_typespec *ts);
+try gfc_validate_c_kind (gfc_typespec *);
+try gfc_check_any_c_kind (gfc_typespec *);
int gfc_validate_kind (bt, int, bool);
extern int gfc_index_integer_kind;
extern int gfc_default_integer_kind;
@@ -1961,7 +1957,7 @@ try gfc_set_default_type (gfc_symbol *,
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 *);
@@ -1972,7 +1968,7 @@ try gfc_add_optional (symbol_attribute *
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 *);
@@ -1995,8 +1991,7 @@ try gfc_add_subroutine (symbol_attribute
try gfc_add_volatile (symbol_attribute *, const char *, locus *);
try gfc_add_access (symbol_attribute *, gfc_access, const char *, locus *);
-try gfc_add_is_bind_c(symbol_attribute *, const char *,locus *,
- int is_proc_lang_bind_spec);
+try gfc_add_is_bind_c(symbol_attribute *, const char *, locus *, int);
try gfc_add_value (symbol_attribute *, const char *, locus *);
try gfc_add_flavor (symbol_attribute *, sym_flavor, const char *, locus *);
try gfc_add_entry (symbol_attribute *, const char *, locus *);
@@ -2031,16 +2026,14 @@ gfc_symbol *gfc_new_symbol (const char *
int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **);
int gfc_find_sym_tree (const char *, gfc_namespace *, int, gfc_symtree **);
int gfc_get_symbol (const char *, gfc_namespace *, gfc_symbol **);
-try verify_c_interop (gfc_typespec *ts, const char *name, locus *where);
-try verify_c_interop_param (gfc_symbol *sym);
-try verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts,
- int is_in_common, gfc_common_head *com_block);
-try verify_bind_c_derived_type (gfc_symbol *derived_sym);
-try verify_com_block_vars_c_interop (gfc_common_head *com_block);
+try verify_c_interop (gfc_typespec *, const char *name, locus *where);
+try verify_c_interop_param (gfc_symbol *);
+try verify_bind_c_sym (gfc_symbol *, gfc_typespec *, int, gfc_common_head *);
+try verify_bind_c_derived_type (gfc_symbol *);
+try verify_com_block_vars_c_interop (gfc_common_head *);
void generate_isocbinding_symbol (const char *, iso_c_binding_symbol, char *);
-gfc_symbol *get_iso_c_sym (gfc_symbol *old_sym, char *new_name,
- char *new_binding_label, int add_optional_arg);
-void copy_formal_args (gfc_symbol *dest, gfc_symbol *src);
+gfc_symbol *get_iso_c_sym (gfc_symbol *, char *, char *, int);
+void copy_formal_args (gfc_symbol *, gfc_symbol *);
int gfc_get_sym_tree (const char *, gfc_namespace *, gfc_symtree **);
int gfc_get_ha_symbol (const char *, gfc_symbol **);
int gfc_get_ha_sym_tree (const char *, gfc_symtree **);
@@ -2049,7 +2042,7 @@ int gfc_symbols_could_alias (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);
@@ -2144,7 +2137,7 @@ try gfc_check_assign_symbol (gfc_symbol
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 +2159,7 @@ try gfc_resolve_iterator (gfc_iterator *
try gfc_resolve_index (gfc_expr *, int);
try gfc_resolve_dim_arg (gfc_expr *);
int gfc_is_formal_arg (void);
-match gfc_iso_c_sub_interface(gfc_code *c, gfc_symbol *sym);
+match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *);
/* array.c */
@@ -2191,7 +2184,7 @@ try gfc_resolve_array_constructor (gfc_e
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 *);
@@ -2199,7 +2192,7 @@ try gfc_array_ref_shape (gfc_array_ref *
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 *);
int gfc_is_compile_time_shape (gfc_array_spec *);
@@ -2214,7 +2207,7 @@ gfc_symbol *gfc_search_interface (gfc_in
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;
Index: module.c
===================================================================
--- module.c (revision 124352)
+++ module.c (working copy)
@@ -409,6 +409,7 @@ find_pointer2 (void *p)
/* Resolve any fixups using a known pointer. */
+
static void
resolve_fixups (fixup_t *f, void *gp)
{
@@ -609,7 +610,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)
@@ -996,7 +997,7 @@ parse_string (void)
len = 0;
- /* See how long the string is */
+ /* See how long the string is. */
for ( ; ; )
{
c = module_char ();
@@ -1027,11 +1028,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. */
}
@@ -1196,7 +1197,7 @@ parse_atom (void)
bad_module ("Bad name");
}
- /* Not reached */
+ /* Not reached. */
}
@@ -1275,7 +1276,7 @@ find_enum (const mstring *m)
bad_module ("find_enum(): Enum not found");
- /* Not reached */
+ /* Not reached. */
}
@@ -1449,8 +1450,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)
@@ -1510,7 +1510,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,
@@ -1558,6 +1557,7 @@ static const mstring attr_bits[] =
minit (NULL, -1)
};
+
/* Specialization of mio_name. */
DECL_MIO_NAME (ab_attribute)
DECL_MIO_NAME (ar_type)
@@ -1652,11 +1652,11 @@ mio_symbol_attribute (symbol_attribute *
if (attr->cray_pointee)
MIO_NAME (ab_attribute) (AB_CRAY_POINTEE, attr_bits);
if(attr->is_bind_c)
- MIO_NAME(ab_attribute) (AB_IS_BIND_C, attr_bits);
+ MIO_NAME(ab_attribute) (AB_IS_BIND_C, attr_bits);
if (attr->is_c_interop)
- MIO_NAME(ab_attribute) (AB_IS_C_INTEROP, attr_bits);
+ MIO_NAME(ab_attribute) (AB_IS_C_INTEROP, attr_bits);
if (attr->is_iso_c)
- MIO_NAME(ab_attribute) (AB_IS_ISO_C, attr_bits);
+ MIO_NAME(ab_attribute) (AB_IS_ISO_C, attr_bits);
if (attr->alloc_comp)
MIO_NAME (ab_attribute) (AB_ALLOC_COMP, attr_bits);
@@ -1699,9 +1699,9 @@ mio_symbol_attribute (symbol_attribute *
case AB_SAVE:
attr->save = 1;
break;
- case AB_VALUE:
- attr->value = 1;
- break;
+ case AB_VALUE:
+ attr->value = 1;
+ break;
case AB_VOLATILE:
attr->volatile_ = 1;
break;
@@ -1756,15 +1756,15 @@ mio_symbol_attribute (symbol_attribute *
case AB_CRAY_POINTEE:
attr->cray_pointee = 1;
break;
- case AB_IS_BIND_C:
- attr->is_bind_c = 1;
- break;
- case AB_IS_C_INTEROP:
- attr->is_c_interop = 1;
- break;
- case AB_IS_ISO_C:
- attr->is_iso_c = 1;
- break;
+ case AB_IS_BIND_C:
+ attr->is_bind_c = 1;
+ break;
+ case AB_IS_C_INTEROP:
+ attr->is_c_interop = 1;
+ break;
+ case AB_IS_ISO_C:
+ attr->is_iso_c = 1;
+ break;
case AB_ALLOC_COMP:
attr->alloc_comp = 1;
break;
@@ -1854,7 +1854,7 @@ mio_typespec (gfc_typespec *ts)
else
mio_symbol_ref (&ts->derived);
- /* Add info for C interop and is_iso_c. */
+ /* Add info for C interop and is_iso_c. */
mio_integer (&ts->is_c_interop);
mio_integer (&ts->is_iso_c);
@@ -2216,7 +2216,6 @@ mio_formal_arglist (gfc_symbol *sym)
{
for (f = sym->formal; f; f = f->next)
mio_symbol_ref (&f->sym);
-
}
else
{
@@ -2300,7 +2299,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;
}
}
}
@@ -2627,7 +2626,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);
@@ -2830,7 +2829,7 @@ mio_expr (gfc_expr **ep)
}
-/* Read and write namelists */
+/* Read and write namelists. */
static void
mio_namelist (gfc_symbol *sym)
@@ -3013,7 +3012,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);
@@ -3181,8 +3180,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)
@@ -3228,9 +3227,9 @@ load_commons (void)
p->threadprivate = 1;
p->use_assoc = 1;
- /* get whether this was a bind(c) common or not */
+ /* Get whether this was a bind(c) common or not. */
mio_integer (&p->is_bind_c);
- /* get the binding label */
+ /* Get the binding label. */
mio_internal_string (p->binding_label);
mio_rparen ();
@@ -3240,9 +3239,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)
@@ -3257,7 +3256,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;
@@ -3311,6 +3310,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. */
@@ -3368,8 +3368,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)
@@ -3444,7 +3443,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);
@@ -3544,8 +3543,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);
@@ -3582,11 +3580,11 @@ read_module (void)
gfc_current_ns);
sym = info->u.rsym.sym;
sym->module = gfc_get_string (info->u.rsym.module);
- /* hmm, can we test this. do we know it will be
- * initialized to zeros?? --Rickett, 03.13.06
- */
- if (info->u.rsym.binding_label[0] != '\0')
- strcpy (sym->binding_label, info->u.rsym.binding_label);
+
+ /* TODO: hmm, can we test this? Do we know it will be
+ initialized to zeros? */
+ if (info->u.rsym.binding_label[0] != '\0')
+ strcpy (sym->binding_label, info->u.rsym.binding_label);
}
st->n.sym = sym;
@@ -3702,7 +3700,7 @@ gfc_check_access (gfc_access specific_ac
}
-/* Write a common block to the module */
+/* Write a common block to the module. */
static void
write_common (gfc_symtree *st)
@@ -3711,8 +3709,7 @@ write_common (gfc_symtree *st)
const char * name;
int flags;
const char *label;
-
-
+
if (st == NULL)
return;
@@ -3732,9 +3729,10 @@ write_common (gfc_symtree *st)
if (p->threadprivate) flags |= 2;
mio_integer (&flags);
- /* write out whether the common block is bind(c) or not */
+ /* Write out whether the common block is bind(c) or not. */
mio_integer(&(p->is_bind_c));
- /* write out the binding label, or the com name if no label given */
+
+ /* Write out the binding label, or the com name if no label given. */
if (p->is_bind_c)
{
label = p->binding_label;
@@ -3749,17 +3747,16 @@ write_common (gfc_symtree *st)
mio_rparen ();
}
-/* Write the blank common block to the module */
+
+/* Write the blank common block to the module. */
static void
write_blank_common (void)
{
const char * name = BLANK_COMMON_NAME;
int saved;
- /* blank commons are not bind(c). the draft probably says this,
- * but i haven't checked. just making it so for now.
- * --Rickett, 04.12.06
- */
+ /* TODO: Blank commons are not bind(c). The F2003 standard probably says
+ this, but it hasn't been checked. Just making it so for now. */
int is_bind_c = 0;
if (gfc_current_ns->blank_common.head == NULL)
@@ -3775,6 +3772,7 @@ write_blank_common (void)
/* Write out whether the common block is bind(c) or not. */
mio_integer (&is_bind_c);
+
/* Write out the binding label, which is BLANK_COMMON_NAME, though
it doesn't matter because the label isn't used. */
mio_pool_string (&name);
@@ -3875,8 +3873,6 @@ write_symbol0 (gfc_symtree *st)
write_symbol (p->integer, sym);
p->u.wsym.state = WRITTEN;
-
- return;
}
@@ -3890,6 +3886,7 @@ write_symbol0 (gfc_symtree *st)
static int
write_symbol1 (pointer_info *p)
{
+
if (p == NULL)
return 0;
@@ -4078,6 +4075,7 @@ read_md5_from_module_file (const char *
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. */
@@ -4135,7 +4133,7 @@ gfc_dump_module (const char *name, int d
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);
@@ -4187,16 +4185,16 @@ sort_iso_c_rename_list (void)
for (curr = gfc_rename_list; curr; curr = curr->next)
{
- c_kind = get_c_kind (curr->use_name, c_interop_kinds_table);
+ c_kind = get_c_kind (curr->use_name, c_interop_kinds_table);
if (c_kind == ISOCBINDING_INVALID || c_kind == ISOCBINDING_LAST)
- {
- gfc_error ("Symbol '%s' referenced at %L does not exist in "
- "intrinsic module ISO_C_BINDING.", curr->use_name,
- &curr->where);
- }
+ {
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", curr->use_name,
+ &curr->where);
+ }
else
- /* Put it in the list. */
- kinds_used[c_kind] = curr;
+ /* Put it in the list. */
+ kinds_used[c_kind] = curr;
}
/* Make a new (sorted) rename list. */
@@ -4211,24 +4209,23 @@ sort_iso_c_rename_list (void)
i++;
curr = tmp_list;
for (; i < ISOCBINDING_NUMBER; i++)
- if (kinds_used[i] != NULL)
- {
- curr->next = kinds_used[i];
- curr = curr->next;
- curr->next = NULL;
- }
+ if (kinds_used[i] != NULL)
+ {
+ curr->next = kinds_used[i];
+ curr = curr->next;
+ curr->next = NULL;
+ }
}
gfc_rename_list = tmp_list;
-
- return;
}
-/* Import the instrinsic ISO_C_BINDING module, generating symbols in the
- current namespace for all named constants, pointer types,
- and procedures in the module unless the only clause was used
- or a rename list was provided. */
+/* Import the instrinsic ISO_C_BINDING module, generating symbols in
+ the current namespace for all named constants, pointer types, and
+ procedures in the module unless the only clause was used or a rename
+ list was provided. */
+
static void
import_iso_c_binding_module (void)
{
@@ -4240,7 +4237,7 @@ import_iso_c_binding_module (void)
char *local_name;
/* Look only in the current namespace. */
- mod_symtree = gfc_find_symtree(gfc_current_ns->sym_root, iso_c_module_name);
+ mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name);
if (mod_symtree == NULL)
{
@@ -4248,9 +4245,9 @@ import_iso_c_binding_module (void)
gfc_get_sym_tree (iso_c_module_name, gfc_current_ns, &mod_symtree);
if (mod_symtree != NULL)
- mod_sym = mod_symtree->n.sym;
+ mod_sym = mod_symtree->n.sym;
else
- gfc_internal_error ("import_iso_c_binding_module(): Unable to "
+ gfc_internal_error ("import_iso_c_binding_module(): Unable to "
"create symbol for %s", iso_c_module_name);
mod_sym->attr.flavor = FL_MODULE;
@@ -4264,23 +4261,23 @@ import_iso_c_binding_module (void)
if (only_flag)
{
/* Sort the rename list because there are dependencies between types
- and procedures (e.g., c_loc needs c_ptr). */
+ and procedures (e.g., c_loc needs c_ptr). */
sort_iso_c_rename_list ();
for (u = gfc_rename_list; u; u = u->next)
- {
- i = get_c_kind (u->use_name, c_interop_kinds_table);
+ {
+ i = get_c_kind (u->use_name, c_interop_kinds_table);
- if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST)
+ if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST)
{
- gfc_error ("Symbol '%s' referenced at %L does not exist in "
- "intrinsic module ISO_C_BINDING.", u->use_name,
- &u->where);
- continue;
- }
+ gfc_error ("Symbol '%s' referenced at %L does not exist in "
+ "intrinsic module ISO_C_BINDING.", u->use_name,
+ &u->where);
+ continue;
+ }
- generate_isocbinding_symbol (iso_c_module_name, i, u->local_name);
- }
+ generate_isocbinding_symbol (iso_c_module_name, i, u->local_name);
+ }
}
else
{
@@ -4294,7 +4291,7 @@ import_iso_c_binding_module (void)
local_name = u->local_name;
u->found = 1;
break;
- }
+ }
}
generate_isocbinding_symbol (iso_c_module_name, i, local_name);
}
@@ -4312,6 +4309,7 @@ import_iso_c_binding_module (void)
/* Add an integer named constant from a given module. */
+
static void
create_int_parameter (const char *name, int value, const char *modname,
intmod_id module, int id)
@@ -4496,8 +4494,8 @@ gfc_use_module (void)
module_fp = gfc_open_intrinsic_module (filename);
if (module_fp == NULL && specified_int)
- gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
- module_name);
+ gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
+ module_name);
}
if (module_fp == NULL)
Index: match.c
===================================================================
--- match.c (revision 124352)
+++ match.c (working copy)
@@ -118,7 +118,7 @@ gfc_match_eos (void)
}
while (c != '\n');
- /* Fall through */
+ /* Fall through. */
case '\n':
return MATCH_YES;
@@ -219,6 +219,7 @@ gfc_match_small_int (int *value)
return m;
}
+
/* This function is the same as the gfc_match_small_int, except that
we're keeping the pointer to the expr. This function could just be
removed and the previously mentioned one modified, though all calls
@@ -226,6 +227,7 @@ gfc_match_small_int (int *value)
them). Return MATCH_ERROR if fail to extract the int; otherwise,
return the result of gfc_match_expr(). The expr (if any) that was
matched is returned in the parameter expr. */
+
match
gfc_match_small_int_expr (int *value, gfc_expr **expr)
{
@@ -499,7 +501,7 @@ gfc_match_name_C (char *buffer)
return MATCH_ERROR;
}
- /* continue to read valid variable name characters */
+ /* Continue to read valid variable name characters. */
do
{
buffer[i++] = c;
@@ -518,14 +520,14 @@ gfc_match_name_C (char *buffer)
old_loc = gfc_current_locus;
- /* get next char; param means we're in a string */
+ /* Get next char; param means we're in a string. */
c = gfc_next_char_literal (1);
} while (ISALNUM (c) || c == '_');
buffer[i] = '\0';
gfc_current_locus = old_loc;
- /* See if we stopped because of whitespace. */
+ /* See if we stopped because of whitespace. */
if (c == ' ')
{
gfc_gobble_whitespace ();
@@ -564,7 +566,7 @@ gfc_match_sym_tree (gfc_symtree **matche
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;
@@ -864,7 +866,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);
@@ -894,7 +896,7 @@ not_yes:
{
case '%':
matches++;
- break; /* Skip */
+ break; /* Skip. */
/* Matches that don't have to be undone */
case 'o':
@@ -1034,7 +1036,6 @@ gfc_match_pointer_assignment (void)
goto cleanup;
}
-
new_st.op = EXEC_POINTER_ASSIGN;
new_st.expr = lvalue;
new_st.expr2 = rvalue;
@@ -1196,7 +1197,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)
@@ -1206,7 +1207,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
@@ -1372,6 +1373,7 @@ cleanup:
void
gfc_free_iterator (gfc_iterator *iter, int flag)
{
+
if (iter == NULL)
return;
@@ -1411,7 +1413,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)
{
@@ -1420,8 +1422,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. */
@@ -1432,15 +1434,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)
@@ -1512,8 +1514,7 @@ match_exit_cycle (gfc_statement st, gfc_
}
}
- /* 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;
@@ -1555,7 +1556,6 @@ match_exit_cycle (gfc_statement st, gfc_
new_st.ext.whichloop = p->head;
new_st.op = op;
-/* new_st.sym = sym;*/
return MATCH_YES;
}
@@ -1642,6 +1642,7 @@ cleanup:
return MATCH_ERROR;
}
+
/* Match the (deprecated) PAUSE statement. */
match
@@ -2013,7 +2014,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))
@@ -2022,13 +2023,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
@@ -2268,7 +2269,7 @@ gfc_match_call (void)
i = 0;
for (a = arglist; a; a = a->next)
if (a->expr == NULL)
- i = 1;
+ i = 1;
if (i)
{
@@ -2279,7 +2280,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;
@@ -2480,7 +2481,7 @@ gfc_match_common (void)
if (m == MATCH_NO)
goto syntax;
- /* store a ref to the common block for error checking */
+ /* Store a ref to the common block for error checking. */
sym->common_block = t;
/* See if we know the current common block is bind(c), and if
@@ -2716,11 +2717,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
@@ -3368,6 +3369,7 @@ cleanup:
return MATCH_ERROR;
}
+
/* Match a WHERE statement. */
match
@@ -3459,7 +3461,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;
@@ -3534,7 +3536,7 @@ match_forall_iterator (gfc_forall_iterat
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;
@@ -3623,7 +3625,7 @@ match_forall_header (gfc_forall_iterator
continue;
}
- /* Have to have a mask expression */
+ /* Have to have a mask expression. */
m = gfc_match_expr (&msk);
if (m == MATCH_NO)
Index: match.h
===================================================================
--- match.h (revision 124352)
+++ match.h (working copy)
@@ -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 *);
@@ -47,7 +48,7 @@ match gfc_match_small_int (int *);
match gfc_match_small_int_expr (int *, gfc_expr **);
int gfc_match_strings (mstring *);
match gfc_match_name (char *);
-match gfc_match_name_C(char *buffer);
+match gfc_match_name_C (char *buffer);
match gfc_match_symbol (gfc_symbol **, int);
match gfc_match_sym_tree (gfc_symtree **, int);
match gfc_match_intrinsic_op (gfc_intrinsic_op *);
@@ -55,7 +56,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);
@@ -76,14 +77,15 @@ match gfc_match_nullify (void);
match gfc_match_deallocate (void);
match gfc_match_return (void);
match gfc_match_call (void);
-/* want to use this function to check for a common-block-name
- * that can exist in a bind statement, so i remove the "static"
- * declaration of the function in match.c. --Rickett, 10.17.05
- *
- * should probably rename this now that it'll be globally seen to
- * something like gfc_match_common_name. --Rickett, 10.17.05
- */
+
+/* We want to use this function to check for a common-block-name
+ that can exist in a bind statement, so removed the "static"
+ declaration of the function in match.c.
+
+ TODO: should probably rename this now that it'll be globally seen to
+ gfc_match_common_name. */
match match_common_name (char *name);
+
match gfc_match_common (void);
match gfc_match_block_data (void);
match gfc_match_namelist (void);
@@ -100,9 +102,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);
@@ -122,7 +124,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 **);
@@ -142,7 +144,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);
@@ -161,23 +163,22 @@ match gfc_match_target (void);
match gfc_match_value (void);
match gfc_match_volatile (void);
-/* F03 c interop */
-/* some of these should be moved to another file rather than decl.c */
-/* decl.c */
-void set_com_block_bind_c (gfc_common_head *com_block, int is_bind_c);
-try set_binding_label (char *dest_label, const char *sym_name,
- int num_idents);
-try set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents);
-try set_verify_bind_c_com_block (gfc_common_head *com_block,
- int num_idents);
+/* decl.c. */
+
+/* Fortran 2003 c interop.
+ TODO: some of these should be moved to another file rather than decl.c */
+void set_com_block_bind_c (gfc_common_head *, int);
+try set_binding_label (char *, const char *, int);
+try set_verify_bind_c_sym (gfc_symbol *, int);
+try set_verify_bind_c_com_block (gfc_common_head *, int);
try get_bind_c_idents (void);
match gfc_match_bind_c_stmt (void);
match gfc_match_proc_decl_stmt (void);
-match gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result);
-match gfc_match_bind_c (gfc_symbol *sym);
-match gfc_get_type_attr_spec (symbol_attribute *attr);
+match gfc_match_suffix (gfc_symbol *, gfc_symbol **);
+match gfc_match_bind_c (gfc_symbol *);
+match gfc_get_type_attr_spec (symbol_attribute *);
-/* primary.c */
+/* primary.c. */
match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **);
match gfc_match_rvalue (gfc_expr **);
match gfc_match_variable (gfc_expr **, int);
@@ -190,17 +191,17 @@ match gfc_match_literal_constant (gfc_ex
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);
@@ -213,11 +214,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);