This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[fortran-experiments] Patch applied.
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org
- Date: Mon, 30 Apr 2007 20:34:36 -0700
- Subject: [fortran-experiments] Patch applied.
If anyone cares, I've committed the attached patch.
2207-04-30 Steven G. Kargl <kargl@gcc.gnu.org>
* symbol.c: Whitespace. Fix comment punctuation and gammar.
* decl.c: Ditto.
* trans-common.c: Ditto.
* expr.c: Ditto.
--
Steve
Index: symbol.c
===================================================================
--- symbol.c (revision 124313)
+++ symbol.c (working copy)
@@ -168,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;
@@ -200,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;
@@ -226,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;
@@ -260,10 +260,10 @@ gfc_set_default_type (gfc_symbol * sym,
if (sym->attr.dummy != 0)
{
- if (sym->ns->proc_name != NULL &&
- (sym->ns->proc_name->attr.subroutine != 0 ||
- sym->ns->proc_name->attr.function != 0) &&
- sym->ns->proc_name->attr.is_bind_c != 0)
+ if (sym->ns->proc_name != NULL
+ && (sym->ns->proc_name->attr.subroutine != 0
+ || sym->ns->proc_name->attr.function != 0)
+ && sym->ns->proc_name->attr.is_bind_c != 0)
{
/* Dummy args to a BIND(C) routine may not be interoperable if
they are implicitly typed. */
@@ -327,7 +327,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",
@@ -382,8 +382,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;
}
}
@@ -393,8 +393,8 @@ check_conflict (symbol_attribute * attr,
conf (dummy, save);
conf (dummy, threadprivate);
conf (pointer, target);
- if(attr->in_proc_decl != 1)
- conf (pointer, external);
+ if (attr->in_proc_decl != 1)
+ conf (pointer, external);
conf (pointer, intrinsic);
conf (pointer, elemental);
conf (allocatable, elemental);
@@ -449,10 +449,9 @@ check_conflict (symbol_attribute * attr,
conf (is_bind_c, cray_pointee);
conf (is_bind_c, allocatable);
- /* need to also get volatile attr, according to
- * section 5.1 of f03 draft. parameter conflict caught below..
- * also, value cannot be specified for a dummy procedure.
- */
+ /* Need to also get volatile attr, according to 5.1 of F2003 draft.
+ Parameter conflict caught below. Also, value cannot be specified
+ for a dummy procedure. */
/* Cray pointer/pointee conflicts. */
conf (cray_pointer, cray_pointee);
@@ -493,7 +492,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;
@@ -520,7 +520,6 @@ check_conflict (symbol_attribute * attr,
&& attr->flavor != FL_VARIABLE
&& attr->flavor != FL_UNKNOWN)
{
-
a2 = in_namelist;
goto conflict;
}
@@ -555,18 +554,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)
@@ -631,7 +630,7 @@ check_conflict (symbol_attribute * attr,
conf2 (value);
conf2 (volatile_);
conf2 (threadprivate);
- /* hmm, double check this.. --Rickett, 01.24.06 */
+ /* TODO: hmm, double check this. */
conf2 (value);
break;
@@ -674,8 +673,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;
@@ -693,7 +693,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)
@@ -716,7 +716,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)
@@ -725,11 +725,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;
@@ -737,7 +740,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))
@@ -755,7 +758,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))
@@ -773,7 +776,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))
@@ -792,7 +795,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))
@@ -811,7 +814,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))
@@ -829,7 +832,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))
@@ -841,7 +844,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))
@@ -853,7 +856,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))
@@ -870,8 +873,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;
@@ -889,8 +893,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))
@@ -902,7 +907,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))
@@ -931,7 +936,7 @@ gfc_add_save (symbol_attribute * attr, c
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))
@@ -952,7 +957,7 @@ gfc_add_value (symbol_attribute * attr,
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
@@ -971,8 +976,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;
@@ -988,7 +994,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))
@@ -1006,7 +1012,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))
@@ -1019,7 +1025,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))
@@ -1036,8 +1042,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. */
@@ -1065,8 +1072,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;
@@ -1075,7 +1081,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))
@@ -1087,7 +1093,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))
@@ -1099,7 +1105,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))
@@ -1111,7 +1117,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))
@@ -1123,7 +1129,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))
@@ -1141,7 +1147,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
@@ -1154,7 +1160,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
@@ -1167,7 +1173,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
@@ -1183,8 +1189,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
@@ -1214,8 +1220,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))
@@ -1250,7 +1256,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))
@@ -1276,8 +1282,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)
@@ -1293,19 +1299,21 @@ gfc_add_access (symbol_attribute * attr,
return FAILURE;
}
+
/* Set the is_bind_c field for the given symbol_attribute. */
try
gfc_add_is_bind_c (symbol_attribute *attr, const char *name, locus *where,
int is_proc_lang_bind_spec)
{
+
if (is_proc_lang_bind_spec == 0 && attr->flavor == FL_PROCEDURE)
- gfc_error_now ("BIND(C) attribute at %L can only be used for "
- "variables or common blocks", where);
+ gfc_error_now ("BIND(C) attribute at %L can only be used for "
+ "variables or common blocks", where);
else if (attr->is_bind_c)
- gfc_error_now ("Duplicate BIND attribute specified at %L", where);
+ gfc_error_now ("Duplicate BIND attribute specified at %L", where);
else
- attr->is_bind_c = 1;
+ attr->is_bind_c = 1;
if (where == NULL)
where = &gfc_current_locus;
@@ -1319,8 +1327,8 @@ gfc_add_is_bind_c (symbol_attribute *att
try
-gfc_add_explicit_interface (gfc_symbol * sym, ifsrc source,
- gfc_formal_arglist * formal, locus * where)
+gfc_add_explicit_interface (gfc_symbol *sym, ifsrc source,
+ gfc_formal_arglist * formal, locus *where)
{
if (check_used (&sym->attr, sym->name, where))
@@ -1347,7 +1355,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;
@@ -1358,23 +1366,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);
@@ -1389,9 +1397,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));
}
@@ -1399,8 +1407,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;
@@ -1412,7 +1420,7 @@ gfc_missing_attr (symbol_attribute * att
where we are called from, so we ignore some bits. */
try
-gfc_copy_attr (symbol_attribute * dest, symbol_attribute * src, locus * where)
+gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
{
int is_proc_lang_bind_spec;
@@ -1433,7 +1441,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;
@@ -1497,7 +1506,7 @@ gfc_copy_attr (symbol_attribute * dest,
is_proc_lang_bind_spec = (src->flavor == FL_PROCEDURE ? 1 : 0);
if (src->is_bind_c
&& gfc_add_is_bind_c (dest, NULL, where, is_proc_lang_bind_spec)
- != SUCCESS)
+ != SUCCESS)
return FAILURE;
if (src->is_c_interop)
@@ -1527,7 +1536,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;
@@ -1565,7 +1575,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;
@@ -1600,7 +1610,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;
@@ -1658,7 +1668,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;
@@ -1695,7 +1705,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;
@@ -1711,11 +1721,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;
@@ -1728,7 +1737,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);
@@ -1744,10 +1753,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);
}
@@ -1758,8 +1767,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;
@@ -1771,11 +1781,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;
@@ -1827,7 +1839,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;
@@ -1874,7 +1886,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;
@@ -1939,7 +1951,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;
@@ -1963,7 +1975,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;
}
@@ -1995,7 +2007,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;
@@ -2009,7 +2021,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;
@@ -2024,7 +2036,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;
@@ -2041,7 +2053,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;
@@ -2087,7 +2099,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;
@@ -2102,7 +2114,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)
@@ -2130,7 +2142,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;
@@ -2147,13 +2159,13 @@ gfc_new_symbol (const char *name, gfc_na
p->name = gfc_get_string (name);
- /* make sure flag for symbol being C bound is clear initially */
+ /* Make sure flags for symbol being C bound are clear initially. */
p->attr.is_bind_c = 0;
p->attr.is_iso_c = 0;
- /* make sure the binding label field has a nil char to start */
+ /* Make sure the binding label field has a Nul char to start. */
p->binding_label[0] = '\0';
- /* clear the ptrs we may need */
+ /* Clear the ptrs we may need. */
p->common_block = NULL;
return p;
@@ -2163,7 +2175,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)
@@ -2180,8 +2192,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;
@@ -2220,8 +2232,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;
@@ -2240,7 +2252,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)
@@ -2266,7 +2278,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;
@@ -2328,12 +2340,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;
@@ -2350,7 +2361,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;
@@ -2359,7 +2370,6 @@ gfc_get_ha_sym_tree (const char *name, g
if (st != NULL)
{
save_symbol_data (st->n.sym);
-
*result = st;
return i;
}
@@ -2382,7 +2392,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;
@@ -2401,7 +2411,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)
@@ -2479,7 +2489,6 @@ gfc_undo_symbols (void)
}
else
{
-
if (p->namelist_tail != old->namelist_tail)
{
gfc_free_namelist (old->namelist_tail);
@@ -2511,8 +2520,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;
@@ -2544,7 +2554,6 @@ gfc_commit_symbols (void)
p->tlink = NULL;
p->mark = 0;
p->new = 0;
-
free_old_symbol (p);
}
changed_syms = NULL;
@@ -2555,7 +2564,7 @@ gfc_commit_symbols (void)
information. */
void
-gfc_commit_symbol (gfc_symbol * sym)
+gfc_commit_symbol (gfc_symbol *sym)
{
gfc_symbol *p;
@@ -2599,7 +2608,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)
@@ -2619,7 +2628,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;
@@ -2674,7 +2683,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;
@@ -2686,7 +2695,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;
@@ -2701,7 +2710,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;
@@ -2745,7 +2754,6 @@ gfc_free_namespace (gfc_namespace * ns)
{
q = p;
p = p->sibling;
-
gfc_free_namespace (q);
}
}
@@ -2772,7 +2780,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;
@@ -2782,7 +2790,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)
{
@@ -2797,7 +2805,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)
@@ -2816,7 +2824,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);
@@ -2826,8 +2834,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)
@@ -2847,7 +2856,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)
@@ -2867,7 +2876,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);
@@ -2915,13 +2924,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);
}
@@ -2958,8 +2967,8 @@ get_iso_c_binding_dt (int sym_id)
if necessary and requested to (parent_flag). */
while (dt_list != NULL)
{
- if (dt_list->derived->from_intmod != INTMOD_NONE &&
- dt_list->derived->intmod_sym_id == sym_id)
+ if (dt_list->derived->from_intmod != INTMOD_NONE
+ && dt_list->derived->intmod_sym_id == sym_id)
return dt_list->derived;
dt_list = dt_list->next;
@@ -2969,14 +2978,12 @@ get_iso_c_binding_dt (int sym_id)
}
-
-/* Verifies that the given derived type symbol, derived_sym,
- is interoperable with C. This is necessary for any derived type that is
- BIND(C) and for derived types that are parameters to
- functions that are BIND(C). All fields of the derived
- type are required to be interoperable, and are tested for such. If
- an error occurs, the errors are reported here, allowing for multiple
- errors to be handled for a single derived type. */
+/* Verifies that the given derived type symbol, derived_sym, is interoperable
+ with C. This is necessary for any derived type that is BIND(C) and for
+ derived types that are parameters to functions that are BIND(C). All
+ fields of the derived type are required to be interoperable, and are tested
+ for such. If an error occurs, the errors are reported here, allowing for
+ multiple errors to be handled for a single derived type. */
try
verify_bind_c_derived_type (gfc_symbol *derived_sym)
@@ -2990,7 +2997,7 @@ verify_bind_c_derived_type (gfc_symbol *
"unexpectedly NULL");
/* The derived type must have the BIND attribute to be interoperable
- J3/04-007, Section 15.2.3. */
+ J3/04-007, Section 15.2.3. */
if (derived_sym->attr.is_bind_c != 1)
{
derived_sym->ts.is_c_interop = 0;
@@ -3001,7 +3008,8 @@ verify_bind_c_derived_type (gfc_symbol *
}
curr_comp = derived_sym->components;
- /* is this really an error?? --Rickett, 10.24.05 */
+
+ /* TODO: is this really an error? */
if (curr_comp == NULL)
{
gfc_error ("Derived type '%s' at %L is empty",
@@ -3010,7 +3018,7 @@ verify_bind_c_derived_type (gfc_symbol *
}
/* Initialize the derived type as being C interoperable.
- If we find an error in the components, this will be set false. */
+ If we find an error in the components, this will be set false. */
derived_sym->ts.is_c_interop = 1;
/* Loop through the list of components to verify that the kind of
@@ -3019,8 +3027,8 @@ verify_bind_c_derived_type (gfc_symbol *
{
/* BIND(C) derived types can't have derived types in them unless
they're c_ptr or c_funptr. J3/04-007, Section 15.2.3, C1502. */
- if (curr_comp->ts.type == BT_DERIVED &&
- curr_comp->ts.derived->ts.is_iso_c != 1)
+ if (curr_comp->ts.type == BT_DERIVED
+ && curr_comp->ts.derived->ts.is_iso_c != 1)
{
/* This should be allowed; the draft says a derived-type can not
have type parameters if it is has the BIND attribute. Type
@@ -3030,7 +3038,7 @@ verify_bind_c_derived_type (gfc_symbol *
}
else
{
- /* grab the typespec for the given component and test the kind */
+ /* Grab the typespec for the given component and test the kind. */
is_c_interop = verify_c_interop (&(curr_comp->ts), curr_comp->name,
&(curr_comp->loc));
@@ -3046,7 +3054,8 @@ verify_bind_c_derived_type (gfc_symbol *
x86_64 and using integer(4) to claim interop with a
C_LONG). */
if (derived_sym->attr.is_bind_c == 1)
- /* If the derived type is bind(c), all fields must be interop. */
+ /* If the derived type is bind(c), all fields must be
+ interop. */
gfc_warning ("Component '%s' in derived type '%s' at %L "
"may not be C interoperable, even though "
"derived type '%s' is BIND(C)",
@@ -3091,7 +3100,7 @@ verify_bind_c_derived_type (gfc_symbol *
} while (curr_comp != NULL);
- /* make sure we don't have conflicts with the attributes */
+ /* Make sure we don't have conflicts with the attributes. */
if (derived_sym->attr.access == ACCESS_PRIVATE)
{
gfc_error ("Derived type '%s' at %L cannot be declared with both "
@@ -3138,8 +3147,8 @@ gen_special_c_interop_ptr (int ptr_id, c
"create symbol for %s", ptr_name);
}
- /* Set up the symbol's important fields. */
- /* Save attr required so we can initialize the ptr to NULL. */
+ /* Set up the symbol's important fields. Save attr required so we can
+ initialize the ptr to NULL. */
tmp_sym->attr.save = 1;
tmp_sym->ts.is_c_interop = 1;
tmp_sym->attr.is_c_interop = 1;
@@ -3161,7 +3170,7 @@ gen_special_c_interop_ptr (int ptr_id, c
current ns. */
generate_isocbinding_symbol (module_name, ptr_id == ISOCBINDING_NULL_PTR
? ISOCBINDING_PTR : ISOCBINDING_FUNPTR,
- (char *)(ptr_id == ISOCBINDING_NULL_PTR
+ (char *) (ptr_id == ISOCBINDING_NULL_PTR
? "c_ptr" : "c_funptr"));
tmp_sym->ts.derived =
get_iso_c_binding_dt (ptr_id == ISOCBINDING_NULL_PTR
@@ -3207,7 +3216,7 @@ add_formal_arg (gfc_formal_arglist **hea
gfc_formal_arglist *formal_arg,
gfc_symbol *param_sym)
{
- /* put in list, either as first arg or at the tail (curr arg) */
+ /* Put in list, either as first arg or at the tail (curr arg). */
if (*head == NULL)
*head = *tail = formal_arg;
else
@@ -3250,13 +3259,15 @@ gen_cptr_param (gfc_formal_arglist **hea
else
gfc_internal_error ("gen_cptr_param(): Unable to "
"create symbol for %s", c_ptr_in);
- /* set up the appropriate fields for the new c_ptr param sym */
+
+ /* Set up the appropriate fields for the new c_ptr param sym. */
param_sym->refs++;
param_sym->attr.flavor = FL_DERIVED;
param_sym->ts.type = BT_DERIVED;
param_sym->attr.intent = INTENT_IN;
param_sym->attr.dummy = 1;
- /* this will pass the ptr to the iso_c routines as a (void *) */
+
+ /* This will pass the ptr to the iso_c routines as a (void *). */
param_sym->attr.value = 1;
param_sym->attr.use_assoc = 1;
@@ -3275,12 +3286,10 @@ gen_cptr_param (gfc_formal_arglist **hea
param_sym->ts.derived = c_ptr_sym;
param_sym->module = gfc_get_string (module_name);
- /* make new formal arg */
+ /* Make new formal arg. */
formal_arg = gfc_get_formal_arglist ();
- /* add arg to list of formal args (the CPTR arg) */
+ /* Add arg to list of formal args (the CPTR arg). */
add_formal_arg (head, tail, formal_arg, param_sym);
-
- return;
}
@@ -3305,21 +3314,21 @@ gen_fptr_param (gfc_formal_arglist **hea
else
gfc_internal_error ("generateFPtrParam(): Unable to "
"create symbol for %s", f_ptr_out);
- /* set up the necessary fields for the fptr output param sym */
+
+ /* Set up the necessary fields for the fptr output param sym. */
param_sym->refs++;
param_sym->attr.pointer = 1;
param_sym->attr.dummy = 1;
param_sym->attr.use_assoc = 1;
- /* my own type, to allow any pointer type as actual param */
+
+ /* ISO C Binding type to allow any pointer type as actual param. */
param_sym->ts.type = BT_VOID;
param_sym->module = gfc_get_string (module_name);
- /* make the arg */
+ /* Make the arg. */
formal_arg = gfc_get_formal_arglist ();
- /* add arg to list of formal args */
+ /* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym);
-
- return;
}
@@ -3347,15 +3356,17 @@ gen_shape_param (gfc_formal_arglist **he
gfc_internal_error ("generateShapeParam(): Unable to "
"create symbol for %s", shape_param);
- /* set up the necessary fields for the shape input param sym */
+ /* Set up the necessary fields for the shape input param sym. */
param_sym->refs++;
param_sym->attr.dummy = 1;
param_sym->attr.use_assoc = 1;
- /* integer array, rank 1, describing the shape of the object */
+
+ /* Integer array, rank 1, describing the shape of the object. */
param_sym->ts.type = BT_INTEGER;
param_sym->ts.kind = gfc_default_integer_kind;
param_sym->as = gfc_get_array_spec ();
- /* clear out the dimension info for the array */
+
+ /* Clear out the dimension info for the array. */
for (i = 0; i < GFC_MAX_DIMENSIONS; i++)
{
param_sym->as->lower[i] = NULL;
@@ -3363,9 +3374,11 @@ gen_shape_param (gfc_formal_arglist **he
}
param_sym->as->rank = 1;
param_sym->as->lower[0] = gfc_int_expr (1);
+
/* The extent is unknown until we get it. The length give us
the rank the incoming pointer. */
param_sym->as->type = AS_ASSUMED_SHAPE;
+
/* The arg is also optional; it is required iff the second arg
(fptr) is to an array, otherwise, it's ignored. */
param_sym->attr.optional = 1;
@@ -3373,25 +3386,22 @@ gen_shape_param (gfc_formal_arglist **he
param_sym->attr.dimension = 1;
param_sym->module = gfc_get_string (module_name);
- /* make the arg */
+ /* Make the arg. */
formal_arg = gfc_get_formal_arglist ();
- /* add arg to list of formal args */
+ /* Add arg to list of formal args. */
add_formal_arg (head, tail, formal_arg, param_sym);
-
- return;
}
/* Add a procedure interface to the given symbol (i.e., store a
reference to the list of formal arguments). */
static void
-add_proc_interface (gfc_symbol * sym, ifsrc source,
- gfc_formal_arglist * formal)
+add_proc_interface (gfc_symbol *sym, ifsrc source,
+ gfc_formal_arglist *formal)
{
+
sym->formal = formal;
sym->attr.if_source = source;
-
- return;
}
@@ -3419,20 +3429,20 @@ build_formal_args (gfc_symbol *new_proc_
gfc_current_ns = gfc_get_namespace(parent_ns, 0);
gfc_current_ns->proc_name = new_proc_sym;
- /* generate the params */
+ /* Generate the params. */
if ((old_sym->intmod_sym_id == ISOCBINDING_F_POINTER) ||
(old_sym->intmod_sym_id == ISOCBINDING_F_PROCPOINTER))
{
- gen_cptr_param (&head, &tail, (const char *)new_proc_sym->module,
+ gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
gfc_current_ns, NULL);
- gen_fptr_param (&head, &tail, (const char *)new_proc_sym->module,
+ gen_fptr_param (&head, &tail, (const char *) new_proc_sym->module,
gfc_current_ns);
- /* if we're dealing with c_f_pointer, it has an optional third arg */
+ /* If we're dealing with c_f_pointer, it has an optional third arg. */
if (old_sym->intmod_sym_id == ISOCBINDING_F_POINTER)
{
gen_shape_param (&head, &tail,
- (const char *)new_proc_sym->module,
+ (const char *) new_proc_sym->module,
gfc_current_ns);
}
}
@@ -3440,18 +3450,18 @@ build_formal_args (gfc_symbol *new_proc_
{
/* c_associated has one required arg and one optional; both
are c_ptrs. */
- gen_cptr_param (&head, &tail, (const char *)new_proc_sym->module,
+ gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
gfc_current_ns, "c_ptr_1");
if (add_optional_arg)
{
- gen_cptr_param (&head, &tail, (const char *)new_proc_sym->module,
+ gen_cptr_param (&head, &tail, (const char *) new_proc_sym->module,
gfc_current_ns, "c_ptr_2");
- /* the last param is optional so mark it as such */
+ /* The last param is optional so mark it as such. */
tail->sym->attr.optional = 1;
}
}
- /* add the interface (store formal args to new_proc_sym) */
+ /* Add the interface (store formal args to new_proc_sym). */
add_proc_interface (new_proc_sym, IFSRC_DECL, head);
/* Set up the formal_ns pointer to the one created for the
@@ -3459,8 +3469,6 @@ build_formal_args (gfc_symbol *new_proc_
new_proc_sym->formal_ns = gfc_current_ns;
gfc_current_ns = parent_ns;
-
- return;
}
@@ -3476,30 +3484,26 @@ build_formal_args (gfc_symbol *new_proc_
void
-generate_isocbinding_symbol (const char * mod_name, iso_c_binding_symbol s,
- char * local_name)
+generate_isocbinding_symbol (const char *mod_name, iso_c_binding_symbol s,
+ char *local_name)
{
- char * name = (local_name && local_name[0]) ? local_name
- : c_interop_kinds_table[s].name;
- gfc_symtree * tmp_symtree = NULL;
- gfc_symbol * tmp_sym = NULL;
- gfc_dt_list ** dt_list_ptr = NULL;
- gfc_component * tmp_comp = NULL;
+ char *name = (local_name && local_name[0]) ? local_name
+ : c_interop_kinds_table[s].name;
+ gfc_symtree *tmp_symtree = NULL;
+ gfc_symbol *tmp_sym = NULL;
+ gfc_dt_list **dt_list_ptr = NULL;
+ gfc_component *tmp_comp = NULL;
char comp_name[(GFC_MAX_SYMBOL_LEN * 2) + 1];
int index;
-#if 0
- gfc_namespace *save_curr_ns;
-#endif
-
tmp_symtree = gfc_find_symtree (gfc_current_ns->sym_root, name);
- /* already exists in this scope so don't re-add it
- TODO: we should probably check that it's really the same symbol */
+ /* Already exists in this scope so don't re-add it.
+ TODO: we should probably check that it's really the same symbol. */
if (tmp_symtree != NULL)
return;
- /* create the sym tree in the current ns */
+ /* Create the sym tree in the current ns. */
gfc_get_sym_tree (name, gfc_current_ns, &tmp_symtree);
if (tmp_symtree)
tmp_sym = tmp_symtree->n.sym;
@@ -3507,7 +3511,7 @@ generate_isocbinding_symbol (const char
gfc_internal_error ("generate_isocbinding_symbol(): Unable to "
"create symbol");
- /* say what module this symbol belongs to */
+ /* Say what module this symbol belongs to. */
tmp_sym->module = gfc_get_string (mod_name);
tmp_sym->from_intmod = INTMOD_ISO_C_BINDING;
tmp_sym->intmod_sym_id = s;
@@ -3524,25 +3528,25 @@ generate_isocbinding_symbol (const char
tmp_sym->value = gfc_int_expr (c_interop_kinds_table[s].value);
- /* initialize an integer constant expression node */
+ /* Initialize an integer constant expression node. */
tmp_sym->attr.flavor = FL_PARAMETER;
tmp_sym->ts.type = BT_INTEGER;
tmp_sym->ts.kind = gfc_default_integer_kind;
- /* mark this type as a C interoperable one */
+ /* Mark this type as a C interoperable one. */
tmp_sym->ts.is_c_interop = 1;
tmp_sym->ts.is_iso_c = 1;
tmp_sym->value->ts.is_c_interop = 1;
tmp_sym->value->ts.is_iso_c = 1;
tmp_sym->attr.is_c_interop = 1;
- /* tell what f90 type this c interop kind is valid for */
+ /* Tell what f90 type this c interop kind is valid. */
tmp_sym->ts.f90_type = c_interop_kinds_table[s].f90_type;
- /* say it's from the iso_c_binding module */
+ /* Say it's from the iso_c_binding module. */
tmp_sym->attr.is_iso_c = 1;
- /* make it use associated */
+ /* Make it use associated. */
tmp_sym->attr.use_assoc = 1;
break;
@@ -3565,8 +3569,8 @@ generate_isocbinding_symbol (const char
= (char) c_interop_kinds_table[s].value;
tmp_sym->value->value.character.string[1] = '\0';
- /* may not need this in both attr and ts, but do need in
- attr for writing module file. --Rickett, 02.07.07 */
+ /* May not need this in both attr and ts, but do need in
+ attr for writing module file. */
tmp_sym->attr.is_c_interop = 1;
tmp_sym->attr.flavor = FL_PARAMETER;
@@ -3575,30 +3579,31 @@ generate_isocbinding_symbol (const char
/* Need to set it to the C_CHAR kind. */
tmp_sym->ts.kind = gfc_default_character_kind;
- /* mark this type as a C interoperable one */
+ /* Mark this type as a C interoperable one. */
tmp_sym->ts.is_c_interop = 1;
tmp_sym->ts.is_iso_c = 1;
- /* tell what f90 type this c interop kind is valid for */
+ /* Tell what f90 type this c interop kind is valid. */
tmp_sym->ts.f90_type = BT_CHARACTER;
- /* say it's from the iso_c_binding module */
+ /* Say it's from the iso_c_binding module. */
tmp_sym->attr.is_iso_c = 1;
- /* make it use associated */
+ /* Make it use associated. */
tmp_sym->attr.use_assoc = 1;
break;
case ISOCBINDING_PTR:
case ISOCBINDING_FUNPTR:
- /* initialize an integer constant expression node */
+ /* Initialize an integer constant expression node. */
tmp_sym->attr.flavor = FL_DERIVED;
tmp_sym->ts.is_c_interop = 1;
tmp_sym->attr.is_c_interop = 1;
tmp_sym->attr.is_iso_c = 1;
tmp_sym->ts.is_iso_c = 1;
tmp_sym->ts.type = BT_DERIVED;
+
/* A derived type must have the bind attribute to be
interoperable (J3/04-007, Section 15.2.3), even though
the binding label is not used. */
@@ -3632,6 +3637,7 @@ generate_isocbinding_symbol (const char
"create component for c_address");
tmp_comp->ts.type = BT_INTEGER;
+
/* Set this because the module will need to read/write this field. */
tmp_comp->ts.f90_type = BT_INTEGER;
@@ -3661,6 +3667,7 @@ generate_isocbinding_symbol (const char
case ISOCBINDING_F_PROCPOINTER:
tmp_sym->attr.proc = PROC_MODULE;
+
/* Use the procedure's name as it is in the iso_c_binding module for
setting the binding label in case the user renamed the symbol. */
sprintf (tmp_sym->binding_label, "%s_%s", mod_name,
@@ -3670,10 +3677,10 @@ generate_isocbinding_symbol (const char
tmp_sym->attr.subroutine = 1;
else
{
- /* TODO!!! this needs to be finished more for the expr of the
- function or something!!! --Rickett, 08.10.06
- this may not need to be here, because trying to do c_loc
- as an external... --Rickett, 08.24.06 */
+ /* TODO! This needs to be finished more for the expr of the
+ function or something!
+ This may not need to be here, because trying to do c_loc
+ as an external. */
if (s == ISOCBINDING_ASSOCIATED)
{
tmp_sym->attr.function = 1;
@@ -3721,31 +3728,20 @@ generate_isocbinding_symbol (const char
tmp_sym->attr.flavor = FL_PROCEDURE;
tmp_sym->attr.contained = 0;
-
-#if 0
- /* we need to make the curr ns the ns that'll hold the proc sym */
- save_curr_ns = gfc_current_ns;
- gfc_current_ns = ns;
-#endif
/* Try using this builder routine, with the new and old symbols
both being the generic iso_c proc sym being created. This
- will create the formal args (and the new namespace for them). */
- /* Don't build an arg list for c_loc because we're going to treat c_loc
- as an external procedure. */
+ will create the formal args (and the new namespace for them).
+ Don't build an arg list for c_loc because we're going to treat
+ c_loc as an external procedure. */
if (s != ISOCBINDING_LOC && s != ISOCBINDING_FUNLOC)
/* The 1 says to add any optional args, if applicable. */
build_formal_args (tmp_sym, tmp_sym, 1);
-#if 0
- /* restore the current namespace to what it was coming in */
- gfc_current_ns = save_curr_ns;
-#endif
-
- /* set this after setting up the symbol, to prevent error messages */
+ /* Set this after setting up the symbol, to prevent error messages. */
tmp_sym->attr.use_assoc = 1;
- /* this symbol will not be referenced directly. it will be
+ /* This symbol will not be referenced directly. It will be
resolved to the implementation for the given f90 kind. */
tmp_sym->attr.referenced = 0;
@@ -3776,21 +3772,21 @@ get_iso_c_sym (gfc_symbol *old_sym, char
through any parent namespaces. */
gfc_find_sym_tree (new_name, gfc_current_ns, 1, &new_symtree);
if (new_symtree != NULL)
- /* return the existing symbol */
+ /* Return the existing symbol. */
return new_symtree->n.sym;
- /* create the symtree/symbol, with attempted host association */
+ /* Create the symtree/symbol, with attempted host association. */
gfc_get_ha_sym_tree (new_name, &new_symtree);
if (new_symtree == NULL)
gfc_internal_error ("get_iso_c_sym(): Unable to create "
"symtree for '%s'", new_name);
- /* now fill in the fields of the resolved symbol with the old sym */
+ /* Now fill in the fields of the resolved symbol with the old sym. */
strcpy (new_symtree->n.sym->binding_label, new_binding_label);
new_symtree->n.sym->attr = old_sym->attr;
new_symtree->n.sym->ts = old_sym->ts;
new_symtree->n.sym->module = gfc_get_string (old_sym->module);
- /* build the formal arg list */
+ /* Build the formal arg list. */
build_formal_args (new_symtree->n.sym, old_sym, add_optional_arg);
gfc_commit_symbol (new_symtree->n.sym);
@@ -3816,8 +3812,9 @@ copy_formal_args (gfc_symbol *dest, gfc_
gfc_formal_arglist *formal_prev = NULL;
gfc_namespace *parent_ns = NULL;
- /* save current namespace so we can change it for formal args */
+ /* Save current namespace so we can change it for formal args. */
parent_ns = gfc_current_ns;
+
/* Create a new namespace, which will be the formal ns (namespace
of the formal args). */
gfc_current_ns = gfc_get_namespace (parent_ns, 0);
@@ -3827,15 +3824,16 @@ copy_formal_args (gfc_symbol *dest, gfc_
formal_prev = NULL;
while (curr_arg != NULL)
{
- /* allocate a new struct for the formal arg */
+ /* Allocate a new struct for the formal arg. */
formal_arg = gfc_get_formal_arglist ();
- /* create symbol for the arg */
- gfc_get_symbol (curr_arg->sym->name, gfc_current_ns,
- &(formal_arg->sym));
- /* may need to copy more info for the symbol.. */
+ /* Create symbol for the arg. */
+ gfc_get_symbol (curr_arg->sym->name, gfc_current_ns, &(formal_arg->sym));
+
+ /* May need to copy more info for the symbol. */
formal_arg->sym->attr = curr_arg->sym->attr;
formal_arg->sym->ts = curr_arg->sym->ts;
+
/* If this isn't the first arg, set up the next ptr. For the
last arg built, the formal_arg->next will never get set to
anything other than NULL. */
@@ -3844,24 +3842,24 @@ copy_formal_args (gfc_symbol *dest, gfc_
formal_prev->next = formal_arg;
formal_prev = formal_arg;
- /* add arg to list of formal args */
+ /* Add arg to list of formal args. */
add_formal_arg (&head, &tail, formal_arg, formal_arg->sym);
- /* will reuse for any additional arg(s) */
+ /* Will reuse for any additional arg(s). */
formal_arg = NULL;
- /* go to the next arg, if any */
+
+ /* Go to the next arg, if any. */
curr_arg = curr_arg->next;
}
- /* add the interface to the symbol */
+ /* Add the interface to the symbol. */
add_proc_interface (dest, IFSRC_DECL, head);
- /* store the formal namespace information */
+
+ /* Store the formal namespace information. */
if (dest->formal != NULL)
- /* the current ns should be that for the dest proc */
+ /* The current ns should be that for the dest proc. */
dest->formal_ns = gfc_current_ns;
- /* restore the current namespace to what it was on entry */
+ /* Restore the current namespace to what it was on entry. */
gfc_current_ns = parent_ns;
-
- return;
}
Index: decl.c
===================================================================
--- decl.c (revision 124313)
+++ decl.c (working copy)
@@ -51,8 +51,6 @@ static int num_idents_on_line;
can supply a name if the curr_binding_label is nil and NAME= was not. */
static int has_name_equals = 0;
-
-
/* Initializer of the previous enumerator. */
static gfc_expr *last_initializer;
@@ -152,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;
@@ -455,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)
{
@@ -649,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)
{
@@ -730,7 +727,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
@@ -883,8 +880,7 @@ verify_c_interop_param (gfc_symbol *sym)
}
-/* Function called by variable_decl() that adds a name to the symbol
- table. */
+/* Function called by variable_decl() that adds a name to the symbol table. */
static try
build_sym (const char *name, gfc_charlen *cl,
@@ -896,8 +892,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))
@@ -941,7 +936,7 @@ build_sym (const char *name, gfc_charlen
common then we need to make sure we're an interoperable type. */
if (sym->attr.in_common == 1)
{
- /* test the common block object */
+ /* Test the common block object. */
if (sym->common_block != NULL && sym->common_block->is_bind_c == 1
&& sym->ts.is_c_interop != 1)
{
@@ -1005,7 +1000,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)
@@ -1059,8 +1054,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;
@@ -1123,9 +1117,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;
@@ -1174,7 +1167,7 @@ add_init_expr_to_sym (const char *name,
{
sym->ts.is_iso_c |= init->ts.is_iso_c;
sym->ts.is_c_interop |= init->ts.is_c_interop;
- /* attr bits needed for module files */
+ /* attr bits needed for module files. */
sym->attr.is_iso_c |= init->ts.is_iso_c;
sym->attr.is_c_interop |= init->ts.is_c_interop;
if (init->ts.is_iso_c)
@@ -1718,13 +1711,13 @@ gfc_match_kind_spec (gfc_typespec *ts)
m = MATCH_ERROR;
}
else
- /* all tests passed */
+ /* All tests passed. */
m = MATCH_YES;
if(m == MATCH_ERROR)
gfc_current_locus = where;
- /* return what we know from the test(s) */
+ /* Return what we know from the test(s). */
return m;
no_match:
@@ -1764,15 +1757,14 @@ match_char_spec (gfc_typespec *ts)
m = gfc_match_char ('(');
if (m != MATCH_YES)
{
- m = MATCH_YES; /* character without length is a single char */
+ m = MATCH_YES; /* Character without length is a single char. */
goto done;
}
- /* Try the weird case: ( KIND = <int> [ , LEN = <len-param> ] ) */
+ /* Try the weird case: ( KIND = <int> [ , LEN = <len-param> ] ). */
if (gfc_match (" kind =") == MATCH_YES)
{
- m = gfc_match_small_int_expr(&kind, &kind_expr);
-/* m = gfc_match_small_int (&kind); */
+ m = gfc_match_small_int_expr(&kind, &kind_expr);
if (m == MATCH_ERROR)
goto done;
@@ -1792,7 +1784,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);
@@ -1808,8 +1800,7 @@ match_char_spec (gfc_typespec *ts)
if (gfc_match (" , kind =") != MATCH_YES)
goto syntax;
- gfc_match_small_int_expr(&kind, &kind_expr);
-/* gfc_match_small_int (&kind); */
+ gfc_match_small_int_expr(&kind, &kind_expr);
if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0)
{
@@ -1820,7 +1811,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;
@@ -1835,10 +1826,9 @@ match_char_spec (gfc_typespec *ts)
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
- gfc_match (" kind ="); /* Gobble optional text */
+ gfc_match (" kind ="); /* Gobble optional text. */
m = gfc_match_small_int_expr(&kind, &kind_expr);
-/* m = gfc_match_small_int (&kind); */
if (m == MATCH_ERROR)
goto done;
if (m == MATCH_NO)
@@ -1864,7 +1854,7 @@ done:
if (m != MATCH_YES)
{
gfc_free_expr (len);
- gfc_free_expr (kind_expr);
+ gfc_free_expr (kind_expr);
return m;
}
@@ -1901,7 +1891,7 @@ done:
could be an error.
To see if the user used a C interop kind, test the expr
of the so called length, and see if it's C interoperable. */
- ts->is_c_interop = len->ts.is_iso_c;
+ ts->is_c_interop = len->ts.is_iso_c;
}
return MATCH_YES;
@@ -1926,7 +1916,7 @@ match_type_spec (gfc_typespec *ts, int i
gfc_clear_ts (ts);
- /* clear the current binding label, in case one is given */
+ /* Clear the current binding label, in case one is given. */
curr_binding_label[0] = '\0';
if (gfc_match (" byte") == MATCH_YES)
@@ -2092,7 +2082,7 @@ match_implicit_range (void)
switch (c)
{
case ')':
- inner = 0; /* Fall through */
+ inner = 0; /* Fall through. */
case ',':
c2 = c1;
@@ -2265,6 +2255,7 @@ error:
return MATCH_ERROR;
}
+
match
gfc_match_import (void)
{
@@ -2273,8 +2264,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");
@@ -2308,16 +2299,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;
@@ -2365,6 +2355,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
@@ -2445,9 +2436,9 @@ match_attr_spec (void)
peek_char = gfc_peek_char ();
if (peek_char == ',')
{
- /* chomp the comma */
+ /* Chomp the comma. */
peek_char = gfc_next_char ();
- /* try and match the bind(c) */
+ /* Try and match the bind(c). */
if (gfc_match_bind_c (NULL) == MATCH_YES)
d = DECL_IS_BIND_C;
else
@@ -2539,16 +2530,16 @@ match_attr_spec (void)
attr = "TARGET";
break;
case DECL_IS_BIND_C:
- attr = "IS_BIND_C";
- break;
+ attr = "IS_BIND_C";
+ break;
case DECL_VALUE:
- attr = "VALUE";
- break;
+ attr = "VALUE";
+ break;
case DECL_VOLATILE:
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]);
@@ -2755,7 +2746,7 @@ set_binding_label (char *dest_label, con
return FAILURE;
}
- /* binding label given; store in temp holder til have sym */
+ /* Binding label given; store in temp holder til have sym. */
strncpy (dest_label, curr_binding_label,
strlen (curr_binding_label) + 1);
}
@@ -2782,8 +2773,7 @@ set_com_block_bind_c (gfc_common_head *c
}
-/* Verify that the given gfc_typespec is for a C interoperable
- type. */
+/* Verify that the given gfc_typespec is for a C interoperable type. */
try
verify_c_interop (gfc_typespec *ts, const char *name, locus *where)
@@ -2795,10 +2785,10 @@ verify_c_interop (gfc_typespec *ts, cons
used (e.g., real(4), bind(c) :: myFloat). */
if (ts->f90_type != BT_UNKNOWN)
{
- t = gfc_validate_c_kind(ts);
+ t = gfc_validate_c_kind (ts);
if (t != SUCCESS)
{
- /* print error, but continue parsing line */
+ /* Print an error, but continue parsing line. */
gfc_error_now ("C kind parameter is for type %s but "
"symbol '%s' at %L is of type %s",
gfc_basic_typename (ts->f90_type),
@@ -2809,9 +2799,9 @@ verify_c_interop (gfc_typespec *ts, cons
/* Make sure the kind is C interoperable. This does not care about the
possible error above. */
- if(ts->type == BT_DERIVED && ts->derived != NULL)
+ if (ts->type == BT_DERIVED && ts->derived != NULL)
return (ts->derived->ts.is_c_interop ? SUCCESS : FAILURE);
- else if(ts->is_c_interop != 1)
+ else if (ts->is_c_interop != 1)
return FAILURE;
return SUCCESS;
@@ -2966,7 +2956,7 @@ set_verify_bind_c_sym (gfc_symbol *tmp_s
/* TODO: Do we need to make sure the vars aren't marked private? */
- /* Set the is_bind_c bit in symbol_attribute. */
+ /* Set the is_bind_c bit in symbol_attribute. */
gfc_add_is_bind_c (&(tmp_sym->attr), tmp_sym->name, &gfc_current_locus, 0);
if (set_binding_label (tmp_sym->binding_label, tmp_sym->name,
@@ -2985,9 +2975,9 @@ set_verify_bind_c_com_block (gfc_common_
{
try retval = SUCCESS;
- /* destLabel, common name, typespec (which may have binding label) */
- if (set_binding_label (com_block->binding_label, com_block->name,
- num_idents) != SUCCESS)
+ /* destLabel, common name, typespec (which may have binding label). */
+ if (set_binding_label (com_block->binding_label, com_block->name, num_idents)
+ != SUCCESS)
return FAILURE;
/* Set the given common block (com_block) to being bind(c) (1). */
@@ -3029,7 +3019,7 @@ get_bind_c_idents (void)
/* Save the current identifier and look for more. */
do
{
- /* inc the number of identifiers found for this spec stmt */
+ /* Increment the number of identifiers found for this spec stmt. */
num_idents++;
/* Make sure we have a sym or com block, and verify that it can
@@ -3050,7 +3040,7 @@ get_bind_c_idents (void)
return FAILURE;
}
- /* look to see if we have another identifier */
+ /* Look to see if we have another identifier. */
tmp_sym = NULL;
if (gfc_match_eos () == MATCH_YES)
found_id = MATCH_NO;
@@ -3069,7 +3059,7 @@ get_bind_c_idents (void)
else
{
gfc_error ("Missing entity or common block name for "
- "attribute specification statement at %C");
+ "attribute specification statement at %C");
return FAILURE;
}
}
@@ -3107,7 +3097,7 @@ verify_proc_decl_attrs (gfc_symbol *proc
return FAILURE;
}
- /* if we get here, no errors reported */
+ /* If we get here, no errors reported. */
return SUCCESS;
}
@@ -3149,17 +3139,15 @@ match_proc_decl (void)
if (proc_decl != MATCH_YES)
return proc_decl;
- /* Get the optional procedure interface now.
- The parens seem required (looking at the grammar), but the
- interface is not. */
+ /* Get the optional procedure interface now. The parens seem required
+ (looking at the grammar), but the interface is not. */
proc_decl = gfc_match_char ('(');
/* Get the optional name. if this fails, it's ok as long as
nothing is between the parens. */
gfc_match_name (int_name);
if (proc_decl == MATCH_ERROR || gfc_match_char (')') != MATCH_YES)
{
- gfc_error ("Syntax error in procedure declaration statement "
- "at %C");
+ gfc_error ("Syntax error in procedure declaration statement at %C");
return MATCH_ERROR;
}
@@ -3216,31 +3204,31 @@ match_proc_decl (void)
if (gfc_match_name (proc_name) != MATCH_YES)
return MATCH_ERROR;
- /* create the symbol for the procedure of this name */
+ /* Create the symbol for the procedure of this name. */
if (get_proc_name (proc_name, &new_proc_sym, false))
/* A nonzero return value means error, but the message should
- * have been handled by the get_proc_name, so just return. */
+ have been handled by the get_proc_name, so just return. */
return MATCH_ERROR;
/* Copy the attr and typespecs. These are an or of what the
user lists, and what is defined for the interface proc. */
new_proc_sym->attr = int_symtree->n.sym->attr;
new_proc_sym->ts = int_symtree->n.sym->ts;
- src_attr = (char *)(&(current_attr));
- dest_attr = (char *)(&(new_proc_sym->attr));
- for (i = 0; i < (int)sizeof (new_proc_sym->attr); i++)
+ src_attr = (char *) (&(current_attr));
+ dest_attr = (char *) (&(new_proc_sym->attr));
+ for (i = 0; i < (int) sizeof (new_proc_sym->attr); i++)
{
*dest_attr = (*dest_attr) | (*src_attr);
dest_attr++;
src_attr++;
}
- /* or necessary current_ts info with ts from interface proc */
+ /* Or necessary current_ts info with ts from interface proc. */
new_proc_sym->ts.is_c_interop |= current_ts.is_c_interop;
new_proc_sym->ts.f90_type |= current_ts.f90_type;
/* All procedure decls refer to external procedures (this may
- not be right to do if it's a proc pointer..). */
+ not be right to do if it's a proc pointer.). */
new_proc_sym->attr.external = 1;
/* We have the symbol for the new procedure, so set up the
properties such as formal args, sub/func flag, etc. */
@@ -3259,17 +3247,17 @@ match_proc_decl (void)
num_idents) != SUCCESS)
return MATCH_ERROR;
- /* copy the formal arg list (params are: (dest, src)) */
+ /* Copy the formal arg list (params are: (dest, src)). */
copy_formal_args (new_proc_sym, int_symtree->n.sym);
- /* verify the proc decl attributes with the interface's attrs */
+ /* Verify the proc decl attributes with the interface's attrs. */
if (verify_proc_decl_attrs (new_proc_sym, int_symtree->n.sym)
!= SUCCESS)
- /* error messages will have already been printed */
+ /* Error messages will have already been printed. */
return MATCH_ERROR;
} while (gfc_match_char (',') == MATCH_YES);
- /* make sure we match the eos now */
+ /* Make sure we match the eos now. */
if (gfc_match_eos () != MATCH_YES)
return MATCH_ERROR;
@@ -3294,26 +3282,26 @@ gfc_match_bind_c_stmt (void)
ts = ¤t_ts;
- /* this may not be necessary */
+ /* This may not be necessary. */
gfc_clear_ts (ts);
- /* clear the temporary binding label holder */
+ /* Clear the temporary binding label holder. */
curr_binding_label[0] = '\0';
- /* look for the bind(c) */
+ /* Look for the bind(c). */
found_match = gfc_match_bind_c (NULL);
if (found_match == MATCH_YES)
{
- /* look for the :: now, but it is not required */
+ /* Look for the :: now, but it is not required. */
gfc_match (" :: ");
- /* get the identifier(s) that need updated */
- /* This may need to change to hand the flag(s) for the attr
- specified so all identifiers found can have all appropriate
- parts updated (assuming that the same spec stmt can have
- multiple attrs, such as both bind(c) and allocatable...). */
+ /* Get the identifier(s) that needs to be updated. This may need to
+ change to hand the flag(s) for the attr specified so all identifiers
+ found can have all appropriate parts updated (assuming that the same
+ spec stmt can have multiple attrs, such as both bind(c) and
+ allocatable...). */
if (get_bind_c_idents () != SUCCESS)
- /* error message should have printed already */
+ /* Error message should have printed already. */
return MATCH_ERROR;
}
@@ -3321,7 +3309,7 @@ gfc_match_bind_c_stmt (void)
}
-/* Try and match a PROCEDURE declaration statement.
+/* Try to match a PROCEDURE declaration statement.
TODO: Handling of procedure declarations is nowhere near complete! */
match
@@ -3332,12 +3320,12 @@ gfc_match_proc_decl_stmt (void)
ts = ¤t_ts;
- /* this may not be necessary */
+ /* This may not be necessary. */
gfc_clear_ts (ts);
- /* clear the temporary binding label holder */
+ /* Clear the temporary binding label holder. */
curr_binding_label[0] = '\0';
- /* look for procedure decl stmt */
+ /* Look for procedure decl stmt. */
found_match = match_proc_decl ();
return found_match;
@@ -3613,8 +3601,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;
@@ -3632,7 +3620,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;
@@ -3645,14 +3633,11 @@ match_result (gfc_symbol * function, gfc
if (m != MATCH_YES)
return m;
- /* get the right paren, and that's it because there could be the
- * bind(c) attribute after the result clause.
- */
- if(gfc_match_char(')') != MATCH_YES)
- {
- /* should report the missing right paren here.
- * --Rickett, 10.04.05
- */
+ /* Get the right paren, and that's it because there could be the
+ bind(c) attribute after the result clause. */
+ if (gfc_match_char(')') != MATCH_YES)
+ {
+ /* TODO: should report the missing right paren here. */
return MATCH_ERROR;
}
@@ -3682,48 +3667,48 @@ match_result (gfc_symbol * function, gfc
match
gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result)
{
- match is_bind_c; /* found bind(c) */
- match is_result; /* found result clause */
- match found_match; /* status of whether we've found a good match */
- int peek_char; /* character we're going to peek at */
+ match is_bind_c; /* Found bind(c). */
+ match is_result; /* Found result clause. */
+ match found_match; /* Status of whether we've found a good match. */
+ int peek_char; /* Character we're going to peek at. */
- /* initialize to having found nothing */
+ /* Initialize to having found nothing. */
found_match = MATCH_NO;
is_bind_c = MATCH_NO;
is_result = MATCH_NO;
- /* get the next char to narrow between result and bind(c) */
+ /* Get the next char to narrow between result and bind(c). */
gfc_gobble_whitespace ();
peek_char = gfc_peek_char ();
switch (peek_char)
{
case 'r':
- /* look for result clause */
+ /* Look for result clause. */
is_result = match_result (sym, result);
if (is_result == MATCH_YES)
{
- /* now see if there is a bind(c) after it */
+ /* Now see if there is a bind(c) after it. */
is_bind_c = gfc_match_bind_c (sym);
- /* we've found the result clause and possibly bind(c) */
+ /* We've found the result clause and possibly bind(c). */
found_match = MATCH_YES;
}
else
- /* this should only be MATCH_ERROR */
+ /* This should only be MATCH_ERROR. */
found_match = is_result;
break;
case 'b':
- /* look for bind(c) first */
+ /* Look for bind(c) first. */
is_bind_c = gfc_match_bind_c (sym);
if (is_bind_c == MATCH_YES)
{
- /* now see if a result clause followed it */
+ /* Now see if a result clause followed it. */
is_result = match_result (sym, result);
found_match = MATCH_YES;
}
else
{
- /* should only be a MATCH_ERROR if get here after seeing 'b' */
+ /* Should only be a MATCH_ERROR if we get here after seeing 'b'. */
found_match = MATCH_ERROR;
}
break;
@@ -3758,7 +3743,7 @@ gfc_match_function_decl (void)
locus old_loc;
match m;
match suffix_match;
- match found_match; /* status returned by match func */
+ match found_match; /* Status returned by match func. */
if (gfc_current_state () != COMP_NONE
&& gfc_current_state () != COMP_INTERFACE
@@ -3822,10 +3807,10 @@ gfc_match_function_decl (void)
if (found_match != MATCH_YES)
{
- /* if haven't found the end-of-statement, look for a suffix */
+ /* If we haven't found the end-of-statement, look for a suffix. */
suffix_match = gfc_match_suffix (sym, &result);
if (suffix_match == MATCH_YES)
- /* need to get the eos now */
+ /* Need to get the eos now. */
found_match = gfc_match_eos ();
else
found_match = suffix_match;
@@ -4233,7 +4218,7 @@ gfc_match_bind_c (gfc_symbol *sym)
has_name_equals = 1;
- /* get the opening quote */
+ /* Get the opening quote. */
double_quote = MATCH_YES;
single_quote = MATCH_YES;
double_quote = gfc_match_char ('"');
@@ -4251,13 +4236,13 @@ gfc_match_bind_c (gfc_symbol *sym)
if (gfc_match_name_C (binding_label) != MATCH_YES)
return MATCH_ERROR;
- /* get the closing quotation */
+ /* Get the closing quotation. */
if (double_quote == MATCH_YES)
{
if (gfc_match_char ('"') != MATCH_YES)
{
gfc_error ("Missing closing quote '\"' for binding label at %C");
- /* user started string with '"' so looked to match it */
+ /* User started string with '"' so looked to match it. */
return MATCH_ERROR;
}
}
@@ -4266,13 +4251,13 @@ gfc_match_bind_c (gfc_symbol *sym)
if (gfc_match_char ('\'') != MATCH_YES)
{
gfc_error ("Missing closing quote '\'' for binding label at %C");
- /* user started string with ''' char */
+ /* User started string with "'" char. */
return MATCH_ERROR;
}
}
}
- /* get the required right paren */
+ /* Get the required right paren. */
if (gfc_match_char (')') != MATCH_YES)
{
gfc_error ("Missing closing paren for binding label at %C");
@@ -4484,7 +4469,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;
@@ -4521,7 +4506,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);
@@ -5428,7 +5414,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. */
@@ -5502,7 +5487,7 @@ syntax:
match
gfc_get_type_attr_spec (symbol_attribute *attr)
{
- /* see if the derived type is marked as private */
+ /* See if the derived type is marked as private. */
if (gfc_match (" , private") == MATCH_YES)
{
if (gfc_current_state () != COMP_MODULE)
@@ -5532,20 +5517,16 @@ gfc_get_type_attr_spec (symbol_attribute
/* If the type is defined to be bind(c) it then needs to make
sure that all fields are interoperable. This will
need to be a semantic check on the finished derived type.
- sect. 15.2.3 (lines 9-12) of f03 draft */
+ See 15.2.3 (lines 9-12) of F2003 draft. */
if (gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0) != SUCCESS)
return MATCH_ERROR;
- /* TODO!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
-
- /* attr conflicts need to be checked, probably in symbol.c */
-
- /* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! */
+ /* TODO: attr conflicts need to be checked, probably in symbol.c. */
}
else
return MATCH_NO;
- /* if get here, something matched */
+ /* If we get here, something matched. */
return MATCH_YES;
}
@@ -5632,9 +5613,9 @@ gfc_match_derived_decl (void)
&& gfc_add_access (&sym->attr, attr.access, sym->name, NULL) == FAILURE)
return MATCH_ERROR;
- /* see if the derived type was labeled as bind(c) */
- if(attr.is_bind_c != 0)
- sym->attr.is_bind_c = attr.is_bind_c;
+ /* See if the derived type was labeled as bind(c). */
+ if (attr.is_bind_c != 0)
+ sym->attr.is_bind_c = attr.is_bind_c;
gfc_new_block = sym;
Index: trans-common.c
===================================================================
--- trans-common.c (revision 124313)
+++ trans-common.c (working copy)
@@ -108,10 +108,9 @@ Software Foundation, 51 Franklin Street,
#include "trans-const.h"
-/* this is defined in match.h, and probably shouldn't be here also,
- * but we need it for now at least and don't want to include the
- * whole match.h. --Rickett, 10.18.05
- */
+/* TODO: This is defined in match.h, and probably shouldn't be here also,
+ but we need it for now at least and don't want to include the whole
+ match.h. */
gfc_common_head *gfc_get_common (const char *, int);
@@ -410,7 +409,7 @@ build_common_decl (gfc_common_head *com,
if (decl == NULL_TREE)
{
decl = build_decl (VAR_DECL, get_identifier (com->name), union_type);
- SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com));
+ SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com));
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
@@ -448,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;
@@ -514,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;
@@ -816,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
@@ -858,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;
@@ -895,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;
@@ -1030,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. */
@@ -1041,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: expr.c
===================================================================
--- expr.c (revision 124313)
+++ expr.c (working copy)
@@ -353,8 +353,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)
@@ -370,7 +369,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;
@@ -463,14 +462,14 @@ gfc_copy_expr (gfc_expr *p)
case BT_LOGICAL:
case BT_DERIVED:
- break; /* Already done */
+ break; /* Already done. */
case BT_PROCEDURE:
case BT_VOID:
- /* should never be reached. --Rickett, 03.14.06 */
+ /* Should never be reached. */
case BT_UNKNOWN:
gfc_internal_error ("gfc_copy_expr(): Bad expr node");
- /* Not reached */
+ /* Not reached. */
}
break;
@@ -485,7 +484,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;
@@ -704,7 +703,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:
@@ -780,7 +778,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;
@@ -1338,7 +1336,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
@@ -1420,6 +1418,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)
{
@@ -1437,8 +1436,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
@@ -2176,7 +2174,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:
@@ -2257,6 +2254,7 @@ check_restricted (gfc_expr *e)
try
gfc_specification_expr (gfc_expr *e)
{
+
if (e == NULL)
return SUCCESS;
@@ -2360,18 +2358,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;
@@ -2379,7 +2377,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
@@ -2387,11 +2385,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;
}
@@ -2434,7 +2432,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)