This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] Merge whitespace fixes from fortran-experiments branch
- From: Brooks Moses <brooks dot moses at codesourcery dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 07 Jun 2007 02:02:25 -0700
- Subject: [patch, fortran] Merge whitespace fixes from fortran-experiments branch
Steve Kargl spent quite a lot of time fixing whitespace problems with
the early versions of the ISO C binding implementation on the
fortran-experiments branch. When I was reviewing the recent branch diff
file, I noticed that he did a sufficiently good job of this that he also
fixed quite a lot of problems that predated the ISO C binding work, and
thus also exist on the trunk.
By "quite a lot", I mean 2500 lines of patch file. (!)
In my opinion, it would be useful to go ahead and merge those whitespace
fixes to the trunk now, independently of the rest of the branch merging
process. That should make it easier to review the substantive changes
on the branch when we get to that point.
Attached is a patch for trunk containing these whitespace fixes -- and,
in particular, only the whitespace fixes that are sufficiently far away
from the ISO C binding changes to avoid producing merge conflicts later.
I've build-tested it on powerpc-apple-darwin8.9.0, and am currently
regression-testing it. Ok to commit (assuming it passes reg-testing)?
Steve, what's your preference for the name on the changelog -- am I
correct in putting your name on it? (Or would you prefer that I take
the blame in case something goes wrong? :) )
- Brooks
---------------------------------------------------------------
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.
---------------------------------------------------------------
Index: interface.c
===================================================================
--- interface.c (.../trunk/gcc/fortran) (revision 125520)
+++ interface.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -423,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);
}
@@ -750,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;
@@ -899,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;
@@ -965,7 +972,7 @@ check_interface0 (gfc_interface *p, cons
}
else
{
- /* Duplicate interface */
+ /* Duplicate interface. */
qlast->next = q->next;
gfc_free (q);
q = qlast->next;
@@ -978,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,
@@ -991,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;
@@ -1193,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);
}
@@ -1226,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;
}
@@ -1905,7 +1923,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 +1933,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 +1992,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 +2081,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: trans-array.c
===================================================================
--- trans-array.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-array.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -5009,7 +5009,7 @@ gfc_duplicate_allocatable(tree dest, tre
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_
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_
}
/* 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)
Index: symbol.c
===================================================================
--- symbol.c (.../trunk/gcc/fortran) (revision 125520)
+++ symbol.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -167,7 +168,7 @@ gfc_add_new_implicit_range (int c1, int
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 +200,7 @@ gfc_merge_new_implicit (gfc_typespec * t
/* 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 +226,7 @@ gfc_get_default_type (gfc_symbol * sym,
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 +332,7 @@ gfc_check_function_type (gfc_namespace *
}
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 +387,8 @@ check_conflict (symbol_attribute * attr,
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 +497,8 @@ check_conflict (symbol_attribute * attr,
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 +526,6 @@ check_conflict (symbol_attribute * attr,
&& attr->flavor != FL_PROCEDURE
&& attr->flavor != FL_UNKNOWN)
{
-
a2 = in_namelist;
goto conflict;
}
@@ -520,18 +560,18 @@ check_conflict (symbol_attribute * attr,
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 +679,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 +699,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 +722,7 @@ check_used (symbol_attribute * attr, con
/* 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 +731,14 @@ duplicate_attr (const char *attr, locus
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 +746,7 @@ gfc_add_attribute (symbol_attribute * at
}
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 +764,7 @@ gfc_add_allocatable (symbol_attribute *
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 +782,7 @@ gfc_add_dimension (symbol_attribute * at
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 +801,7 @@ gfc_add_external (symbol_attribute * att
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 +820,7 @@ gfc_add_intrinsic (symbol_attribute * at
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 +838,7 @@ gfc_add_optional (symbol_attribute * att
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 +850,7 @@ gfc_add_pointer (symbol_attribute * attr
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 +862,7 @@ gfc_add_cray_pointer (symbol_attribute *
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 +879,9 @@ gfc_add_cray_pointee (symbol_attribute *
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 +899,9 @@ gfc_add_protected (symbol_attribute * at
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 +913,7 @@ gfc_add_result (symbol_attribute * attr,
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 +940,9 @@ gfc_add_save (symbol_attribute * attr, c
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 +961,9 @@ gfc_add_value (symbol_attribute * attr,
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 +982,9 @@ gfc_add_volatile (symbol_attribute * att
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 +1000,7 @@ gfc_add_threadprivate (symbol_attribute
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 +1018,7 @@ gfc_add_target (symbol_attribute * attr,
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 +1031,7 @@ gfc_add_dummy (symbol_attribute * attr,
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 +1048,9 @@ gfc_add_in_common (symbol_attribute * at
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 +1078,7 @@ gfc_add_data (symbol_attribute *attr, co
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 +1087,7 @@ gfc_add_in_namelist (symbol_attribute *
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 +1099,7 @@ gfc_add_sequence (symbol_attribute * att
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 +1111,7 @@ gfc_add_elemental (symbol_attribute * at
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 +1123,7 @@ gfc_add_pure (symbol_attribute * attr, l
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 +1135,7 @@ gfc_add_recursive (symbol_attribute * at
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 +1153,7 @@ gfc_add_entry (symbol_attribute * attr,
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 +1166,7 @@ gfc_add_function (symbol_attribute * att
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 +1179,7 @@ gfc_add_subroutine (symbol_attribute * a
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 +1195,8 @@ gfc_add_generic (symbol_attribute * attr
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 +1231,8 @@ gfc_add_flavor (symbol_attribute * attr,
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 +1267,7 @@ gfc_add_procedure (symbol_attribute * at
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 +1293,8 @@ gfc_add_intent (symbol_attribute * attr,
/* 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 +1366,7 @@ gfc_add_explicit_interface (gfc_symbol *
/* 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 +1377,23 @@ gfc_add_type (gfc_symbol * sym, gfc_type
{
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 +1408,9 @@ gfc_add_type (gfc_symbol * sym, gfc_type
/* 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 +1418,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 +1452,8 @@ gfc_copy_attr (symbol_attribute * dest,
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 +1547,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 +1586,7 @@ gfc_add_component (gfc_symbol * sym, con
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 +1621,7 @@ switch_types (gfc_symtree * st, gfc_symb
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 +1679,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 +1716,7 @@ gfc_find_component (gfc_symbol * sym, co
they point to. */
static void
-free_components (gfc_component * p)
+free_components (gfc_component *p)
{
gfc_component *q;
@@ -1639,11 +1732,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 +1748,7 @@ gfc_set_component_attr (gfc_component *
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 +1764,10 @@ gfc_get_component_attr (symbol_attribute
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 +1778,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 +1792,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 +1850,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 +1897,7 @@ gfc_define_st_label (gfc_st_label * lp,
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 +1962,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 +1986,7 @@ gfc_get_namespace (gfc_namespace * paren
if (parent_types && ns->parent != NULL)
{
- /* Copy parent settings */
+ /* Copy parent settings. */
*ts = ns->parent->default_type[i - 'a'];
continue;
}
@@ -1923,7 +2018,7 @@ gfc_get_namespace (gfc_namespace * paren
/* 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 +2032,7 @@ compare_symtree (void * _st1, void * _st
/* 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 +2047,7 @@ gfc_new_symtree (gfc_symtree ** root, co
/* 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 +2064,7 @@ delete_symtree (gfc_symtree ** root, con
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 +2110,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 +2125,7 @@ gfc_find_uop (const char *name, gfc_name
/* 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 +2153,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 +2186,7 @@ gfc_new_symbol (const char *name, gfc_na
/* 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 +2203,8 @@ ambiguous_symbol (const char *name, gfc_
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 +2243,8 @@ gfc_find_sym_tree (const char *name, gfc
/* 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 +2263,7 @@ gfc_find_symbol (const char *name, gfc_n
/* 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 +2289,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 +2351,11 @@ gfc_get_sym_tree (const char *name, gfc_
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 +2372,7 @@ gfc_get_symbol (const char *name, gfc_na
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 +2381,6 @@ gfc_get_ha_sym_tree (const char *name, g
if (st != NULL)
{
save_symbol_data (st->n.sym);
-
*result = st;
return i;
}
@@ -2300,7 +2403,7 @@ gfc_get_ha_sym_tree (const char *name, g
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 +2422,7 @@ gfc_get_ha_symbol (const char *name, gfc
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 +2500,6 @@ gfc_undo_symbols (void)
}
else
{
-
if (p->namelist_tail != old->namelist_tail)
{
gfc_free_namelist (old->namelist_tail);
@@ -2429,8 +2531,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 +2565,6 @@ gfc_commit_symbols (void)
p->tlink = NULL;
p->mark = 0;
p->new = 0;
-
free_old_symbol (p);
}
changed_syms = NULL;
@@ -2473,7 +2575,7 @@ gfc_commit_symbols (void)
information. */
void
-gfc_commit_symbol (gfc_symbol * sym)
+gfc_commit_symbol (gfc_symbol *sym)
{
gfc_symbol *p;
@@ -2517,7 +2619,7 @@ free_common_tree (gfc_symtree * common_t
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 +2639,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 +2694,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 +2706,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 +2721,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 +2765,6 @@ gfc_free_namespace (gfc_namespace * ns)
{
q = p;
p = p->sibling;
-
gfc_free_namespace (q);
}
}
@@ -2690,7 +2791,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 +2801,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 +2816,7 @@ gfc_traverse_symtree (gfc_symtree * st,
/* 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 +2835,7 @@ traverse_ns (gfc_symtree * st, void (*fu
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 +2845,9 @@ gfc_traverse_ns (gfc_namespace * ns, voi
/* 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 +2867,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 +2887,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 +2935,13 @@ gfc_find_gsymbol (gfc_gsymbol *symbol, c
/* 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);
}
Index: decl.c
===================================================================
--- decl.c (.../trunk/gcc/fortran) (revision 125520)
+++ decl.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -141,7 +150,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 +453,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 +646,7 @@ find_special (const char *name, gfc_symb
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 +737,7 @@ get_proc_name (const char *name, gfc_sym
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 +903,7 @@ build_sym (const char *name, gfc_charlen
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, ¤t_ts))
@@ -831,7 +1011,7 @@ gfc_set_constant_character_len (int len,
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 +1065,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 +1128,8 @@ add_init_expr_to_sym (const char *name,
/* 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 +1437,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 +1832,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 +1859,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 +2139,7 @@ match_implicit_range (void)
switch (c)
{
case ')':
- inner = 0; /* Fall through */
+ inner = 0; /* Fall through. */
case ',':
c2 = c1;
@@ -2068,6 +2312,7 @@ error:
return MATCH_ERROR;
}
+
match
gfc_match_import (void)
{
@@ -2076,8 +2321,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 +2356,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 +2412,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
@@ -2319,7 +2586,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 +3658,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 +3677,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 +3823,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 +4522,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 +4559,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 +5413,7 @@ syntax:
return MATCH_ERROR;
}
+
match
gfc_match_volatile (void)
{
@@ -4315,7 +5467,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 +5814,7 @@ cleanup:
}
-/* Match the enumerator definition statement. */
+/* Match the enumerator definition statement. */
match
gfc_match_enumerator_def (void)
Index: trans-common.c
===================================================================
--- trans-common.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-common.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -417,7 +447,7 @@ build_common_decl (gfc_common_head *com,
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 +513,10 @@ create_common (gfc_common_head *com, seg
}
/* 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 +817,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 +859,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 +896,7 @@ align_segment (unsigned HOST_WIDE_INT *
/* 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 +1031,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 +1043,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);
}
Index: gfortran.h
===================================================================
--- gfortran.h (.../trunk/gcc/fortran) (revision 125520)
+++ gfortran.h (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -619,8 +690,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 +1355,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 +1938,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 +2044,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 *);
@@ -1960,7 +2055,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 *);
@@ -2025,7 +2129,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);
@@ -2121,7 +2225,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 +2272,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 *);
@@ -2174,7 +2280,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 *);
try spec_dimen_size (gfc_array_spec *, int, mpz_t *);
int gfc_is_compile_time_shape (gfc_array_spec *);
@@ -2190,7 +2296,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: trans-stmt.c
===================================================================
--- trans-stmt.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-stmt.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -243,7 +243,7 @@ gfc_conv_elemental_dependencies (gfc_se
}
/* 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
Index: expr.c
===================================================================
--- expr.c (.../trunk/gcc/fortran) (revision 125520)
+++ expr.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -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,
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 +489,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 +708,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 +783,7 @@ simplify_intrinsic_op (gfc_expr *p, int
|| (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 +1341,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 +1423,7 @@ simplify_ref_chain (gfc_ref *ref, int ty
/* Try to substitute the value of a parameter variable. */
+
static try
simplify_parameter_variable (gfc_expr *p, int type)
{
@@ -1429,8 +1441,7 @@ simplify_parameter_variable (gfc_expr *p
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 +2179,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 +2259,7 @@ check_restricted (gfc_expr *e)
try
gfc_specification_expr (gfc_expr *e)
{
+
if (e == NULL)
return SUCCESS;
@@ -2352,18 +2363,18 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
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 +2382,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
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 +2390,11 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
|| 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 +2437,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_
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)
Index: module.c
===================================================================
--- module.c (.../trunk/gcc/fortran) (revision 125520)
+++ module.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -399,6 +409,7 @@ find_pointer2 (void *p)
/* Resolve any fixups using a known pointer. */
+
static void
resolve_fixups (fixup_t *f, void *gp)
{
@@ -599,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)
@@ -986,7 +997,7 @@ parse_string (void)
len = 0;
- /* See how long the string is */
+ /* See how long the string is. */
for ( ; ; )
{
c = module_char ();
@@ -1017,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. */
}
@@ -1186,7 +1197,7 @@ parse_atom (void)
bad_module ("Bad name");
}
- /* Not reached */
+ /* Not reached. */
}
@@ -1265,7 +1276,7 @@ find_enum (const mstring *m)
bad_module ("find_enum(): Enum not found");
- /* Not reached */
+ /* Not reached. */
}
@@ -1436,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)
@@ -1497,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,
@@ -2171,7 +2216,6 @@ mio_formal_arglist (gfc_symbol *sym)
{
for (f = sym->formal; f; f = f->next)
mio_symbol_ref (&f->sym);
-
}
else
{
@@ -2271,7 +2315,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 +2642,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 +2845,7 @@ mio_expr (gfc_expr **ep)
}
-/* Read and write namelists */
+/* Read and write namelists. */
static void
mio_namelist (gfc_symbol *sym)
@@ -2982,7 +3028,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 +3196,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 +3255,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 +3272,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 +3326,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 +3384,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 +3459,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 +3559,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 +3716,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)
@@ -3794,6 +3902,7 @@ write_symbol0 (gfc_symtree *st)
static int
write_symbol1 (pointer_info *p)
{
+
if (p == NULL)
return 0;
@@ -3982,6 +4091,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. */
@@ -4039,7 +4149,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);
Index: trans-types.c
===================================================================
--- trans-types.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-types.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -77,6 +80,7 @@ gfc_real_info gfc_real_kinds[MAX_REAL_KI
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 +1791,7 @@ gfc_return_by_reference (gfc_symbol * sy
&& sym->ts.type == BT_COMPLEX
&& !sym->attr.intrinsic && !sym->attr.always_explicit)
return 1;
-
+
return 0;
}
Index: io.c
===================================================================
--- io.c (.../trunk/gcc/fortran) (revision 125520)
+++ io.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -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)
Index: resolve.c
===================================================================
--- resolve.c (.../trunk/gcc/fortran) (revision 125520)
+++ resolve.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -2027,7 +2469,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 +6174,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 +6274,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 +6557,7 @@ resolve_fl_procedure (gfc_symbol *sym, i
/* 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 +7718,7 @@ resolve_equivalence_derived (gfc_symbol
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 +8014,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)
Index: trans-decl.c
===================================================================
--- trans-decl.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-decl.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -2909,7 +2979,7 @@ generate_expr_decls (gfc_symbol *sym, gf
}
-/* 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)
Index: match.c
===================================================================
--- match.c (.../trunk/gcc/fortran) (revision 125520)
+++ match.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -118,7 +118,7 @@ gfc_match_eos (void)
}
while (c != '\n');
- /* Fall through */
+ /* Fall through. */
case '\n':
return MATCH_YES;
@@ -441,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;
@@ -741,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);
@@ -771,7 +896,7 @@ not_yes:
{
case '%':
matches++;
- break; /* Skip */
+ break; /* Skip. */
/* Matches that don't have to be undone */
case 'o':
@@ -911,7 +1036,6 @@ gfc_match_pointer_assignment (void)
goto cleanup;
}
-
new_st.op = EXEC_POINTER_ASSIGN;
new_st.expr = lvalue;
new_st.expr2 = rvalue;
@@ -1073,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)
@@ -1083,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
@@ -1249,6 +1373,7 @@ cleanup:
void
gfc_free_iterator (gfc_iterator *iter, int flag)
{
+
if (iter == NULL)
return;
@@ -1288,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)
{
@@ -1297,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. */
@@ -1309,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)
@@ -1389,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;
@@ -1432,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;
}
@@ -1519,6 +1642,7 @@ cleanup:
return MATCH_ERROR;
}
+
/* Match the (deprecated) PAUSE statement. */
match
@@ -1890,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))
@@ -1899,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
@@ -2145,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)
{
@@ -2156,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;
@@ -2565,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
@@ -2776,7 +2928,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 +3369,7 @@ cleanup:
return MATCH_ERROR;
}
+
/* Match a WHERE statement. */
match
@@ -3308,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;
@@ -3383,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;
@@ -3472,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: trans-io.c
===================================================================
--- trans-io.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-io.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -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, con
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,
Index: match.h
===================================================================
--- match.h (.../trunk/gcc/fortran) (revision 125520)
+++ match.h (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -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 +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);
@@ -90,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);
@@ -112,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 **);
@@ -132,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);
@@ -163,17 +190,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);
@@ -186,11 +213,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);
Index: parse.c
===================================================================
--- parse.c (.../trunk/gcc/fortran) (revision 125520)
+++ parse.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -42,6 +42,7 @@ static void check_statement_label (gfc_s
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 +743,6 @@ push_state (gfc_state_data *p, gfc_compi
/* Pop the current state. */
-
static void
pop_state (void)
{
Index: trans-intrinsic.c
===================================================================
--- trans-intrinsic.c (.../trunk/gcc/fortran) (revision 125520)
+++ trans-intrinsic.c (.../branches/fortran-experiments/gcc/fortran) (revision 125520)
@@ -2025,7 +2025,7 @@ gfc_conv_intrinsic_minmaxloc (gfc_se * s
/* 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 * s
/* 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);