summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>2007-01-07 19:39:52 +0000
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>2007-01-07 19:39:52 +0000
commit1a9745d21e1268a87f19cfda24155b849b8b11b2 (patch)
treee2633becc84e13a77c5ae809cc07bf460e685f59
parentccb16ec521709e9f7eac08426337a6ebe03bc3aa (diff)
downloadgcc-1a9745d21e1268a87f19cfda24155b849b8b11b2.tar.gz
2007-01-07 Steven G. Kargl <kargl@gcc.gnu.org>
* decl.c, dump-parse-tree.c, error.c, data.c, expr.c, dependency.c, convert.c: Update Copyright dates. Fix whitespace. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@120552 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat
-rw-r--r--gcc/fortran/ChangeLog5
-rw-r--r--gcc/fortran/convert.c8
-rw-r--r--gcc/fortran/data.c229
-rw-r--r--gcc/fortran/decl.c530
-rw-r--r--gcc/fortran/dependency.c102
-rw-r--r--gcc/fortran/dump-parse-tree.c110
-rw-r--r--gcc/fortran/error.c37
-rw-r--r--gcc/fortran/expr.c341
8 files changed, 645 insertions, 717 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index abab9056a5a..0eb50bc43f0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2007-01-07 Steven G. Kargl <kargl@gcc.gnu.org>
+
+ * decl.c, dump-parse-tree.c, error.c, data.c, expr.c, dependency.c,
+ convert.c: Update Copyright dates. Fix whitespace.
+
2007-01-07 Bernhard Fischer <aldot@gcc.gnu.org>
* data.c (gfc_assign_data_value): Fix whitespace.
diff --git a/gcc/fortran/convert.c b/gcc/fortran/convert.c
index 73d7a6d92b7..b0c4d4550c8 100644
--- a/gcc/fortran/convert.c
+++ b/gcc/fortran/convert.c
@@ -1,5 +1,6 @@
/* Language-level data type conversion for GNU C.
- Copyright (C) 1987, 1988, 1991, 1998, 2002 Free Software Foundation, Inc.
+ Copyright (C) 1987, 1988, 1991, 1998, 2002, 2007
+ Free Software Foundation, Inc.
This file is part of GCC.
@@ -57,9 +58,8 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
In expr.c: expand_expr, for operands of a MULT_EXPR.
In fold-const.c: fold.
In tree.c: get_narrower and get_unwidened. */
-
+
/* Subroutines of `convert'. */
-
/* Create an expression whose value is that of EXPR,
@@ -104,7 +104,7 @@ convert (tree type, tree expr)
e = gfc_truthvalue_conversion (e);
/* If we have a NOP_EXPR, we must fold it here to avoid
- infinite recursion between fold () and convert (). */
+ infinite recursion between fold () and convert (). */
if (TREE_CODE (e) == NOP_EXPR)
return fold_build1 (NOP_EXPR, type, TREE_OPERAND (e, 0));
else
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 4a3ce78b137..70a715127df 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -1,6 +1,6 @@
/* Supporting functions for resolving DATA statement.
- Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software
- Foundation, Inc.
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
This file is part of GCC.
@@ -22,14 +22,14 @@ Software Foundation, 51 Franklin Street, Fifth Floor,Boston, MA
/* Notes for DATA statement implementation:
-
+
We first assign initial value to each symbol by gfc_assign_data_value
during resolveing DATA statement. Refer to check_data_variable and
traverse_data_list in resolve.c.
-
+
The complexity exists in the handling of array section, implied do
and array of struct appeared in DATA statement.
-
+
We call gfc_conv_structure, gfc_con_array_array_initializer,
etc., to convert the initial value. Refer to trans-expr.c and
trans-array.c. */
@@ -42,7 +42,7 @@ static void formalize_init_expr (gfc_expr *);
/* Calculate the array element offset. */
static void
-get_array_index (gfc_array_ref * ar, mpz_t * offset)
+get_array_index (gfc_array_ref *ar, mpz_t *offset)
{
gfc_expr *e;
int i;
@@ -61,14 +61,15 @@ get_array_index (gfc_array_ref * ar, mpz_t * offset)
if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
|| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
|| (gfc_is_constant_expr (e) == 0))
- gfc_error ("non-constant array in DATA statement %L", &ar->where);
+ gfc_error ("non-constant array in DATA statement %L", &ar->where);
+
mpz_set (tmp, e->value.integer);
mpz_sub (tmp, tmp, ar->as->lower[i]->value.integer);
mpz_mul (tmp, tmp, delta);
mpz_add (*offset, tmp, *offset);
mpz_sub (tmp, ar->as->upper[i]->value.integer,
- ar->as->lower[i]->value.integer);
+ ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
@@ -87,39 +88,40 @@ find_con_by_offset (splay_tree spt, mpz_t offset)
gfc_constructor *con;
splay_tree_node sptn;
-/* The complexity is due to needing quick access to the linked list of
- constructors. Both a linked list and a splay tree are used, and both are
- kept up to date if they are array elements (which is the only time that
- a specific constructor has to be found). */
+ /* The complexity is due to needing quick access to the linked list of
+ constructors. Both a linked list and a splay tree are used, and both
+ are kept up to date if they are array elements (which is the only time
+ that a specific constructor has to be found). */
gcc_assert (spt != NULL);
mpz_init (tmp);
- sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si(offset));
+ sptn = splay_tree_lookup (spt, (splay_tree_key) mpz_get_si (offset));
if (sptn)
ret = (gfc_constructor*) sptn->value;
else
{
/* Need to check and see if we match a range, so we will pull
- the next lowest index and see if the range matches. */
- sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
+ the next lowest index and see if the range matches. */
+ sptn = splay_tree_predecessor (spt,
+ (splay_tree_key) mpz_get_si (offset));
if (sptn)
- {
- con = (gfc_constructor*) sptn->value;
- if (mpz_cmp_ui (con->repeat, 1) > 0)
- {
- mpz_init (tmp);
- mpz_add (tmp, con->n.offset, con->repeat);
- if (mpz_cmp (offset, tmp) < 0)
- ret = con;
- mpz_clear (tmp);
- }
- else
- ret = NULL; /* The range did not match. */
- }
+ {
+ con = (gfc_constructor*) sptn->value;
+ if (mpz_cmp_ui (con->repeat, 1) > 0)
+ {
+ mpz_init (tmp);
+ mpz_add (tmp, con->n.offset, con->repeat);
+ if (mpz_cmp (offset, tmp) < 0)
+ ret = con;
+ mpz_clear (tmp);
+ }
+ else
+ ret = NULL; /* The range did not match. */
+ }
else
- ret = NULL; /* No pred, so no match. */
+ ret = NULL; /* No pred, so no match. */
}
return ret;
@@ -134,7 +136,7 @@ find_con_by_component (gfc_component *com, gfc_constructor *con)
for (; con; con = con->next)
{
if (com == con->n.component)
- return con;
+ return con;
}
return NULL;
}
@@ -146,8 +148,8 @@ find_con_by_component (gfc_component *com, gfc_constructor *con)
according to normal assignment rules. */
static gfc_expr *
-create_character_intializer (gfc_expr * init, gfc_typespec * ts,
- gfc_ref * ref, gfc_expr * rvalue)
+create_character_intializer (gfc_expr *init, gfc_typespec *ts,
+ gfc_ref *ref, gfc_expr *rvalue)
{
int len;
int start;
@@ -181,14 +183,14 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
gcc_assert (ref->type == REF_SUBSTRING);
/* Only set a substring of the destination. Fortran substring bounds
- are one-based [start, end], we want zero based [start, end). */
+ are one-based [start, end], we want zero based [start, end). */
start_expr = gfc_copy_expr (ref->u.ss.start);
end_expr = gfc_copy_expr (ref->u.ss.end);
if ((gfc_simplify_expr (start_expr, 1) == FAILURE)
- || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
+ || (gfc_simplify_expr (end_expr, 1)) == FAILURE)
{
- gfc_error ("failure to simplify substring reference in DATA"
+ gfc_error ("failure to simplify substring reference in DATA "
"statement at %L", &ref->u.ss.start->where);
return NULL;
}
@@ -225,12 +227,13 @@ create_character_intializer (gfc_expr * init, gfc_typespec * ts,
return init;
}
+
/* Assign the initial value RVALUE to LVALUE's symbol->value. If the
LVALUE already has an initialization, we extend this, otherwise we
create a new one. */
void
-gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
+gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index)
{
gfc_ref *ref;
gfc_expr *init;
@@ -262,7 +265,7 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
}
/* Use the existing initializer expression if it exists. Otherwise
- create a new one. */
+ create a new one. */
if (init == NULL)
expr = gfc_get_expr ();
else
@@ -289,38 +292,40 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
else
mpz_set (offset, index);
- /* Splay tree containing offset and gfc_constructor. */
- spt = expr->con_by_offset;
+ /* Splay tree containing offset and gfc_constructor. */
+ spt = expr->con_by_offset;
- if (spt == NULL)
- {
- spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
- expr->con_by_offset = spt;
- con = NULL;
- }
- else
+ if (spt == NULL)
+ {
+ spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
+ expr->con_by_offset = spt;
+ con = NULL;
+ }
+ else
con = find_con_by_offset (spt, offset);
if (con == NULL)
{
+ splay_tree_key j;
+
/* Create a new constructor. */
con = gfc_get_constructor ();
mpz_set (con->n.offset, offset);
- sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
- (splay_tree_value) con);
- /* Fix up the linked list. */
- sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
- if (sptn == NULL)
- { /* Insert at the head. */
- con->next = expr->value.constructor;
- expr->value.constructor = con;
- }
- else
- { /* Insert in the chain. */
- pred = (gfc_constructor*) sptn->value;
- con->next = pred->next;
- pred->next = con;
- }
+ j = (splay_tree_key) mpz_get_si (offset);
+ sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
+ /* Fix up the linked list. */
+ sptn = splay_tree_predecessor (spt, j);
+ if (sptn == NULL)
+ { /* Insert at the head. */
+ con->next = expr->value.constructor;
+ expr->value.constructor = con;
+ }
+ else
+ { /* Insert in the chain. */
+ pred = (gfc_constructor*) sptn->value;
+ con->next = pred->next;
+ pred->next = con;
+ }
}
break;
@@ -374,16 +379,16 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
provokes a warning from other compilers. */
if (init != NULL)
{
- /* Order in which the expressions arrive here depends on whether they
- are from data statements or F95 style declarations. Therefore,
- check which is the most recent. */
+ /* Order in which the expressions arrive here depends on whether
+ they are from data statements or F95 style declarations.
+ Therefore, check which is the most recent. */
#ifdef USE_MAPPED_LOCATION
expr = (LOCATION_LINE (init->where.lb->location)
> LOCATION_LINE (rvalue->where.lb->location))
- ? init : rvalue;
+ ? init : rvalue;
#else
- expr = (init->where.lb->linenum > rvalue->where.lb->linenum) ?
- init : rvalue;
+ expr = (init->where.lb->linenum > rvalue->where.lb->linenum)
+ ? init : rvalue;
#endif
gfc_notify_std (GFC_STD_GNU, "Extension: re-initialization "
"of '%s' at %L", symbol->name, &expr->where);
@@ -400,12 +405,13 @@ gfc_assign_data_value (gfc_expr * lvalue, gfc_expr * rvalue, mpz_t index)
last_con->expr = expr;
}
+
/* Similarly, but initialize REPEAT consecutive values in LVALUE the same
value in RVALUE. For the nonce, LVALUE must refer to a full array, not
an array section. */
void
-gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
+gfc_assign_data_value_range (gfc_expr *lvalue, gfc_expr *rvalue,
mpz_t index, mpz_t repeat)
{
gfc_ref *ref;
@@ -471,42 +477,44 @@ gfc_assign_data_value_range (gfc_expr * lvalue, gfc_expr * rvalue,
/* Find the same element in the existing constructor. */
- /* Splay tree containing offset and gfc_constructor. */
- spt = expr->con_by_offset;
-
- if (spt == NULL)
- {
- spt = splay_tree_new (splay_tree_compare_ints,NULL,NULL);
- expr->con_by_offset = spt;
- con = NULL;
- }
- else
- con = find_con_by_offset (spt, offset);
-
- if (con == NULL)
- {
- /* Create a new constructor. */
- con = gfc_get_constructor ();
- mpz_set (con->n.offset, offset);
- if (ref->next == NULL)
- mpz_set (con->repeat, repeat);
- sptn = splay_tree_insert (spt, (splay_tree_key) mpz_get_si(offset),
- (splay_tree_value) con);
- /* Fix up the linked list. */
- sptn = splay_tree_predecessor (spt, (splay_tree_key) mpz_get_si(offset));
- if (sptn == NULL)
- { /* Insert at the head. */
- con->next = expr->value.constructor;
- expr->value.constructor = con;
- }
- else
- { /* Insert in the chain. */
- pred = (gfc_constructor*) sptn->value;
- con->next = pred->next;
- pred->next = con;
- }
- }
- else
+ /* Splay tree containing offset and gfc_constructor. */
+ spt = expr->con_by_offset;
+
+ if (spt == NULL)
+ {
+ spt = splay_tree_new (splay_tree_compare_ints, NULL, NULL);
+ expr->con_by_offset = spt;
+ con = NULL;
+ }
+ else
+ con = find_con_by_offset (spt, offset);
+
+ if (con == NULL)
+ {
+ splay_tree_key j;
+ /* Create a new constructor. */
+ con = gfc_get_constructor ();
+ mpz_set (con->n.offset, offset);
+ j = (splay_tree_key) mpz_get_si (offset);
+
+ if (ref->next == NULL)
+ mpz_set (con->repeat, repeat);
+ sptn = splay_tree_insert (spt, j, (splay_tree_value) con);
+ /* Fix up the linked list. */
+ sptn = splay_tree_predecessor (spt, j);
+ if (sptn == NULL)
+ { /* Insert at the head. */
+ con->next = expr->value.constructor;
+ expr->value.constructor = con;
+ }
+ else
+ { /* Insert in the chain. */
+ pred = (gfc_constructor*) sptn->value;
+ con->next = pred->next;
+ pred->next = con;
+ }
+ }
+ else
gcc_assert (ref->next != NULL);
break;
@@ -612,10 +620,9 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
else
cmp = mpz_cmp (section_index[i], ar->as->upper[i]->value.integer);
- if ((cmp > 0 && forwards)
- || (cmp < 0 && ! forwards))
+ if ((cmp > 0 && forwards) || (cmp < 0 && !forwards))
{
- /* Reset index to start, then loop to advance the next index. */
+ /* Reset index to start, then loop to advance the next index. */
if (ar->start[i])
mpz_set (section_index[i], ar->start[i]->value.integer);
else
@@ -635,7 +642,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
mpz_add (*offset_ret, tmp, *offset_ret);
mpz_sub (tmp, ar->as->upper[i]->value.integer,
- ar->as->lower[i]->value.integer);
+ ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
@@ -648,7 +655,7 @@ gfc_advance_section (mpz_t *section_index, gfc_array_ref *ar,
order. Also insert NULL entries if necessary. */
static void
-formalize_structure_cons (gfc_expr * expr)
+formalize_structure_cons (gfc_expr *expr)
{
gfc_constructor *head;
gfc_constructor *tail;
@@ -710,7 +717,7 @@ formalize_structure_cons (gfc_expr * expr)
elements of the constructors are in the correct order. */
static void
-formalize_init_expr (gfc_expr * expr)
+formalize_init_expr (gfc_expr *expr)
{
expr_t type;
gfc_constructor *c;
@@ -789,7 +796,7 @@ gfc_get_section_index (gfc_array_ref *ar, mpz_t *section_index, mpz_t *offset)
}
mpz_sub (tmp, ar->as->upper[i]->value.integer,
- ar->as->lower[i]->value.integer);
+ ar->as->lower[i]->value.integer);
mpz_add_ui (tmp, tmp, 1);
mpz_mul (delta, tmp, delta);
}
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index b2f401f6efb..2470722b8b2 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1,5 +1,6 @@
/* Declaration statement matcher
- Copyright (C) 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -19,14 +20,12 @@ along with GCC; see the file COPYING. If not, write to the Free
Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA. */
-
#include "config.h"
#include "system.h"
#include "gfortran.h"
#include "match.h"
#include "parse.h"
-
/* This flag is set if an old-style length selector is matched
during a type-declaration statement. */
@@ -91,7 +90,7 @@ gfc_set_in_match_data (bool set_value)
/* Free a gfc_data_variable structure and everything beneath it. */
static void
-free_variable (gfc_data_variable * p)
+free_variable (gfc_data_variable *p)
{
gfc_data_variable *q;
@@ -101,7 +100,6 @@ free_variable (gfc_data_variable * p)
gfc_free_expr (p->expr);
gfc_free_iterator (&p->iter, 0);
free_variable (p->list);
-
gfc_free (p);
}
}
@@ -110,7 +108,7 @@ free_variable (gfc_data_variable * p)
/* Free a gfc_data_value structure and everything beneath it. */
static void
-free_value (gfc_data_value * p)
+free_value (gfc_data_value *p)
{
gfc_data_value *q;
@@ -126,23 +124,22 @@ free_value (gfc_data_value * p)
/* Free a list of gfc_data structures. */
void
-gfc_free_data (gfc_data * p)
+gfc_free_data (gfc_data *p)
{
gfc_data *q;
for (; p; p = q)
{
q = p->next;
-
free_variable (p->var);
free_value (p->value);
-
gfc_free (p);
}
}
/* Free all data in a namespace. */
+
static void
gfc_free_data_all (gfc_namespace * ns)
{
@@ -163,7 +160,7 @@ static match var_element (gfc_data_variable *);
parenthesis. */
static match
-var_list (gfc_data_variable * parent)
+var_list (gfc_data_variable *parent)
{
gfc_data_variable *tail, var;
match m;
@@ -216,7 +213,7 @@ syntax:
variable-iterator list. */
static match
-var_element (gfc_data_variable * new)
+var_element (gfc_data_variable *new)
{
match m;
gfc_symbol *sym;
@@ -232,7 +229,8 @@ var_element (gfc_data_variable * new)
sym = new->expr->symtree->n.sym;
- if (!sym->attr.function && gfc_current_ns->parent && gfc_current_ns->parent == sym->ns)
+ if (!sym->attr.function && gfc_current_ns->parent
+ && gfc_current_ns->parent == sym->ns)
{
gfc_error ("Host associated variable '%s' may not be in the DATA "
"statement at %C", sym->name);
@@ -240,10 +238,10 @@ var_element (gfc_data_variable * new)
}
if (gfc_current_state () != COMP_BLOCK_DATA
- && sym->attr.in_common
- && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of "
- "common block variable '%s' in DATA statement at %C",
- sym->name) == FAILURE)
+ && sym->attr.in_common
+ && gfc_notify_std (GFC_STD_GNU, "Extension: initialization of "
+ "common block variable '%s' in DATA statement at %C",
+ sym->name) == FAILURE)
return MATCH_ERROR;
if (gfc_add_data (&sym->attr, sym->name, &new->expr->where) == FAILURE)
@@ -256,7 +254,7 @@ var_element (gfc_data_variable * new)
/* Match the top-level list of data variables. */
static match
-top_var_list (gfc_data * d)
+top_var_list (gfc_data *d)
{
gfc_data_variable var, *tail, *new;
match m;
@@ -297,7 +295,7 @@ syntax:
static match
-match_data_constant (gfc_expr ** result)
+match_data_constant (gfc_expr **result)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
@@ -344,7 +342,7 @@ match_data_constant (gfc_expr ** result)
already been seen at this point. */
static match
-top_val_list (gfc_data * data)
+top_val_list (gfc_data *data)
{
gfc_data_value *new, *tail;
gfc_expr *expr;
@@ -458,6 +456,7 @@ match_old_style_init (const char *name)
return m;
}
+
/* Match the stuff following a DATA statement. If ERROR_FLAG is set,
we are matching a DATA statement and are therefore issuing an error
if we encounter something unexpected, if not, we're trying to match
@@ -535,9 +534,8 @@ match_intent_spec (void)
specification expression or a '*'. */
static match
-char_len_param_value (gfc_expr ** expr)
+char_len_param_value (gfc_expr **expr)
{
-
if (gfc_match_char ('*') == MATCH_YES)
{
*expr = NULL;
@@ -552,7 +550,7 @@ char_len_param_value (gfc_expr ** expr)
char_len_param_value in parenthesis. */
static match
-match_char_length (gfc_expr ** expr)
+match_char_length (gfc_expr **expr)
{
int length;
match m;
@@ -602,13 +600,13 @@ syntax:
(located in another namespace). */
static int
-find_special (const char *name, gfc_symbol ** result)
+find_special (const char *name, gfc_symbol **result)
{
gfc_state_data *s;
int i;
i = gfc_get_symbol (name, NULL, result);
- if (i==0)
+ if (i == 0)
goto end;
if (gfc_current_state () != COMP_SUBROUTINE
@@ -622,7 +620,7 @@ find_special (const char *name, gfc_symbol ** result)
if (s->state != COMP_INTERFACE)
goto end;
if (s->sym == NULL)
- goto end; /* Nameless interface */
+ goto end; /* Nameless interface */
if (strcmp (name, s->sym->name) == 0)
{
@@ -642,8 +640,7 @@ end:
parent, then the symbol is just created in the current unit. */
static int
-get_proc_name (const char *name, gfc_symbol ** result,
- bool module_fcn_entry)
+get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry)
{
gfc_symtree *st;
gfc_symbol *sym;
@@ -671,9 +668,9 @@ get_proc_name (const char *name, gfc_symbol ** result,
this is handled using gsymbols to register unique,globally
accessible names. */
if (sym->attr.flavor != 0
- && sym->attr.proc != 0
- && (sym->attr.subroutine || sym->attr.function)
- && sym->attr.if_source != IFSRC_UNKNOWN)
+ && sym->attr.proc != 0
+ && (sym->attr.subroutine || sym->attr.function)
+ && sym->attr.if_source != IFSRC_UNKNOWN)
gfc_error_now ("Procedure '%s' at %C is already defined at %L",
name, &sym->declared_at);
@@ -681,13 +678,13 @@ get_proc_name (const char *name, gfc_symbol ** result,
signature for this is that ts.kind is set. Legitimate
references only set ts.type. */
if (sym->ts.kind != 0
- && !sym->attr.implicit_type
- && sym->attr.proc == 0
- && gfc_current_ns->parent != NULL
- && sym->attr.access == 0
- && !module_fcn_entry)
- gfc_error_now ("Procedure '%s' at %C has an explicit interface"
- " and must not have attributes declared at %L",
+ && !sym->attr.implicit_type
+ && sym->attr.proc == 0
+ && gfc_current_ns->parent != NULL
+ && sym->attr.access == 0
+ && !module_fcn_entry)
+ gfc_error_now ("Procedure '%s' at %C has an explicit interface "
+ "and must not have attributes declared at %L",
name, &sym->declared_at);
}
@@ -707,10 +704,10 @@ get_proc_name (const char *name, gfc_symbol ** result,
/* See if the procedure should be a module procedure */
if (((sym->ns->proc_name != NULL
- && sym->ns->proc_name->attr.flavor == FL_MODULE
- && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
- && gfc_add_procedure (&sym->attr, PROC_MODULE,
- sym->name, NULL) == FAILURE)
+ && sym->ns->proc_name->attr.flavor == FL_MODULE
+ && sym->attr.proc != PROC_MODULE) || module_fcn_entry)
+ && gfc_add_procedure (&sym->attr, PROC_MODULE,
+ sym->name, NULL) == FAILURE)
rc = 2;
return rc;
@@ -721,21 +718,20 @@ get_proc_name (const char *name, gfc_symbol ** result,
table. */
static try
-build_sym (const char *name, gfc_charlen * cl,
- gfc_array_spec ** as, locus * var_locus)
+build_sym (const char *name, gfc_charlen *cl,
+ gfc_array_spec **as, locus *var_locus)
{
symbol_attribute attr;
gfc_symbol *sym;
- /* if (find_special (name, &sym)) */
if (gfc_get_symbol (name, NULL, &sym))
return FAILURE;
/* Start updating the symbol table. Add basic type attribute
if present. */
if (current_ts.type != BT_UNKNOWN
- &&(sym->attr.implicit_type == 0
- || !gfc_compare_types (&sym->ts, &current_ts))
+ && (sym->attr.implicit_type == 0
+ || !gfc_compare_types (&sym->ts, &current_ts))
&& gfc_add_type (sym, &current_ts, var_locus) == FAILURE)
return FAILURE;
@@ -758,13 +754,14 @@ build_sym (const char *name, gfc_charlen * cl,
return SUCCESS;
}
+
/* Set character constant to the given length. The constant will be padded or
truncated. */
void
-gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
+gfc_set_constant_character_len (int len, gfc_expr *expr, bool array)
{
- char * s;
+ char *s;
int slen;
gcc_assert (expr->expr_type == EXPR_CONSTANT);
@@ -787,7 +784,7 @@ gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
if (array && slen < len && !(gfc_option.allow_std & GFC_STD_GNU))
gfc_error_now ("The CHARACTER elements of the array constructor "
"at %L must have the same length (%d/%d)",
- &expr->where, slen, len);
+ &expr->where, slen, len);
s[len] = '\0';
gfc_free (expr->value.character.string);
@@ -806,7 +803,7 @@ gfc_set_constant_character_len (int len, gfc_expr * expr, bool array)
INIT points to its enumerator value. */
static void
-create_enum_history(gfc_symbol *sym, gfc_expr *init)
+create_enum_history (gfc_symbol *sym, gfc_expr *init)
{
enumerator_history *new_enum_history;
gcc_assert (sym != NULL && init != NULL);
@@ -829,7 +826,7 @@ create_enum_history(gfc_symbol *sym, gfc_expr *init)
if (mpz_cmp (max_enum->initializer->value.integer,
new_enum_history->initializer->value.integer) < 0)
- max_enum = new_enum_history;
+ max_enum = new_enum_history;
}
}
@@ -837,7 +834,7 @@ create_enum_history(gfc_symbol *sym, gfc_expr *init)
/* Function to free enum kind history. */
void
-gfc_free_enum_history(void)
+gfc_free_enum_history (void)
{
enumerator_history *current = enum_history;
enumerator_history *next;
@@ -857,8 +854,8 @@ 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;
@@ -905,9 +902,8 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
initializer. */
if (sym->attr.data)
{
- gfc_error
- ("Variable '%s' at %C with an initializer already appears "
- "in a DATA statement", sym->name);
+ gfc_error ("Variable '%s' at %C with an initializer already "
+ "appears in a DATA statement", sym->name);
return FAILURE;
}
@@ -924,13 +920,13 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
{
/* If there are multiple CHARACTER variables declared on
the same line, we don't want them to share the same
- length. */
+ length. */
sym->ts.cl = gfc_get_charlen ();
sym->ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = sym->ts.cl;
if (sym->attr.flavor == FL_PARAMETER
- && init->expr_type == EXPR_ARRAY)
+ && init->expr_type == EXPR_ARRAY)
sym->ts.cl->length = gfc_copy_expr (init->ts.cl->length);
}
/* Update initializer character length according symbol. */
@@ -971,8 +967,8 @@ add_init_expr_to_sym (const char *name, gfc_expr ** initp,
being built. */
static try
-build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
- gfc_array_spec ** as)
+build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
+ gfc_array_spec **as)
{
gfc_component *c;
@@ -986,8 +982,7 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
return FAILURE;
}
- if (gfc_current_block ()->attr.pointer
- && (*as)->rank != 0)
+ if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)
{
if ((*as)->type != AS_DEFERRED && (*as)->type != AS_EXPLICIT)
{
@@ -1046,9 +1041,8 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
{
if (c->as->type != AS_EXPLICIT)
{
- gfc_error
- ("Array component of structure at %C must have an explicit "
- "shape");
+ gfc_error ("Array component of structure at %C must have an "
+ "explicit shape");
return FAILURE;
}
}
@@ -1060,7 +1054,7 @@ build_struct (const char *name, gfc_charlen * cl, gfc_expr ** init,
/* Match a 'NULL()', and possibly take care of some side effects. */
match
-gfc_match_null (gfc_expr ** result)
+gfc_match_null (gfc_expr **result)
{
gfc_symbol *sym;
gfc_expr *e;
@@ -1166,7 +1160,7 @@ variable_decl (int elem)
element. */
case MATCH_NO:
if (elem > 1 && current_ts.cl->length
- && current_ts.cl->length->expr_type != EXPR_CONSTANT)
+ && current_ts.cl->length->expr_type != EXPR_CONSTANT)
{
cl = gfc_get_charlen ();
cl->next = gfc_current_ns->cl_list;
@@ -1249,10 +1243,10 @@ variable_decl (int elem)
that the interface may specify a procedure that is not pure if the procedure
is defined to be pure(12.3.2). */
if (current_ts.type == BT_DERIVED
- && gfc_current_ns->proc_name
- && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
- && current_ts.derived->ns != gfc_current_ns
- && !gfc_current_ns->has_import_set)
+ && gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY
+ && current_ts.derived->ns != gfc_current_ns
+ && !gfc_current_ns->has_import_set)
{
gfc_error ("the type of '%s' at %C has not been declared within the "
"interface", name);
@@ -1298,7 +1292,6 @@ variable_decl (int elem)
{
if (gfc_match (" =>") == MATCH_YES)
{
-
if (!current_attr.pointer)
{
gfc_error ("Initialization at %C isn't for a pointer variable");
@@ -1315,9 +1308,8 @@ variable_decl (int elem)
if (gfc_pure (NULL))
{
- gfc_error
- ("Initialization of pointer at %C is not allowed in a "
- "PURE procedure");
+ gfc_error ("Initialization of pointer at %C is not allowed in "
+ "a PURE procedure");
m = MATCH_ERROR;
}
@@ -1329,8 +1321,8 @@ variable_decl (int elem)
{
if (current_attr.pointer)
{
- gfc_error
- ("Pointer initialization at %C requires '=>', not '='");
+ gfc_error ("Pointer initialization at %C requires '=>', "
+ "not '='");
m = MATCH_ERROR;
goto cleanup;
}
@@ -1344,9 +1336,8 @@ variable_decl (int elem)
if (current_attr.flavor != FL_PARAMETER && gfc_pure (NULL))
{
- gfc_error
- ("Initialization of variable at %C is not allowed in a "
- "PURE procedure");
+ gfc_error ("Initialization of variable at %C is not allowed in "
+ "a PURE procedure");
m = MATCH_ERROR;
}
@@ -1358,7 +1349,8 @@ variable_decl (int elem)
if (initializer != NULL && current_attr.allocatable
&& gfc_current_state () == COMP_DERIVED)
{
- gfc_error ("Initialization of allocatable component at %C is not allowed");
+ gfc_error ("Initialization of allocatable component at %C is not "
+ "allowed");
m = MATCH_ERROR;
goto cleanup;
}
@@ -1371,16 +1363,16 @@ variable_decl (int elem)
if (gfc_current_state () == COMP_ENUM)
{
if (initializer == NULL)
- initializer = gfc_enum_initializer (last_initializer, old_locus);
+ initializer = gfc_enum_initializer (last_initializer, old_locus);
if (initializer == NULL || initializer->ts.type != BT_INTEGER)
- {
- gfc_error("ENUMERATOR %L not initialized with integer expression",
+ {
+ gfc_error("ENUMERATOR %L not initialized with integer expression",
&var_locus);
- m = MATCH_ERROR;
- gfc_free_enum_history ();
- goto cleanup;
- }
+ m = MATCH_ERROR;
+ gfc_free_enum_history ();
+ goto cleanup;
+ }
/* Store this current initializer, for the next enumerator
variable to be parsed. */
@@ -1395,8 +1387,7 @@ variable_decl (int elem)
else
{
if (current_ts.type == BT_DERIVED
- && !current_attr.pointer
- && !initializer)
+ && !current_attr.pointer && !initializer)
initializer = gfc_default_initializer (&current_ts);
t = build_struct (name, cl, &initializer, &as);
}
@@ -1415,7 +1406,7 @@ cleanup:
/* Match an extended-f77 kind specification. */
match
-gfc_match_old_kind_spec (gfc_typespec * ts)
+gfc_match_old_kind_spec (gfc_typespec *ts)
{
match m;
int original_kind;
@@ -1433,18 +1424,18 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
if (ts->type == BT_COMPLEX)
{
if (ts->kind % 2)
- {
- gfc_error ("Old-style type declaration %s*%d not supported at %C",
- gfc_basic_typename (ts->type), original_kind);
- return MATCH_ERROR;
- }
+ {
+ gfc_error ("Old-style type declaration %s*%d not supported at %C",
+ gfc_basic_typename (ts->type), original_kind);
+ return MATCH_ERROR;
+ }
ts->kind /= 2;
}
if (gfc_validate_kind (ts->type, ts->kind, true) < 0)
{
gfc_error ("Old-style type declaration %s*%d not supported at %C",
- gfc_basic_typename (ts->type), original_kind);
+ gfc_basic_typename (ts->type), original_kind);
return MATCH_ERROR;
}
@@ -1461,7 +1452,7 @@ gfc_match_old_kind_spec (gfc_typespec * ts)
string is found, then we know we have an error. */
match
-gfc_match_kind_spec (gfc_typespec * ts)
+gfc_match_kind_spec (gfc_typespec *ts)
{
locus where;
gfc_expr *e;
@@ -1532,7 +1523,7 @@ no_match:
declaration. We don't return MATCH_NO. */
static match
-match_char_spec (gfc_typespec * ts)
+match_char_spec (gfc_typespec *ts)
{
int i, kind, seen_length;
gfc_charlen *cl;
@@ -1584,7 +1575,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);
@@ -1691,7 +1682,7 @@ done:
statement correctly. */
static match
-match_type_spec (gfc_typespec * ts, int implicit_flag)
+match_type_spec (gfc_typespec *ts, int implicit_flag)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
@@ -1804,7 +1795,7 @@ get_kind:
{
c = gfc_peek_char();
if (!gfc_is_whitespace(c) && c != '*' && c != '('
- && c != ':' && c != ',')
+ && c != ':' && c != ',')
return MATCH_NO;
}
@@ -1827,7 +1818,6 @@ get_kind:
match
gfc_match_implicit_none (void)
{
-
return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
}
@@ -1898,10 +1888,10 @@ match_implicit_range (void)
}
/* See if we can add the newly matched range to the pending
- implicits from this IMPLICIT statement. We do not check for
- conflicts with whatever earlier IMPLICIT statements may have
- set. This is done when we've successfully finished matching
- the current one. */
+ implicits from this IMPLICIT statement. We do not check for
+ conflicts with whatever earlier IMPLICIT statements may have
+ set. This is done when we've successfully finished matching
+ the current one. */
if (gfc_add_new_implicit_range (c1, c2) != SUCCESS)
goto bad;
}
@@ -2053,8 +2043,7 @@ gfc_match_import (void)
return MATCH_ERROR;
}
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: IMPORT statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: IMPORT statement at %C")
== FAILURE)
return MATCH_ERROR;
@@ -2068,10 +2057,10 @@ gfc_match_import (void)
if (gfc_match (" ::") == MATCH_YES)
{
if (gfc_match_eos () == MATCH_YES)
- {
- gfc_error ("Expecting list of named entities at %C");
- return MATCH_ERROR;
- }
+ {
+ gfc_error ("Expecting list of named entities at %C");
+ return MATCH_ERROR;
+ }
}
for(;;)
@@ -2080,30 +2069,30 @@ gfc_match_import (void)
switch (m)
{
case MATCH_YES:
- if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
- {
- gfc_error ("Type name '%s' at %C is ambiguous", name);
- return MATCH_ERROR;
- }
-
- if (sym == NULL)
- {
- gfc_error ("Cannot IMPORT '%s' from host scoping unit "
- "at %C - does not exist.", name);
- return MATCH_ERROR;
- }
-
- if (gfc_find_symtree (gfc_current_ns->sym_root,name))
- {
- gfc_warning ("'%s' is already IMPORTed from host scoping unit "
- "at %C.", name);
- goto next_item;
- }
-
- st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
- st->n.sym = sym;
- sym->refs++;
- sym->ns = gfc_current_ns;
+ if (gfc_find_symbol (name, gfc_current_ns->parent, 1, &sym))
+ {
+ gfc_error ("Type name '%s' at %C is ambiguous", name);
+ return MATCH_ERROR;
+ }
+
+ if (sym == NULL)
+ {
+ gfc_error ("Cannot IMPORT '%s' from host scoping unit "
+ "at %C - does not exist.", name);
+ return MATCH_ERROR;
+ }
+
+ if (gfc_find_symtree (gfc_current_ns->sym_root,name))
+ {
+ gfc_warning ("'%s' is already IMPORTed from host scoping unit "
+ "at %C.", name);
+ goto next_item;
+ }
+
+ st = gfc_new_symtree (&gfc_current_ns->sym_root, name);
+ st->n.sym = sym;
+ sym->refs++;
+ sym->ns = gfc_current_ns;
goto next_item;
@@ -2141,7 +2130,6 @@ syntax:
static match
match_attr_spec (void)
{
-
/* Modifiers that can exist in a type statement. */
typedef enum
{ GFC_DECL_BEGIN = 0,
@@ -2203,10 +2191,10 @@ match_attr_spec (void)
break;
if (gfc_current_state () == COMP_ENUM)
- {
- gfc_error ("Enumerator cannot have attributes %C");
- return MATCH_ERROR;
- }
+ {
+ gfc_error ("Enumerator cannot have attributes %C");
+ return MATCH_ERROR;
+ }
seen[d]++;
seen_at[d] = gfc_current_locus;
@@ -2232,10 +2220,10 @@ match_attr_spec (void)
{
t = gfc_add_flavor (&current_attr, FL_PARAMETER, NULL, NULL);
if (t == FAILURE)
- {
- m = MATCH_ERROR;
- goto cleanup;
- }
+ {
+ m = MATCH_ERROR;
+ goto cleanup;
+ }
}
/* No double colon, so assume that we've been looking at something
@@ -2326,16 +2314,15 @@ match_attr_spec (void)
{
if (d == DECL_ALLOCATABLE)
{
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: ALLOCATABLE "
- "attribute at %C in a TYPE "
- "definition") == FAILURE)
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ALLOCATABLE "
+ "attribute at %C in a TYPE definition")
+ == FAILURE)
{
m = MATCH_ERROR;
goto cleanup;
}
- }
- else
+ }
+ else
{
gfc_error ("Attribute at %L is not allowed in a TYPE definition",
&seen_at[d]);
@@ -2345,7 +2332,7 @@ match_attr_spec (void)
}
if ((d == DECL_PRIVATE || d == DECL_PUBLIC)
- && gfc_current_state () != COMP_MODULE)
+ && gfc_current_state () != COMP_MODULE)
{
if (d == DECL_PRIVATE)
attr = "PRIVATE";
@@ -2409,8 +2396,8 @@ match_attr_spec (void)
break;
}
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: PROTECTED attribute at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED "
+ "attribute at %C")
== FAILURE)
t = FAILURE;
else
@@ -2436,8 +2423,8 @@ match_attr_spec (void)
break;
case DECL_VALUE:
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: VALUE attribute at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE attribute "
+ "at %C")
== FAILURE)
t = FAILURE;
else
@@ -2446,7 +2433,7 @@ match_attr_spec (void)
case DECL_VOLATILE:
if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: VOLATILE attribute at %C")
+ "Fortran 2003: VOLATILE attribute at %C")
== FAILURE)
t = FAILURE;
else
@@ -2515,18 +2502,18 @@ gfc_match_data_decl (void)
goto ok;
gfc_find_symbol (current_ts.derived->name,
- current_ts.derived->ns->parent, 1, &sym);
+ current_ts.derived->ns->parent, 1, &sym);
/* Any symbol that we find had better be a type definition
- which has its components defined. */
+ which has its components defined. */
if (sym != NULL && sym->attr.flavor == FL_DERIVED
- && current_ts.derived->components != NULL)
+ && current_ts.derived->components != NULL)
goto ok;
/* Now we have an error, which we signal, and then fix up
because the knock-on is plain and simple confusing. */
gfc_error_now ("Derived type at %C has not been previously defined "
- "and so cannot appear in a derived type definition");
+ "and so cannot appear in a derived type definition");
current_attr.pointer = 1;
goto ok;
}
@@ -2574,7 +2561,7 @@ cleanup:
returned (the null string was matched). */
static match
-match_prefix (gfc_typespec * ts)
+match_prefix (gfc_typespec *ts)
{
int seen_type;
@@ -2623,9 +2610,8 @@ loop:
/* Copy attributes matched by match_prefix() to attributes on a symbol. */
static try
-copy_prefix (symbol_attribute * dest, locus * where)
+copy_prefix (symbol_attribute *dest, locus *where)
{
-
if (current_attr.pure && gfc_add_pure (dest, where) == FAILURE)
return FAILURE;
@@ -2642,7 +2628,7 @@ copy_prefix (symbol_attribute * dest, locus * where)
/* Match a formal argument list. */
match
-gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag)
+gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, int null_flag)
{
gfc_formal_arglist *head, *tail, *p, *q;
char name[GFC_MAX_SYMBOL_LEN + 1];
@@ -2688,8 +2674,8 @@ gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag)
tail->sym = sym;
/* We don't add the VARIABLE flavor because the name could be a
- dummy procedure. We don't apply these attributes to formal
- arguments of statement functions. */
+ dummy procedure. We don't apply these attributes to formal
+ arguments of statement functions. */
if (sym != NULL && !st_flag
&& (gfc_add_dummy (&sym->attr, sym->name, NULL) == FAILURE
|| gfc_missing_attr (&sym->attr, NULL) == FAILURE))
@@ -2699,8 +2685,8 @@ gfc_match_formal_arglist (gfc_symbol * progname, int st_flag, int null_flag)
}
/* The name of a program unit can be in a different namespace,
- so check for it explicitly. After the statement is accepted,
- the name is checked for especially in gfc_get_symbol(). */
+ so check for it explicitly. After the statement is accepted,
+ the name is checked for especially in gfc_get_symbol(). */
if (gfc_new_block != NULL && sym != NULL
&& strcmp (sym->name, gfc_new_block->name) == 0)
{
@@ -2733,9 +2719,8 @@ ok:
for (q = p->next; q; q = q->next)
if (p->sym == q->sym)
{
- gfc_error
- ("Duplicate symbol '%s' in formal argument list at %C",
- p->sym->name);
+ gfc_error ("Duplicate symbol '%s' in formal argument list "
+ "at %C", p->sym->name);
m = MATCH_ERROR;
goto cleanup;
@@ -2762,7 +2747,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;
@@ -2783,8 +2768,7 @@ match_result (gfc_symbol * function, gfc_symbol ** result)
if (strcmp (function->name, name) == 0)
{
- gfc_error
- ("RESULT variable at %C must be different than function name");
+ gfc_error ("RESULT variable at %C must be different than function name");
return MATCH_ERROR;
}
@@ -2841,7 +2825,7 @@ gfc_match_function_decl (void)
if (m == MATCH_NO)
{
gfc_error ("Expected formal argument list in function "
- "definition at %C");
+ "definition at %C");
m = MATCH_ERROR;
goto cleanup;
}
@@ -2874,9 +2858,8 @@ gfc_match_function_decl (void)
|| copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
goto cleanup;
- if (current_ts.type != BT_UNKNOWN
- && sym->ts.type != BT_UNKNOWN
- && !sym->attr.implicit_type)
+ if (current_ts.type != BT_UNKNOWN && sym->ts.type != BT_UNKNOWN
+ && !sym->attr.implicit_type)
{
gfc_error ("Function '%s' at %C already has a type of %s", name,
gfc_basic_typename (sym->ts.type));
@@ -2901,19 +2884,21 @@ cleanup:
return m;
}
-/* This is mostly a copy of parse.c(add_global_procedure) but modified to pass the
- name of the entry, rather than the gfc_current_block name, and to return false
- upon finding an existing global entry. */
+
+/* This is mostly a copy of parse.c(add_global_procedure) but modified to
+ pass the name of the entry, rather than the gfc_current_block name, and
+ to return false upon finding an existing global entry. */
static bool
-add_global_entry (const char * name, int sub)
+add_global_entry (const char *name, int sub)
{
gfc_gsymbol *s;
s = gfc_get_gsymbol(name);
if (s->defined
- || (s->type != GSYM_UNKNOWN && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
+ || (s->type != GSYM_UNKNOWN
+ && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
global_used(s, NULL);
else
{
@@ -2925,6 +2910,7 @@ add_global_entry (const char * name, int sub)
return false;
}
+
/* Match an ENTRY statement. */
match
@@ -2956,42 +2942,40 @@ gfc_match_entry (void)
gfc_error ("ENTRY statement at %C cannot appear within a MODULE");
break;
case COMP_BLOCK_DATA:
- gfc_error
- ("ENTRY statement at %C cannot appear within a BLOCK DATA");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a BLOCK DATA");
break;
case COMP_INTERFACE:
- gfc_error
- ("ENTRY statement at %C cannot appear within an INTERFACE");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "an INTERFACE");
break;
case COMP_DERIVED:
- gfc_error
- ("ENTRY statement at %C cannot appear "
- "within a DERIVED TYPE block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a DERIVED TYPE block");
break;
case COMP_IF:
- gfc_error
- ("ENTRY statement at %C cannot appear within an IF-THEN block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "an IF-THEN block");
break;
case COMP_DO:
- gfc_error
- ("ENTRY statement at %C cannot appear within a DO block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a DO block");
break;
case COMP_SELECT:
- gfc_error
- ("ENTRY statement at %C cannot appear within a SELECT block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a SELECT block");
break;
case COMP_FORALL:
- gfc_error
- ("ENTRY statement at %C cannot appear within a FORALL block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a FORALL block");
break;
case COMP_WHERE:
- gfc_error
- ("ENTRY statement at %C cannot appear within a WHERE block");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a WHERE block");
break;
case COMP_CONTAINS:
- gfc_error
- ("ENTRY statement at %C cannot appear "
- "within a contained subprogram");
+ gfc_error ("ENTRY statement at %C cannot appear within "
+ "a contained subprogram");
break;
default:
gfc_internal_error ("gfc_match_entry(): Bad state");
@@ -3000,8 +2984,9 @@ gfc_match_entry (void)
}
module_procedure = gfc_current_ns->parent != NULL
- && gfc_current_ns->parent->proc_name
- && gfc_current_ns->parent->proc_name->attr.flavor == FL_MODULE;
+ && gfc_current_ns->parent->proc_name
+ && gfc_current_ns->parent->proc_name->attr.flavor
+ == FL_MODULE;
if (gfc_current_ns->parent != NULL
&& gfc_current_ns->parent->proc_name
@@ -3040,14 +3025,14 @@ gfc_match_entry (void)
else
{
/* An entry in a function.
- We need to take special care because writing
- ENTRY f()
- as
- ENTRY f
- is allowed, whereas
- ENTRY f() RESULT (r)
- can't be written as
- ENTRY f RESULT (r). */
+ We need to take special care because writing
+ ENTRY f()
+ as
+ ENTRY f
+ is allowed, whereas
+ ENTRY f() RESULT (r)
+ can't be written as
+ ENTRY f RESULT (r). */
if (!add_global_entry (name, 0))
return MATCH_ERROR;
@@ -3085,8 +3070,8 @@ gfc_match_entry (void)
if (gfc_add_result (&result->attr, result->name, NULL) == FAILURE
|| gfc_add_entry (&entry->attr, result->name, NULL) == FAILURE
- || gfc_add_function (&entry->attr, result->name,
- NULL) == FAILURE)
+ || gfc_add_function (&entry->attr, result->name, NULL)
+ == FAILURE)
return MATCH_ERROR;
entry->result = result;
@@ -3179,8 +3164,7 @@ contained_procedure (void)
for (s=gfc_state_stack; s; s=s->previous)
if ((s->state == COMP_SUBROUTINE || s->state == COMP_FUNCTION)
- && s->previous != NULL
- && s->previous->state == COMP_CONTAINS)
+ && s->previous != NULL && s->previous->state == COMP_CONTAINS)
return 1;
return 0;
@@ -3220,12 +3204,13 @@ set_enum_kind(void)
}
}
+
/* Match any of the various end-block statements. Returns the type of
END to the caller. The END INTERFACE, END IF, END DO and END
SELECT statements cannot be replaced by a single END statement. */
match
-gfc_match_end (gfc_statement * st)
+gfc_match_end (gfc_statement *st)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_compile_state state;
@@ -3240,14 +3225,14 @@ gfc_match_end (gfc_statement * st)
return MATCH_NO;
state = gfc_current_state ();
- block_name =
- gfc_current_block () == NULL ? NULL : gfc_current_block ()->name;
+ block_name = gfc_current_block () == NULL
+ ? NULL : gfc_current_block ()->name;
if (state == COMP_CONTAINS)
{
state = gfc_state_stack->previous->state;
- block_name = gfc_state_stack->previous->sym == NULL ? NULL
- : gfc_state_stack->previous->sym->name;
+ block_name = gfc_state_stack->previous->sym == NULL
+ ? NULL : gfc_state_stack->previous->sym->name;
}
switch (state)
@@ -3448,9 +3433,8 @@ attr_decl1 (void)
if (current_attr.dimension && m == MATCH_NO)
{
- gfc_error
- ("Missing array specification at %L in DIMENSION statement",
- &var_locus);
+ gfc_error ("Missing array specification at %L in DIMENSION "
+ "statement", &var_locus);
m = MATCH_ERROR;
goto cleanup;
}
@@ -3458,14 +3442,14 @@ attr_decl1 (void)
if ((current_attr.allocatable || current_attr.pointer)
&& (m == MATCH_YES) && (as->type != AS_DEFERRED))
{
- gfc_error ("Array specification must be deferred at %L",
- &var_locus);
+ gfc_error ("Array specification must be deferred at %L", &var_locus);
m = MATCH_ERROR;
goto cleanup;
}
}
- /* Update symbol table. DIMENSION attribute is set in gfc_set_array_spec(). */
+ /* Update symbol table. DIMENSION attribute is set
+ in gfc_set_array_spec(). */
if (current_attr.dimension == 0
&& gfc_copy_attr (&sym->attr, &current_attr, NULL) == FAILURE)
{
@@ -3608,8 +3592,7 @@ cray_pointer_decl (void)
else if (cptr->ts.kind < gfc_index_integer_kind)
gfc_warning ("Cray pointer at %C has %d bytes of precision;"
" memory addresses require %d bytes",
- cptr->ts.kind,
- gfc_index_integer_kind);
+ cptr->ts.kind, gfc_index_integer_kind);
if (gfc_match_char (',') != MATCH_YES)
{
@@ -3706,7 +3689,6 @@ gfc_match_external (void)
}
-
match
gfc_match_intent (void)
{
@@ -3753,8 +3735,8 @@ gfc_match_pointer (void)
{
if (!gfc_option.flag_cray_pointer)
{
- gfc_error ("Cray pointer declaration at %C requires -fcray-pointer"
- " flag");
+ gfc_error ("Cray pointer declaration at %C requires -fcray-pointer "
+ "flag");
return MATCH_ERROR;
}
return cray_pointer_decl ();
@@ -3772,7 +3754,6 @@ gfc_match_pointer (void)
match
gfc_match_allocatable (void)
{
-
gfc_clear_attr (&current_attr);
current_attr.allocatable = 1;
@@ -3783,7 +3764,6 @@ gfc_match_allocatable (void)
match
gfc_match_dimension (void)
{
-
gfc_clear_attr (&current_attr);
current_attr.dimension = 1;
@@ -3794,7 +3774,6 @@ gfc_match_dimension (void)
match
gfc_match_target (void)
{
-
gfc_clear_attr (&current_attr);
current_attr.target = 1;
@@ -3835,9 +3814,8 @@ access_attr_decl (gfc_statement st)
if (gfc_get_symbol (name, NULL, &sym))
goto done;
- if (gfc_add_access (&sym->attr,
- (st ==
- ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE,
+ if (gfc_add_access (&sym->attr, (st == ST_PUBLIC)
+ ? ACCESS_PUBLIC : ACCESS_PRIVATE,
sym->name, NULL) == FAILURE)
return MATCH_ERROR;
@@ -3863,14 +3841,13 @@ access_attr_decl (gfc_statement st)
if (uop->access == ACCESS_UNKNOWN)
{
- uop->access =
- (st == ST_PUBLIC) ? ACCESS_PUBLIC : ACCESS_PRIVATE;
+ uop->access = (st == ST_PUBLIC)
+ ? ACCESS_PUBLIC : ACCESS_PRIVATE;
}
else
{
- gfc_error
- ("Access specification of the .%s. operator at %C has "
- "already been specified", sym->name);
+ gfc_error ("Access specification of the .%s. operator at %C "
+ "has already been specified", sym->name);
goto done;
}
@@ -3907,8 +3884,7 @@ gfc_match_protected (void)
}
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: PROTECTED statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: PROTECTED statement at %C")
== FAILURE)
return MATCH_ERROR;
@@ -3926,8 +3902,8 @@ gfc_match_protected (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_protected (&sym->attr, sym->name,
- &gfc_current_locus) == FAILURE)
+ if (gfc_add_protected (&sym->attr, sym->name, &gfc_current_locus)
+ == FAILURE)
return MATCH_ERROR;
goto next_item;
@@ -3953,13 +3929,12 @@ syntax:
}
-
/* The PRIVATE statement is a bit weird in that it can be a attribute
declaration, but also works as a standlone statement inside of a
type declaration or a module. */
match
-gfc_match_private (gfc_statement * st)
+gfc_match_private (gfc_statement *st)
{
if (gfc_match ("private") != MATCH_YES)
@@ -3989,7 +3964,7 @@ gfc_match_private (gfc_statement * st)
match
-gfc_match_public (gfc_statement * st)
+gfc_match_public (gfc_statement *st)
{
if (gfc_match ("public") != MATCH_YES)
@@ -4112,9 +4087,8 @@ gfc_match_save (void)
{
if (gfc_current_ns->seen_save)
{
- if (gfc_notify_std (GFC_STD_LEGACY,
- "Blanket SAVE statement at %C follows previous "
- "SAVE statement")
+ if (gfc_notify_std (GFC_STD_LEGACY, "Blanket SAVE statement at %C "
+ "follows previous SAVE statement")
== FAILURE)
return MATCH_ERROR;
}
@@ -4125,8 +4099,8 @@ gfc_match_save (void)
if (gfc_current_ns->save_all)
{
- if (gfc_notify_std (GFC_STD_LEGACY,
- "SAVE statement at %C follows blanket SAVE statement")
+ if (gfc_notify_std (GFC_STD_LEGACY, "SAVE statement at %C follows "
+ "blanket SAVE statement")
== FAILURE)
return MATCH_ERROR;
}
@@ -4139,8 +4113,8 @@ gfc_match_save (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_save (&sym->attr, sym->name,
- &gfc_current_locus) == FAILURE)
+ if (gfc_add_save (&sym->attr, sym->name, &gfc_current_locus)
+ == FAILURE)
return MATCH_ERROR;
goto next_item;
@@ -4183,8 +4157,7 @@ gfc_match_value (void)
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: VALUE statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VALUE statement at %C")
== FAILURE)
return MATCH_ERROR;
@@ -4202,8 +4175,8 @@ gfc_match_value (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_value (&sym->attr, sym->name,
- &gfc_current_locus) == FAILURE)
+ if (gfc_add_value (&sym->attr, sym->name, &gfc_current_locus)
+ == FAILURE)
return MATCH_ERROR;
goto next_item;
@@ -4234,8 +4207,7 @@ gfc_match_volatile (void)
gfc_symbol *sym;
match m;
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: VOLATILE statement at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: VOLATILE statement at %C")
== FAILURE)
return MATCH_ERROR;
@@ -4253,8 +4225,8 @@ gfc_match_volatile (void)
switch (m)
{
case MATCH_YES:
- if (gfc_add_volatile (&sym->attr, sym->name,
- &gfc_current_locus) == FAILURE)
+ if (gfc_add_volatile (&sym->attr, sym->name, &gfc_current_locus)
+ == FAILURE)
return MATCH_ERROR;
goto next_item;
@@ -4296,8 +4268,8 @@ gfc_match_modproc (void)
|| gfc_state_stack->previous == NULL
|| current_interface.type == INTERFACE_NAMELESS)
{
- gfc_error
- ("MODULE PROCEDURE at %C must be in a generic module interface");
+ gfc_error ("MODULE PROCEDURE at %C must be in a generic module "
+ "interface");
return MATCH_ERROR;
}
@@ -4358,8 +4330,7 @@ loop:
{
if (gfc_find_state (COMP_MODULE) == FAILURE)
{
- gfc_error
- ("Derived type at %C can only be PRIVATE within a MODULE");
+ gfc_error ("Derived type at %C can only be PRIVATE within a MODULE");
return MATCH_ERROR;
}
@@ -4399,9 +4370,8 @@ loop:
|| strcmp (name, "logical") == 0
|| strcmp (name, "complex") == 0)
{
- gfc_error
- ("Type name '%s' at %C cannot be the same as an intrinsic type",
- name);
+ gfc_error ("Type name '%s' at %C cannot be the same as an intrinsic "
+ "type", name);
return MATCH_ERROR;
}
@@ -4426,9 +4396,8 @@ loop:
if (sym->components != NULL)
{
- gfc_error
- ("Derived type definition of '%s' at %C has already been defined",
- sym->name);
+ gfc_error ("Derived type definition of '%s' at %C has already been "
+ "defined", sym->name);
return MATCH_ERROR;
}
@@ -4481,8 +4450,7 @@ gfc_match_enum (void)
if (m != MATCH_YES)
return m;
- if (gfc_notify_std (GFC_STD_F2003,
- "Fortran 2003: ENUM AND ENUMERATOR at %C")
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ENUM AND ENUMERATOR at %C")
== FAILURE)
return MATCH_ERROR;
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 53bf9e181b7..e0e44c283fd 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -1,5 +1,6 @@
/* Dependency analysis
- Copyright (C) 2000, 2001, 2002, 2005, 2006 Free Software Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Paul Brook <paul@nowt.org>
This file is part of GCC.
@@ -24,7 +25,6 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
have different dependency checking functions for different types
if dependencies. Ideally these would probably be merged. */
-
#include "config.h"
#include "gfortran.h"
#include "dependency.h"
@@ -52,7 +52,7 @@ gfc_dependency;
def if the value could not be determined. */
int
-gfc_expr_is_one (gfc_expr * expr, int def)
+gfc_expr_is_one (gfc_expr *expr, int def)
{
gcc_assert (expr != NULL);
@@ -70,7 +70,7 @@ gfc_expr_is_one (gfc_expr * expr, int def)
and -2 if the relationship could not be determined. */
int
-gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
{
gfc_actual_arglist *args1;
gfc_actual_arglist *args2;
@@ -78,15 +78,14 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
if (e1->expr_type == EXPR_OP
&& (e1->value.op.operator == INTRINSIC_UPLUS
- || e1->value.op.operator == INTRINSIC_PARENTHESES))
+ || e1->value.op.operator == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1->value.op.op1, e2);
if (e2->expr_type == EXPR_OP
&& (e2->value.op.operator == INTRINSIC_UPLUS
- || e2->value.op.operator == INTRINSIC_PARENTHESES))
+ || e2->value.op.operator == INTRINSIC_PARENTHESES))
return gfc_dep_compare_expr (e1, e2->value.op.op1);
- if (e1->expr_type == EXPR_OP
- && e1->value.op.operator == INTRINSIC_PLUS)
+ if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_PLUS)
{
/* Compare X+C vs. X. */
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
@@ -95,8 +94,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
return mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P+Q vs. R+S. */
- if (e2->expr_type == EXPR_OP
- && e2->value.op.operator == INTRINSIC_PLUS)
+ if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS)
{
int l, r;
@@ -129,8 +127,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X vs. X+C. */
- if (e2->expr_type == EXPR_OP
- && e2->value.op.operator == INTRINSIC_PLUS)
+ if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_PLUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
@@ -139,8 +136,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X-C vs. X. */
- if (e1->expr_type == EXPR_OP
- && e1->value.op.operator == INTRINSIC_MINUS)
+ if (e1->expr_type == EXPR_OP && e1->value.op.operator == INTRINSIC_MINUS)
{
if (e1->value.op.op2->expr_type == EXPR_CONSTANT
&& e1->value.op.op2->ts.type == BT_INTEGER
@@ -148,8 +144,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
return -mpz_sgn (e1->value.op.op2->value.integer);
/* Compare P-Q vs. R-S. */
- if (e2->expr_type == EXPR_OP
- && e2->value.op.operator == INTRINSIC_MINUS)
+ if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS)
{
int l, r;
@@ -169,8 +164,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
}
/* Compare X vs. X-C. */
- if (e2->expr_type == EXPR_OP
- && e2->value.op.operator == INTRINSIC_MINUS)
+ if (e2->expr_type == EXPR_OP && e2->value.op.operator == INTRINSIC_MINUS)
{
if (e2->value.op.op2->expr_type == EXPR_CONSTANT
&& e2->value.op.op2->ts.type == BT_INTEGER
@@ -218,8 +212,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
case EXPR_FUNCTION:
/* We can only compare calls to the same intrinsic function. */
- if (e1->value.function.isym == 0
- || e2->value.function.isym == 0
+ if (e1->value.function.isym == 0 || e2->value.function.isym == 0
|| e1->value.function.isym != e2->value.function.isym)
return -2;
@@ -275,7 +268,7 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
if the results are indeterminate. N is the dimension to compare. */
int
-gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
+gfc_is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n, int def)
{
gfc_expr *e1;
gfc_expr *e2;
@@ -375,7 +368,7 @@ gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
whose data can be reused, otherwise return NULL. */
gfc_expr *
-gfc_get_noncopying_intrinsic_argument (gfc_expr * expr)
+gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
{
if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
return NULL;
@@ -439,8 +432,8 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
temporary. */
static int
-gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
- gfc_expr * expr)
+gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
+ gfc_expr *expr)
{
gcc_assert (var->expr_type == EXPR_VARIABLE);
gcc_assert (var->rank > 0);
@@ -472,8 +465,8 @@ gfc_check_argument_var_dependency (gfc_expr * var, sym_intent intent,
array expression OTHER, not just variables. */
static int
-gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
- gfc_expr * expr)
+gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
+ gfc_expr *expr)
{
switch (other->expr_type)
{
@@ -498,8 +491,8 @@ gfc_check_argument_dependency (gfc_expr * other, sym_intent intent,
FNSYM is the function being called, or NULL if not known. */
int
-gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
- gfc_symbol * fnsym, gfc_actual_arglist * actual)
+gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
+ gfc_symbol *fnsym, gfc_actual_arglist *actual)
{
gfc_formal_arglist *formal;
gfc_expr *expr;
@@ -518,8 +511,7 @@ gfc_check_fncall_dependency (gfc_expr * other, sym_intent intent,
continue;
/* Skip intent(in) arguments if OTHER itself is intent(in). */
- if (formal
- && intent == INTENT_IN
+ if (formal && intent == INTENT_IN
&& formal->sym->attr.intent == INTENT_IN)
continue;
@@ -550,12 +542,10 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
gfc_equiv_info *s, *fl1, *fl2;
gcc_assert (e1->expr_type == EXPR_VARIABLE
- && e2->expr_type == EXPR_VARIABLE);
+ && e2->expr_type == EXPR_VARIABLE);
if (!e1->symtree->n.sym->attr.in_equivalence
- || !e2->symtree->n.sym->attr.in_equivalence
- || !e1->rank
- || !e2->rank)
+ || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
return 0;
/* Go through the equiv_lists and return 1 if the variables
@@ -607,7 +597,7 @@ gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
temporary. */
int
-gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
+gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
{
gfc_ref *ref;
int n;
@@ -637,13 +627,10 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
return 1;
/* Symbols can only alias if they have the same type. */
- if (ts1->type != BT_UNKNOWN
- && ts2->type != BT_UNKNOWN
- && ts1->type != BT_DERIVED
- && ts2->type != BT_DERIVED)
+ if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
+ && ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
{
- if (ts1->type != ts2->type
- || ts1->kind != ts2->kind)
+ if (ts1->type != ts2->type || ts1->kind != ts2->kind)
return 0;
}
@@ -710,7 +697,7 @@ gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
/* Determines overlapping for two array sections. */
static gfc_dependency
-gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
+gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref l_ar;
gfc_expr *l_start;
@@ -761,7 +748,7 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
if (!l_stride)
l_dir = 1;
else if (l_stride->expr_type == EXPR_CONSTANT
- && l_stride->ts.type == BT_INTEGER)
+ && l_stride->ts.type == BT_INTEGER)
l_dir = mpz_sgn (l_stride->value.integer);
else if (l_start && l_end)
l_dir = gfc_dep_compare_expr (l_end, l_start);
@@ -772,7 +759,7 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
if (!r_stride)
r_dir = 1;
else if (r_stride->expr_type == EXPR_CONSTANT
- && r_stride->ts.type == BT_INTEGER)
+ && r_stride->ts.type == BT_INTEGER)
r_dir = mpz_sgn (r_stride->value.integer);
else if (r_start && r_end)
r_dir = gfc_dep_compare_expr (r_end, r_start);
@@ -827,18 +814,18 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
{
if (l_dir == 1 && r_dir == -1)
- return GFC_DEP_EQUAL;
+ return GFC_DEP_EQUAL;
if (l_dir == -1 && r_dir == 1)
- return GFC_DEP_EQUAL;
+ return GFC_DEP_EQUAL;
}
/* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL. */
if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
{
if (l_dir == 1 && r_dir == -1)
- return GFC_DEP_EQUAL;
+ return GFC_DEP_EQUAL;
if (l_dir == -1 && r_dir == 1)
- return GFC_DEP_EQUAL;
+ return GFC_DEP_EQUAL;
}
/* Check for forward dependencies x:y vs. x+1:z. */
@@ -874,7 +861,7 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
/* Determines overlapping for a single element and a section. */
static gfc_dependency
-gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
+gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref *ref;
gfc_expr *elem;
@@ -999,7 +986,7 @@ gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
return true, and assume a dependency. */
static bool
-contains_forall_index_p (gfc_expr * expr)
+contains_forall_index_p (gfc_expr *expr)
{
gfc_actual_arglist *arg;
gfc_constructor *c;
@@ -1074,7 +1061,7 @@ contains_forall_index_p (gfc_expr * expr)
/* Determines overlapping for two single element array references. */
static gfc_dependency
-gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
+gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
{
gfc_array_ref l_ar;
gfc_array_ref r_ar;
@@ -1099,8 +1086,7 @@ gfc_check_element_vs_element (gfc_ref * lref, gfc_ref * rref, int n)
/* However, we need to be careful when either scalar expression
contains a FORALL index, as these can potentially change value
during the scalarization/traversal of this array reference. */
- if (contains_forall_index_p (r_start)
- || contains_forall_index_p (l_start))
+ if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
return GFC_DEP_OVERLAP;
if (i != -2)
@@ -1141,8 +1127,7 @@ gfc_full_array_ref_p (gfc_ref *ref)
ref->u.ar.as->upper[i])))
return false;
/* Check the stride. */
- if (ref->u.ar.stride[i]
- && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+ if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
}
return true;
@@ -1155,13 +1140,12 @@ gfc_full_array_ref_p (gfc_ref *ref)
0 : array references are identical or not overlapping. */
int
-gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
+gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref)
{
int n;
gfc_dependency fin_dep;
gfc_dependency this_dep;
-
fin_dep = GFC_DEP_ERROR;
/* Dependencies due to pointers should already have been identified.
We only need to check for overlapping array references. */
@@ -1186,7 +1170,7 @@ gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
return 0;
case REF_ARRAY:
- if (lref->u.ar.dimen != rref->u.ar.dimen)
+ if (lref->u.ar.dimen != rref->u.ar.dimen)
{
if (lref->u.ar.type == AR_FULL)
fin_dep = gfc_full_array_ref_p (rref) ? GFC_DEP_EQUAL
@@ -1195,7 +1179,7 @@ gfc_dep_resolver (gfc_ref * lref, gfc_ref * rref)
fin_dep = gfc_full_array_ref_p (lref) ? GFC_DEP_EQUAL
: GFC_DEP_OVERLAP;
else
- return 1;
+ return 1;
break;
}
diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c
index 17a7bf06052..6f2a6a74f8f 100644
--- a/gcc/fortran/dump-parse-tree.c
+++ b/gcc/fortran/dump-parse-tree.c
@@ -1,5 +1,6 @@
/* Parse tree dumper
- Copyright (C) 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
+ Copyright (C) 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Steven Bosscher
This file is part of GCC.
@@ -40,7 +41,7 @@ static int show_level = 0;
/* Do indentation for a specific level. */
static inline void
-code_indent (int level, gfc_st_label * label)
+code_indent (int level, gfc_st_label *label)
{
int i;
@@ -68,9 +69,8 @@ show_indent (void)
/* Show type-specific information. */
void
-gfc_show_typespec (gfc_typespec * ts)
+gfc_show_typespec (gfc_typespec *ts)
{
-
gfc_status ("(%s ", gfc_basic_typename (ts->type));
switch (ts->type)
@@ -95,9 +95,8 @@ gfc_show_typespec (gfc_typespec * ts)
/* Show an actual argument list. */
void
-gfc_show_actual_arglist (gfc_actual_arglist * a)
+gfc_show_actual_arglist (gfc_actual_arglist *a)
{
-
gfc_status ("(");
for (; a; a = a->next)
@@ -122,7 +121,7 @@ gfc_show_actual_arglist (gfc_actual_arglist * a)
/* Show a gfc_array_spec array specification structure. */
void
-gfc_show_array_spec (gfc_array_spec * as)
+gfc_show_array_spec (gfc_array_spec *as)
{
const char *c;
int i;
@@ -144,8 +143,8 @@ gfc_show_array_spec (gfc_array_spec * as)
case AS_ASSUMED_SIZE: c = "AS_ASSUMED_SIZE"; break;
case AS_ASSUMED_SHAPE: c = "AS_ASSUMED_SHAPE"; break;
default:
- gfc_internal_error
- ("gfc_show_array_spec(): Unhandled array shape type.");
+ gfc_internal_error ("gfc_show_array_spec(): Unhandled array shape "
+ "type.");
}
gfc_status (" %s ", c);
@@ -233,9 +232,8 @@ gfc_show_array_ref (gfc_array_ref * ar)
/* Show a list of gfc_ref structures. */
void
-gfc_show_ref (gfc_ref * p)
+gfc_show_ref (gfc_ref *p)
{
-
for (; p; p = p->next)
switch (p->type)
{
@@ -264,9 +262,8 @@ gfc_show_ref (gfc_ref * p)
/* Display a constructor. Works recursively for array constructors. */
void
-gfc_show_constructor (gfc_constructor * c)
+gfc_show_constructor (gfc_constructor *c)
{
-
for (; c; c = c->next)
{
if (c->iterator == NULL)
@@ -297,7 +294,7 @@ gfc_show_constructor (gfc_constructor * c)
/* Show an expression. */
void
-gfc_show_expr (gfc_expr * p)
+gfc_show_expr (gfc_expr *p)
{
const char *c;
int i;
@@ -530,7 +527,7 @@ gfc_show_expr (gfc_expr * p)
whatever single bit attributes are present. */
void
-gfc_show_attr (symbol_attribute * attr)
+gfc_show_attr (symbol_attribute *attr)
{
gfc_status ("(%s %s %s %s", gfc_code2string (flavors, attr->flavor),
@@ -601,7 +598,7 @@ gfc_show_attr (symbol_attribute * attr)
/* Show components of a derived type. */
void
-gfc_show_components (gfc_symbol * sym)
+gfc_show_components (gfc_symbol *sym)
{
gfc_component *c;
@@ -628,7 +625,7 @@ gfc_show_components (gfc_symbol * sym)
that symbol. */
void
-gfc_show_symbol (gfc_symbol * sym)
+gfc_show_symbol (gfc_symbol *sym)
{
gfc_formal_arglist *formal;
gfc_interface *intr;
@@ -683,12 +680,12 @@ gfc_show_symbol (gfc_symbol * sym)
gfc_status ("Formal arglist:");
for (formal = sym->formal; formal; formal = formal->next)
- {
- if (formal->sym != NULL)
- gfc_status (" %s", formal->sym->name);
- else
- gfc_status (" [Alt Return]");
- }
+ {
+ if (formal->sym != NULL)
+ gfc_status (" %s", formal->sym->name);
+ else
+ gfc_status (" [Alt Return]");
+ }
}
if (sym->formal_ns)
@@ -706,7 +703,7 @@ gfc_show_symbol (gfc_symbol * sym)
and the name of the associated subroutine, really. */
static void
-show_uop (gfc_user_op * uop)
+show_uop (gfc_user_op *uop)
{
gfc_interface *intr;
@@ -721,9 +718,8 @@ show_uop (gfc_user_op * uop)
/* Workhorse function for traversing the user operator symtree. */
static void
-traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
+traverse_uop (gfc_symtree *st, void (*func) (gfc_user_op *))
{
-
if (st == NULL)
return;
@@ -737,9 +733,8 @@ traverse_uop (gfc_symtree * st, void (*func) (gfc_user_op *))
/* Traverse the tree of user operator nodes. */
void
-gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
+gfc_traverse_user_op (gfc_namespace *ns, void (*func) (gfc_user_op *))
{
-
traverse_uop (ns->uop_root, func);
}
@@ -747,7 +742,7 @@ gfc_traverse_user_op (gfc_namespace * ns, void (*func) (gfc_user_op *))
/* Function to display a common block. */
static void
-show_common (gfc_symtree * st)
+show_common (gfc_symtree *st)
{
gfc_symbol *s;
@@ -769,9 +764,8 @@ show_common (gfc_symtree * st)
/* Worker function to display the symbol tree. */
static void
-show_symtree (gfc_symtree * st)
+show_symtree (gfc_symtree *st)
{
-
show_indent ();
gfc_status ("symtree: %s Ambig %d", st->name, st->ambiguous);
@@ -786,15 +780,14 @@ show_symtree (gfc_symtree * st)
-static void gfc_show_code_node (int level, gfc_code * c);
+static void gfc_show_code_node (int, gfc_code *);
/* Show a list of code structures. Mutually recursive with
gfc_show_code_node(). */
void
-gfc_show_code (int level, gfc_code * c)
+gfc_show_code (int level, gfc_code *c)
{
-
for (; c; c = c->next)
gfc_show_code_node (level, c);
}
@@ -811,7 +804,7 @@ gfc_show_namelist (gfc_namelist *n)
if necessary. */
static void
-gfc_show_omp_node (int level, gfc_code * c)
+gfc_show_omp_node (int level, gfc_code *c)
{
gfc_omp_clauses *omp_clauses = NULL;
const char *name = NULL;
@@ -996,10 +989,11 @@ gfc_show_omp_node (int level, gfc_code * c)
gfc_status (" (%s)", c->ext.omp_name);
}
+
/* Show a single code node and everything underneath it if necessary. */
static void
-gfc_show_code_node (int level, gfc_code * c)
+gfc_show_code_node (int level, gfc_code *c)
{
gfc_forall_iterator *fa;
gfc_open *open;
@@ -1051,24 +1045,24 @@ gfc_show_code_node (int level, gfc_code * c)
case EXEC_GOTO:
gfc_status ("GOTO ");
if (c->label)
- gfc_status ("%d", c->label->value);
+ gfc_status ("%d", c->label->value);
else
- {
- gfc_show_expr (c->expr);
- d = c->block;
- if (d != NULL)
- {
- gfc_status (", (");
- for (; d; d = d ->block)
- {
- code_indent (level, d->label);
- if (d->block != NULL)
- gfc_status_char (',');
- else
- gfc_status_char (')');
- }
- }
- }
+ {
+ gfc_show_expr (c->expr);
+ d = c->block;
+ if (d != NULL)
+ {
+ gfc_status (", (");
+ for (; d; d = d ->block)
+ {
+ code_indent (level, d->label);
+ if (d->block != NULL)
+ gfc_status_char (',');
+ else
+ gfc_status_char (')');
+ }
+ }
+ }
break;
case EXEC_CALL:
@@ -1092,9 +1086,9 @@ gfc_show_code_node (int level, gfc_code * c)
gfc_status ("PAUSE ");
if (c->expr != NULL)
- gfc_show_expr (c->expr);
+ gfc_show_expr (c->expr);
else
- gfc_status ("%d", c->ext.stop_code);
+ gfc_status ("%d", c->ext.stop_code);
break;
@@ -1102,9 +1096,9 @@ gfc_show_code_node (int level, gfc_code * c)
gfc_status ("STOP ");
if (c->expr != NULL)
- gfc_show_expr (c->expr);
+ gfc_show_expr (c->expr);
else
- gfc_status ("%d", c->ext.stop_code);
+ gfc_status ("%d", c->ext.stop_code);
break;
@@ -1709,7 +1703,7 @@ gfc_show_equiv (gfc_equiv *eq)
/* Show a freakin' whole namespace. */
void
-gfc_show_namespace (gfc_namespace * ns)
+gfc_show_namespace (gfc_namespace *ns)
{
gfc_interface *intr;
gfc_namespace *save;
diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index fd8f0bb3bc0..89cd4a9ac32 100644
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -1,6 +1,6 @@
/* Handle errors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Andy Vaught & Niels Kristian Bech Jensen
This file is part of GCC.
@@ -69,12 +69,10 @@ error_char (char c)
{
if (cur_error_buffer->index >= cur_error_buffer->allocated)
{
- cur_error_buffer->allocated =
- cur_error_buffer->allocated
- ? cur_error_buffer->allocated * 2 : 1000;
- cur_error_buffer->message
- = xrealloc (cur_error_buffer->message,
- cur_error_buffer->allocated);
+ cur_error_buffer->allocated = cur_error_buffer->allocated
+ ? cur_error_buffer->allocated * 2 : 1000;
+ cur_error_buffer->message = xrealloc (cur_error_buffer->message,
+ cur_error_buffer->allocated);
}
cur_error_buffer->message[cur_error_buffer->index++] = c;
}
@@ -152,7 +150,7 @@ error_integer (int i)
static void error_printf (const char *, ...) ATTRIBUTE_GCC_GFC(1,2);
static void
-show_locus (locus * loc, int c1, int c2)
+show_locus (locus *loc, int c1, int c2)
{
gfc_linebuf *lb;
gfc_file *f;
@@ -308,7 +306,7 @@ show_locus (locus * loc, int c1, int c2)
loci may or may not be on the same source line. */
static void
-show_loci (locus * l1, locus * l2)
+show_loci (locus *l1, locus *l2)
{
int m, c1, c2;
@@ -349,7 +347,6 @@ show_loci (locus * l1, locus * l2)
show_locus (l1, c1, c2);
return;
-
}
@@ -545,10 +542,10 @@ error_print (const char *type, const char *format0, va_list argp)
}
format++;
- if (ISDIGIT(*format))
+ if (ISDIGIT (*format))
{
/* This is a position specifier. See comment above. */
- while (ISDIGIT(*format))
+ while (ISDIGIT (*format))
format++;
/* Skip over the dollar sign. */
@@ -663,17 +660,15 @@ gfc_notify_std (int std, const char *nocmsgid, ...)
va_list argp;
bool warning;
- warning = ((gfc_option.warn_std & std) != 0)
- && !inhibit_warnings;
- if ((gfc_option.allow_std & std) != 0
- && !warning)
+ warning = ((gfc_option.warn_std & std) != 0) && !inhibit_warnings;
+ if ((gfc_option.allow_std & std) != 0 && !warning)
return SUCCESS;
if (gfc_suppress_error)
return warning ? SUCCESS : FAILURE;
cur_error_buffer = (warning && !warnings_are_errors)
- ? &warning_buffer : &error_buffer;
+ ? &warning_buffer : &error_buffer;
cur_error_buffer->flag = 1;
cur_error_buffer->index = 0;
@@ -889,7 +884,7 @@ gfc_error_check (void)
/* Save the existing error state. */
void
-gfc_push_error (gfc_error_buf * err)
+gfc_push_error (gfc_error_buf *err)
{
err->flag = error_buffer.flag;
if (error_buffer.flag)
@@ -902,7 +897,7 @@ gfc_push_error (gfc_error_buf * err)
/* Restore a previous pushed error state. */
void
-gfc_pop_error (gfc_error_buf * err)
+gfc_pop_error (gfc_error_buf *err)
{
error_buffer.flag = err->flag;
if (error_buffer.flag)
@@ -918,7 +913,7 @@ gfc_pop_error (gfc_error_buf * err)
/* Free a pushed error state, but keep the current error state. */
void
-gfc_free_error (gfc_error_buf * err)
+gfc_free_error (gfc_error_buf *err)
{
if (err->flag)
gfc_free (err->message);
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 1146bd11796..dbe51888656 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1,6 +1,6 @@
/* Routines for manipulation of expression nodes.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
- Foundation, Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+ Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -34,7 +34,6 @@ gfc_get_expr (void)
gfc_expr *e;
e = gfc_getmem (sizeof (gfc_expr));
-
gfc_clear_ts (&e->ts);
e->shape = NULL;
e->ref = NULL;
@@ -47,7 +46,7 @@ gfc_get_expr (void)
/* Free an argument list and everything below it. */
void
-gfc_free_actual_arglist (gfc_actual_arglist * a1)
+gfc_free_actual_arglist (gfc_actual_arglist *a1)
{
gfc_actual_arglist *a2;
@@ -64,7 +63,7 @@ gfc_free_actual_arglist (gfc_actual_arglist * a1)
/* Copy an arglist structure and all of the arguments. */
gfc_actual_arglist *
-gfc_copy_actual_arglist (gfc_actual_arglist * p)
+gfc_copy_actual_arglist (gfc_actual_arglist *p)
{
gfc_actual_arglist *head, *tail, *new;
@@ -93,7 +92,7 @@ gfc_copy_actual_arglist (gfc_actual_arglist * p)
/* Free a list of reference structures. */
void
-gfc_free_ref_list (gfc_ref * p)
+gfc_free_ref_list (gfc_ref *p)
{
gfc_ref *q;
int i;
@@ -134,7 +133,7 @@ gfc_free_ref_list (gfc_ref * p)
something else or the expression node belongs to another structure. */
static void
-free_expr0 (gfc_expr * e)
+free_expr0 (gfc_expr *e)
{
int n;
@@ -221,9 +220,8 @@ free_expr0 (gfc_expr * e)
/* Free an expression node and everything beneath it. */
void
-gfc_free_expr (gfc_expr * e)
+gfc_free_expr (gfc_expr *e)
{
-
if (e == NULL)
return;
if (e->con_by_offset)
@@ -236,12 +234,10 @@ gfc_free_expr (gfc_expr * e)
/* Graft the *src expression onto the *dest subexpression. */
void
-gfc_replace_expr (gfc_expr * dest, gfc_expr * src)
+gfc_replace_expr (gfc_expr *dest, gfc_expr *src)
{
-
free_expr0 (dest);
*dest = *src;
-
gfc_free (src);
}
@@ -252,9 +248,8 @@ gfc_replace_expr (gfc_expr * dest, gfc_expr * src)
failure is OK for some callers. */
const char *
-gfc_extract_int (gfc_expr * expr, int *result)
+gfc_extract_int (gfc_expr *expr, int *result)
{
-
if (expr->expr_type != EXPR_CONSTANT)
return _("Constant expression required at %C");
@@ -276,7 +271,7 @@ gfc_extract_int (gfc_expr * expr, int *result)
/* Recursively copy a list of reference structures. */
static gfc_ref *
-copy_ref (gfc_ref * src)
+copy_ref (gfc_ref *src)
{
gfc_array_ref *ar;
gfc_ref *dest;
@@ -312,13 +307,12 @@ copy_ref (gfc_ref * src)
}
-/* Detect whether an expression has any vector index array
- references. */
+/* Detect whether an expression has any vector index array references. */
int
gfc_has_vector_index (gfc_expr *e)
{
- gfc_ref * ref;
+ gfc_ref *ref;
int i;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY)
@@ -332,7 +326,7 @@ gfc_has_vector_index (gfc_expr *e)
/* Copy a shape array. */
mpz_t *
-gfc_copy_shape (mpz_t * shape, int rank)
+gfc_copy_shape (mpz_t *shape, int rank)
{
mpz_t *new_shape;
int n;
@@ -363,7 +357,7 @@ gfc_copy_shape (mpz_t * shape, int rank)
*/
mpz_t *
-gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
+gfc_copy_shape_excluding (mpz_t *shape, int rank, gfc_expr *dim)
{
mpz_t *new_shape, *s;
int i, n;
@@ -380,12 +374,12 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
if (n < 0 || n >= rank)
return NULL;
- s = new_shape = gfc_get_shape (rank-1);
+ s = new_shape = gfc_get_shape (rank - 1);
for (i = 0; i < rank; i++)
{
if (i == n)
- continue;
+ continue;
mpz_init_set (*s, shape[i]);
s++;
}
@@ -393,11 +387,12 @@ gfc_copy_shape_excluding (mpz_t * shape, int rank, gfc_expr * dim)
return new_shape;
}
+
/* Given an expression pointer, return a copy of the expression. This
subroutine is recursive. */
gfc_expr *
-gfc_copy_expr (gfc_expr * p)
+gfc_copy_expr (gfc_expr *p)
{
gfc_expr *q;
char *s;
@@ -423,8 +418,7 @@ gfc_copy_expr (gfc_expr * p)
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
- memcpy (s, p->value.character.string,
- p->value.character.length + 1);
+ memcpy (s, p->value.character.string, p->value.character.length + 1);
break;
}
switch (q->ts.type)
@@ -434,15 +428,15 @@ gfc_copy_expr (gfc_expr * p)
break;
case BT_REAL:
- gfc_set_model_kind (q->ts.kind);
- mpfr_init (q->value.real);
+ gfc_set_model_kind (q->ts.kind);
+ mpfr_init (q->value.real);
mpfr_set (q->value.real, p->value.real, GFC_RND_MODE);
break;
case BT_COMPLEX:
- gfc_set_model_kind (q->ts.kind);
- mpfr_init (q->value.complex.r);
- mpfr_init (q->value.complex.i);
+ gfc_set_model_kind (q->ts.kind);
+ mpfr_init (q->value.complex.r);
+ mpfr_init (q->value.complex.i);
mpfr_set (q->value.complex.r, p->value.complex.r, GFC_RND_MODE);
mpfr_set (q->value.complex.i, p->value.complex.i, GFC_RND_MODE);
break;
@@ -452,8 +446,7 @@ gfc_copy_expr (gfc_expr * p)
s = gfc_getmem (p->value.character.length + 1);
q->value.character.string = s;
- memcpy (s, p->value.character.string,
- p->value.character.length + 1);
+ memcpy (s, p->value.character.string, p->value.character.length + 1);
break;
case BT_LOGICAL:
@@ -512,9 +505,8 @@ gfc_copy_expr (gfc_expr * p)
kind numbers mean more precision for numeric types. */
int
-gfc_kind_max (gfc_expr * e1, gfc_expr * e2)
+gfc_kind_max (gfc_expr *e1, gfc_expr *e2)
{
-
return (e1->ts.kind > e2->ts.kind) ? e1->ts.kind : e2->ts.kind;
}
@@ -524,7 +516,6 @@ gfc_kind_max (gfc_expr * e1, gfc_expr * e2)
static int
numeric_type (bt type)
{
-
return type == BT_COMPLEX || type == BT_REAL || type == BT_INTEGER;
}
@@ -532,9 +523,8 @@ numeric_type (bt type)
/* Returns nonzero if the typespec is a numeric type, zero otherwise. */
int
-gfc_numeric_ts (gfc_typespec * ts)
+gfc_numeric_ts (gfc_typespec *ts)
{
-
return numeric_type (ts->type);
}
@@ -562,7 +552,7 @@ gfc_int_expr (int i)
/* Returns an expression node that is a logical constant. */
gfc_expr *
-gfc_logical_expr (int i, locus * where)
+gfc_logical_expr (int i, locus *where)
{
gfc_expr *p;
@@ -586,7 +576,7 @@ gfc_logical_expr (int i, locus * where)
argument list with a NULL pointer terminating the list. */
gfc_expr *
-gfc_build_conversion (gfc_expr * e)
+gfc_build_conversion (gfc_expr *e)
{
gfc_expr *p;
@@ -612,7 +602,7 @@ gfc_build_conversion (gfc_expr * e)
1.0**2 stays as it is. */
void
-gfc_type_convert_binary (gfc_expr * e)
+gfc_type_convert_binary (gfc_expr *e)
{
gfc_expr *op1, *op2;
@@ -628,10 +618,9 @@ gfc_type_convert_binary (gfc_expr * e)
/* Kind conversions of same type. */
if (op1->ts.type == op2->ts.type)
{
-
if (op1->ts.kind == op2->ts.kind)
{
- /* No type conversions. */
+ /* No type conversions. */
e->ts = op1->ts;
goto done;
}
@@ -685,7 +674,7 @@ done:
function expects that the expression has already been simplified. */
int
-gfc_is_constant_expr (gfc_expr * e)
+gfc_is_constant_expr (gfc_expr *e)
{
gfc_constructor *c;
gfc_actual_arglist *arg;
@@ -757,7 +746,7 @@ gfc_is_constant_expr (gfc_expr * e)
/* Try to collapse intrinsic expressions. */
static try
-simplify_intrinsic_op (gfc_expr * p, int type)
+simplify_intrinsic_op (gfc_expr *p, int type)
{
gfc_expr *op1, *op2, *result;
@@ -882,9 +871,8 @@ simplify_intrinsic_op (gfc_expr * p, int type)
with gfc_simplify_expr(). */
static try
-simplify_constructor (gfc_constructor * c, int type)
+simplify_constructor (gfc_constructor *c, int type)
{
-
for (; c; c = c->next)
{
if (c->iterator
@@ -904,8 +892,8 @@ simplify_constructor (gfc_constructor * c, int type)
/* Pull a single array element out of an array constructor. */
static try
-find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
- gfc_constructor ** rval)
+find_array_element (gfc_constructor *cons, gfc_array_ref *ar,
+ gfc_constructor **rval)
{
unsigned long nelemen;
int i;
@@ -930,10 +918,9 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
/* Check the bounds. */
if (ar->as->upper[i]
- && (mpz_cmp (e->value.integer,
- ar->as->upper[i]->value.integer) > 0
- || mpz_cmp (e->value.integer,
- ar->as->lower[i]->value.integer) < 0))
+ && (mpz_cmp (e->value.integer, ar->as->upper[i]->value.integer) > 0
+ || mpz_cmp (e->value.integer,
+ ar->as->lower[i]->value.integer) < 0))
{
gfc_error ("index in dimension %d is out of bounds "
"at %L", i + 1, &ar->c_where[i]);
@@ -942,8 +929,7 @@ find_array_element (gfc_constructor * cons, gfc_array_ref * ar,
goto depart;
}
- mpz_sub (delta, e->value.integer,
- ar->as->lower[i]->value.integer);
+ mpz_sub (delta, e->value.integer, ar->as->lower[i]->value.integer);
mpz_add (offset, offset, delta);
}
@@ -973,7 +959,7 @@ depart:
/* Find a component of a structure constructor. */
static gfc_constructor *
-find_component_ref (gfc_constructor * cons, gfc_ref * ref)
+find_component_ref (gfc_constructor *cons, gfc_ref *ref)
{
gfc_component *comp;
gfc_component *pick;
@@ -994,7 +980,7 @@ find_component_ref (gfc_constructor * cons, gfc_ref * ref)
the subobject reference in the process. */
static void
-remove_subobject_ref (gfc_expr * p, gfc_constructor * cons)
+remove_subobject_ref (gfc_expr *p, gfc_constructor *cons)
{
gfc_expr *e;
@@ -1075,11 +1061,11 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
upper = ref->u.ar.as->upper[d];
if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */
- {
- gcc_assert(begin);
- gcc_assert(begin->expr_type == EXPR_ARRAY);
- gcc_assert(begin->rank == 1);
- gcc_assert(begin->shape);
+ {
+ gcc_assert (begin);
+ gcc_assert (begin->expr_type == EXPR_ARRAY);
+ gcc_assert (begin->rank == 1);
+ gcc_assert (begin->shape);
vecsub[d] = begin->value.constructor;
mpz_set (ctr[d], vecsub[d]->expr->value.integer);
@@ -1090,7 +1076,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
for (c = vecsub[d]; c; c = c->next)
{
if (mpz_cmp (c->expr->value.integer, upper->value.integer) > 0
- || mpz_cmp (c->expr->value.integer, lower->value.integer) < 0)
+ || mpz_cmp (c->expr->value.integer,
+ lower->value.integer) < 0)
{
gfc_error ("index in dimension %d is out of bounds "
"at %L", d + 1, &ref->u.ar.c_where[d]);
@@ -1098,12 +1085,12 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
goto cleanup;
}
}
- }
+ }
else
- {
+ {
if ((begin && begin->expr_type != EXPR_CONSTANT)
- || (finish && finish->expr_type != EXPR_CONSTANT)
- || (step && step->expr_type != EXPR_CONSTANT))
+ || (finish && finish->expr_type != EXPR_CONSTANT)
+ || (step && step->expr_type != EXPR_CONSTANT))
{
t = FAILURE;
goto cleanup;
@@ -1157,8 +1144,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
mpz_div (tmp_mpz, tmp_mpz, stride[d]);
mpz_mul (nelts, nelts, tmp_mpz);
- /* An element reference reduces the rank of the expression; don't add
- anything to the shape array. */
+ /* An element reference reduces the rank of the expression; don't
+ add anything to the shape array. */
if (ref->u.ar.dimen_type[d] != DIMEN_ELEMENT)
mpz_set (expr->shape[shape_i++], tmp_mpz);
}
@@ -1178,7 +1165,7 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
/* Now clock through the array reference, calculating the index in
the source constructor and transferring the elements to the new
constructor. */
- for (idx = 0; idx < (int)mpz_get_si (nelts); idx++)
+ for (idx = 0; idx < (int) mpz_get_si (nelts); idx++)
{
if (ref->u.ar.offset)
mpz_set (ptr, ref->u.ar.offset->value.integer);
@@ -1189,14 +1176,13 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
for (d = 0; d < rank; d++)
{
mpz_set (tmp_mpz, ctr[d]);
- mpz_sub (tmp_mpz, tmp_mpz,
- ref->u.ar.as->lower[d]->value.integer);
+ mpz_sub (tmp_mpz, tmp_mpz, ref->u.ar.as->lower[d]->value.integer);
mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
mpz_add (ptr, ptr, tmp_mpz);
if (!incr_ctr) continue;
- if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */
+ if (ref->u.ar.dimen_type[d] == DIMEN_VECTOR) /* Vector subscript. */
{
gcc_assert(vecsub[d]);
@@ -1213,9 +1199,9 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
{
mpz_add (ctr[d], ctr[d], stride[d]);
- if (mpz_cmp_ui (stride[d], 0) > 0 ?
- mpz_cmp (ctr[d], end[d]) > 0 :
- mpz_cmp (ctr[d], end[d]) < 0)
+ if (mpz_cmp_ui (stride[d], 0) > 0
+ ? mpz_cmp (ctr[d], end[d]) > 0
+ : mpz_cmp (ctr[d], end[d]) < 0)
mpz_set (ctr[d], start[d]);
else
incr_ctr = false;
@@ -1269,13 +1255,13 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
char *chr;
if (p->ref->u.ss.start->expr_type != EXPR_CONSTANT
- || p->ref->u.ss.end->expr_type != EXPR_CONSTANT)
+ || p->ref->u.ss.end->expr_type != EXPR_CONSTANT)
return FAILURE;
*newp = gfc_copy_expr (p);
chr = p->value.character.string;
- end = (int)mpz_get_ui (p->ref->u.ss.end->value.integer);
- start = (int)mpz_get_ui (p->ref->u.ss.start->value.integer);
+ end = (int) mpz_get_ui (p->ref->u.ss.end->value.integer);
+ start = (int) mpz_get_ui (p->ref->u.ss.start->value.integer);
(*newp)->value.character.length = end - start + 1;
strncpy ((*newp)->value.character.string, &chr[start - 1],
@@ -1289,7 +1275,7 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp)
parameter variable values are substituted. */
static try
-simplify_const_ref (gfc_expr * p)
+simplify_const_ref (gfc_expr *p)
{
gfc_constructor *cons;
gfc_expr *newp;
@@ -1302,8 +1288,7 @@ simplify_const_ref (gfc_expr * p)
switch (p->ref->u.ar.type)
{
case AR_ELEMENT:
- if (find_array_element (p->value.constructor,
- &p->ref->u.ar,
+ if (find_array_element (p->value.constructor, &p->ref->u.ar,
&cons) == FAILURE)
return FAILURE;
@@ -1322,7 +1307,7 @@ simplify_const_ref (gfc_expr * p)
case AR_FULL:
if (p->ref->next != NULL
- && (p->ts.type == BT_CHARACTER || p->ts.type == BT_DERIVED))
+ && (p->ts.type == BT_CHARACTER || p->ts.type == BT_DERIVED))
{
cons = p->value.constructor;
for (; cons; cons = cons->next)
@@ -1364,7 +1349,7 @@ simplify_const_ref (gfc_expr * p)
/* Simplify a chain of references. */
static try
-simplify_ref_chain (gfc_ref * ref, int type)
+simplify_ref_chain (gfc_ref *ref, int type)
{
int n;
@@ -1375,16 +1360,12 @@ simplify_ref_chain (gfc_ref * ref, int type)
case REF_ARRAY:
for (n = 0; n < ref->u.ar.dimen; n++)
{
- if (gfc_simplify_expr (ref->u.ar.start[n], type)
- == FAILURE)
+ if (gfc_simplify_expr (ref->u.ar.start[n], type) == FAILURE)
return FAILURE;
- if (gfc_simplify_expr (ref->u.ar.end[n], type)
- == FAILURE)
+ if (gfc_simplify_expr (ref->u.ar.end[n], type) == FAILURE)
return FAILURE;
- if (gfc_simplify_expr (ref->u.ar.stride[n], type)
- == FAILURE)
+ if (gfc_simplify_expr (ref->u.ar.stride[n], type) == FAILURE)
return FAILURE;
-
}
break;
@@ -1405,7 +1386,7 @@ simplify_ref_chain (gfc_ref * ref, int type)
/* Try to substitute the value of a parameter variable. */
static try
-simplify_parameter_variable (gfc_expr * p, int type)
+simplify_parameter_variable (gfc_expr *p, int type)
{
gfc_expr *e;
try t;
@@ -1423,7 +1404,7 @@ simplify_parameter_variable (gfc_expr * p, int type)
/* Only use the simplification if it eliminated all subobject
references. */
- if (t == SUCCESS && ! e->ref)
+ if (t == SUCCESS && !e->ref)
gfc_replace_expr (p, e);
else
gfc_free_expr (e);
@@ -1446,12 +1427,12 @@ simplify_parameter_variable (gfc_expr * p, int type)
The expression type is defined for:
0 Basic expression parsing
1 Simplifying array constructors -- will substitute
- iterator values.
+ iterator values.
Returns FAILURE on error, SUCCESS otherwise.
NOTE: Will return SUCCESS even if the expression can not be simplified. */
try
-gfc_simplify_expr (gfc_expr * p, int type)
+gfc_simplify_expr (gfc_expr *p, int type)
{
gfc_actual_arglist *ap;
@@ -1489,7 +1470,7 @@ gfc_simplify_expr (gfc_expr * p, int type)
gfc_extract_int (p->ref->u.ss.end, &end);
s = gfc_getmem (end - start + 2);
memcpy (s, p->value.character.string + start, end - start);
- s[end-start+1] = '\0'; /* TODO: C-style string for debugging. */
+ s[end - start + 1] = '\0'; /* TODO: C-style string. */
gfc_free (p->value.character.string);
p->value.character.string = s;
p->value.character.length = end - start;
@@ -1510,7 +1491,7 @@ gfc_simplify_expr (gfc_expr * p, int type)
case EXPR_VARIABLE:
/* Only substitute array parameter variables if we are in an
- initialization expression, or we want a subsection. */
+ initialization expression, or we want a subsection. */
if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
&& (gfc_init_expr || p->ref
|| p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
@@ -1539,9 +1520,8 @@ gfc_simplify_expr (gfc_expr * p, int type)
if (simplify_constructor (p->value.constructor, type) == FAILURE)
return FAILURE;
- if (p->expr_type == EXPR_ARRAY
- && p->ref && p->ref->type == REF_ARRAY
- && p->ref->u.ar.type == AR_FULL)
+ if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY
+ && p->ref->u.ar.type == AR_FULL)
gfc_expand_constructor (p);
if (simplify_const_ref (p) == FAILURE)
@@ -1559,9 +1539,8 @@ gfc_simplify_expr (gfc_expr * p, int type)
be declared as. */
static bt
-et0 (gfc_expr * e)
+et0 (gfc_expr *e)
{
-
if (e->expr_type == EXPR_VARIABLE && gfc_check_iter_variable (e) == SUCCESS)
return BT_INTEGER;
@@ -1575,7 +1554,7 @@ et0 (gfc_expr * e)
static try check_init_expr (gfc_expr *);
static try
-check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
+check_intrinsic_op (gfc_expr *e, try (*check_function) (gfc_expr *))
{
gfc_expr *op1 = e->value.op.op1;
gfc_expr *op2 = e->value.op.op2;
@@ -1605,7 +1584,7 @@ check_intrinsic_op (gfc_expr * e, try (*check_function) (gfc_expr *))
{
gfc_error ("Numeric or CHARACTER operands are required in "
"expression at %L", &e->where);
- return FAILURE;
+ return FAILURE;
}
break;
@@ -1703,7 +1682,7 @@ not_numeric:
this problem here. */
static try
-check_inquiry (gfc_expr * e, int not_restricted)
+check_inquiry (gfc_expr *e, int not_restricted)
{
const char *name;
@@ -1743,7 +1722,7 @@ check_inquiry (gfc_expr * e, int not_restricted)
{
if (e->symtree->n.sym->ts.type == BT_UNKNOWN
&& gfc_set_default_type (e->symtree->n.sym, 0, gfc_current_ns)
- == FAILURE)
+ == FAILURE)
return FAILURE;
e->ts = e->symtree->n.sym->ts;
@@ -1752,8 +1731,8 @@ check_inquiry (gfc_expr * e, int not_restricted)
/* Assumed character length will not reduce to a constant expression
with LEN, as required by the standard. */
if (i == 4 && not_restricted
- && e->symtree->n.sym->ts.type == BT_CHARACTER
- && e->symtree->n.sym->ts.cl->length == NULL)
+ && e->symtree->n.sym->ts.type == BT_CHARACTER
+ && e->symtree->n.sym->ts.cl->length == NULL)
gfc_notify_std (GFC_STD_GNU, "assumed character length "
"variable '%s' in constant expression at %L",
e->symtree->n.sym->name, &e->where);
@@ -1770,7 +1749,7 @@ check_inquiry (gfc_expr * e, int not_restricted)
FAILURE is returned an error message has been generated. */
static try
-check_init_expr (gfc_expr * e)
+check_init_expr (gfc_expr *e)
{
gfc_actual_arglist *ap;
match m;
@@ -1809,7 +1788,7 @@ check_init_expr (gfc_expr * e)
if (m == MATCH_NO)
gfc_error ("Function '%s' in initialization expression at %L "
"must be an intrinsic function",
- e->symtree->n.sym->name, &e->where);
+ e->symtree->n.sym->name, &e->where);
if (m != MATCH_YES)
t = FAILURE;
@@ -1882,7 +1861,7 @@ check_init_expr (gfc_expr * e)
expression, then reducing it to a constant. */
match
-gfc_match_init_expr (gfc_expr ** result)
+gfc_match_init_expr (gfc_expr **result)
{
gfc_expr *expr;
match m;
@@ -1914,9 +1893,8 @@ gfc_match_init_expr (gfc_expr ** result)
/* Not all inquiry functions are simplified to constant expressions
so it is necessary to call check_inquiry again. */
- if (!gfc_is_constant_expr (expr)
- && check_inquiry (expr, 1) == FAILURE
- && !gfc_in_match_data ())
+ if (!gfc_is_constant_expr (expr) && check_inquiry (expr, 1) == FAILURE
+ && !gfc_in_match_data ())
{
gfc_error ("Initialization expression didn't reduce %C");
return MATCH_ERROR;
@@ -1928,7 +1906,6 @@ gfc_match_init_expr (gfc_expr ** result)
}
-
static try check_restricted (gfc_expr *);
/* Given an actual argument list, test to see that each argument is a
@@ -1936,7 +1913,7 @@ static try check_restricted (gfc_expr *);
integer or character. */
static try
-restricted_args (gfc_actual_arglist * a)
+restricted_args (gfc_actual_arglist *a)
{
for (; a; a = a->next)
{
@@ -1954,7 +1931,7 @@ restricted_args (gfc_actual_arglist * a)
/* Make sure a non-intrinsic function is a specification function. */
static try
-external_spec_function (gfc_expr * e)
+external_spec_function (gfc_expr *e)
{
gfc_symbol *f;
@@ -1996,7 +1973,7 @@ external_spec_function (gfc_expr * e)
restricted expression. */
static try
-restricted_intrinsic (gfc_expr * e)
+restricted_intrinsic (gfc_expr *e)
{
/* TODO: Check constraints on inquiry functions. 7.1.6.2 (7). */
if (check_inquiry (e, 0) == SUCCESS)
@@ -2011,7 +1988,7 @@ restricted_intrinsic (gfc_expr * e)
return FAILURE. */
static try
-check_restricted (gfc_expr * e)
+check_restricted (gfc_expr *e)
{
gfc_symbol *sym;
try t;
@@ -2029,8 +2006,8 @@ check_restricted (gfc_expr * e)
break;
case EXPR_FUNCTION:
- t = e->value.function.esym ?
- external_spec_function (e) : restricted_intrinsic (e);
+ t = e->value.function.esym ? external_spec_function (e)
+ : restricted_intrinsic (e);
break;
@@ -2052,10 +2029,11 @@ check_restricted (gfc_expr * e)
break;
}
- /* gfc_is_formal_arg broadcasts that a formal argument list is being processed
- in resolve.c(resolve_formal_arglist). This is done so that host associated
- dummy array indices are accepted (PR23446). This mechanism also does the
- same for the specification expressions of array-valued functions. */
+ /* gfc_is_formal_arg broadcasts that a formal argument list is being
+ processed in resolve.c(resolve_formal_arglist). This is done so
+ that host associated dummy array indices are accepted (PR23446).
+ This mechanism also does the same for the specification expressions
+ of array-valued functions. */
if (sym->attr.in_common
|| sym->attr.use_assoc
|| sym->attr.dummy
@@ -2109,7 +2087,7 @@ check_restricted (gfc_expr * e)
we return FAILURE, an error has been generated. */
try
-gfc_specification_expr (gfc_expr * e)
+gfc_specification_expr (gfc_expr *e)
{
if (e == NULL)
return SUCCESS;
@@ -2138,8 +2116,7 @@ gfc_specification_expr (gfc_expr * e)
/* Given two expressions, make sure that the arrays are conformable. */
try
-gfc_check_conformance (const char *optype_msgid,
- gfc_expr * op1, gfc_expr * op2)
+gfc_check_conformance (const char *optype_msgid, gfc_expr *op1, gfc_expr *op2)
{
int op1_flag, op2_flag, d;
mpz_t op1_size, op2_size;
@@ -2189,7 +2166,7 @@ gfc_check_conformance (const char *optype_msgid,
sure that the assignment can take place. */
try
-gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
+gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
{
gfc_symbol *sym;
gfc_ref *ref;
@@ -2219,10 +2196,9 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
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:*/
- if (sym->attr.flavor == FL_PROCEDURE
- && sym->attr.proc != PROC_ST_FUNCTION
- && !sym->attr.external)
+ Therefore, the left hand side is no longer a varaiable, when it is: */
+ if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_ST_FUNCTION
+ && !sym->attr.external)
{
bool bad_proc;
bad_proc = false;
@@ -2237,10 +2213,10 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
/* (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->proc_name->attr.proc == PROC_MODULE)
&& gfc_current_ns->parent
&& (!(gfc_current_ns->parent->proc_name->attr.function
- || gfc_current_ns->parent->proc_name->attr.subroutine)
+ || gfc_current_ns->parent->proc_name->attr.subroutine)
|| gfc_current_ns->parent->proc_name->attr.is_main_program))
{
/* .... that is not a function.... */
@@ -2285,8 +2261,8 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
&& lvalue->ref->u.ar.type == AR_FULL
&& lvalue->ref->u.ar.as->cp_was_assumed)
{
- gfc_error ("Vector assignment to assumed-size Cray Pointee at %L"
- " is illegal", &lvalue->where);
+ gfc_error ("Vector assignment to assumed-size Cray Pointee at %L "
+ "is illegal", &lvalue->where);
return FAILURE;
}
@@ -2332,7 +2308,7 @@ gfc_check_assign (gfc_expr * lvalue, gfc_expr * rvalue, int conform)
NULLIFY statement. */
try
-gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
+gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
{
symbol_attribute attr;
gfc_ref *ref;
@@ -2347,7 +2323,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
}
if (lvalue->symtree->n.sym->attr.flavor == FL_PROCEDURE
- && lvalue->symtree->n.sym->attr.use_assoc)
+ && lvalue->symtree->n.sym->attr.use_assoc)
{
gfc_error ("'%s' in the pointer assignment at %L cannot be an "
"l-value since it is a procedure",
@@ -2364,16 +2340,16 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
for (ref = lvalue->ref; ref; ref = ref->next)
{
if (pointer)
- check_intent_in = 0;
+ check_intent_in = 0;
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
- pointer = 1;
+ pointer = 1;
}
if (check_intent_in && lvalue->symtree->n.sym->attr.intent == INTENT_IN)
{
gfc_error ("Cannot assign to INTENT(IN) variable '%s' at %L",
- lvalue->symtree->n.sym->name, &lvalue->where);
+ lvalue->symtree->n.sym->name, &lvalue->where);
return FAILURE;
}
@@ -2387,8 +2363,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
if (is_pure && gfc_impure_variable (lvalue->symtree->n.sym))
{
- gfc_error ("Bad pointer object in PURE procedure at %L",
- &lvalue->where);
+ gfc_error ("Bad pointer object in PURE procedure at %L", &lvalue->where);
return FAILURE;
}
@@ -2415,7 +2390,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
if (lvalue->rank != rvalue->rank)
{
gfc_error ("Different ranks in pointer assignment at %L",
- &lvalue->where);
+ &lvalue->where);
return FAILURE;
}
@@ -2424,9 +2399,9 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
return SUCCESS;
if (lvalue->ts.type == BT_CHARACTER
- && lvalue->ts.cl->length && rvalue->ts.cl->length
- && abs (gfc_dep_compare_expr (lvalue->ts.cl->length,
- rvalue->ts.cl->length)) == 1)
+ && lvalue->ts.cl->length && rvalue->ts.cl->length
+ && abs (gfc_dep_compare_expr (lvalue->ts.cl->length,
+ rvalue->ts.cl->length)) == 1)
{
gfc_error ("Different character lengths in pointer "
"assignment at %L", &lvalue->where);
@@ -2457,7 +2432,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
if (attr.protected && attr.use_assoc)
{
gfc_error ("Pointer assigment target has PROTECTED "
- "attribute at %L", &rvalue->where);
+ "attribute at %L", &rvalue->where);
return FAILURE;
}
@@ -2469,7 +2444,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
symbol. Used for initialization assignments. */
try
-gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue)
+gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue)
{
gfc_expr lvalue;
try r;
@@ -2480,7 +2455,7 @@ gfc_check_assign_symbol (gfc_symbol * sym, gfc_expr * rvalue)
lvalue.ts = sym->ts;
if (sym->as)
lvalue.rank = sym->as->rank;
- lvalue.symtree = (gfc_symtree *)gfc_getmem (sizeof (gfc_symtree));
+ lvalue.symtree = (gfc_symtree *) gfc_getmem (sizeof (gfc_symtree));
lvalue.symtree->n.sym = sym;
lvalue.where = sym->declared_at;
@@ -2510,7 +2485,7 @@ gfc_default_initializer (gfc_typespec *ts)
for (c = ts->derived->components; c; c = c->next)
{
if ((c->initializer || c->allocatable) && init == NULL)
- init = gfc_get_expr ();
+ init = gfc_get_expr ();
}
if (init == NULL)
@@ -2524,15 +2499,15 @@ gfc_default_initializer (gfc_typespec *ts)
for (c = ts->derived->components; c; c = c->next)
{
if (tail == NULL)
- init->value.constructor = tail = gfc_get_constructor ();
+ init->value.constructor = tail = gfc_get_constructor ();
else
- {
- tail->next = gfc_get_constructor ();
- tail = tail->next;
- }
+ {
+ tail->next = gfc_get_constructor ();
+ tail = tail->next;
+ }
if (c->initializer)
- tail->expr = gfc_copy_expr (c->initializer);
+ tail->expr = gfc_copy_expr (c->initializer);
if (c->allocatable)
{
@@ -2550,7 +2525,7 @@ gfc_default_initializer (gfc_typespec *ts)
whole array. */
gfc_expr *
-gfc_get_variable_expr (gfc_symtree * var)
+gfc_get_variable_expr (gfc_symtree *var)
{
gfc_expr *e;
@@ -2574,7 +2549,7 @@ gfc_get_variable_expr (gfc_symtree * var)
/* Traverse expr, marking all EXPR_VARIABLE symbols referenced. */
void
-gfc_expr_set_symbols_referenced (gfc_expr * expr)
+gfc_expr_set_symbols_referenced (gfc_expr *expr)
{
gfc_actual_arglist *arg;
gfc_constructor *c;
@@ -2592,7 +2567,7 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr)
case EXPR_FUNCTION:
for (arg = expr->value.function.actual; arg; arg = arg->next)
- gfc_expr_set_symbols_referenced (arg->expr);
+ gfc_expr_set_symbols_referenced (arg->expr);
break;
case EXPR_VARIABLE:
@@ -2607,7 +2582,7 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr)
case EXPR_STRUCTURE:
case EXPR_ARRAY:
for (c = expr->value.constructor; c; c = c->next)
- gfc_expr_set_symbols_referenced (c->expr);
+ gfc_expr_set_symbols_referenced (c->expr);
break;
default:
@@ -2617,26 +2592,26 @@ gfc_expr_set_symbols_referenced (gfc_expr * expr)
for (ref = expr->ref; ref; ref = ref->next)
switch (ref->type)
- {
- case REF_ARRAY:
- for (i = 0; i < ref->u.ar.dimen; i++)
- {
- gfc_expr_set_symbols_referenced (ref->u.ar.start[i]);
- gfc_expr_set_symbols_referenced (ref->u.ar.end[i]);
- gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]);
- }
- break;
-
- case REF_COMPONENT:
- break;
-
- case REF_SUBSTRING:
- gfc_expr_set_symbols_referenced (ref->u.ss.start);
- gfc_expr_set_symbols_referenced (ref->u.ss.end);
- break;
-
- default:
- gcc_unreachable ();
- break;
- }
+ {
+ case REF_ARRAY:
+ for (i = 0; i < ref->u.ar.dimen; i++)
+ {
+ gfc_expr_set_symbols_referenced (ref->u.ar.start[i]);
+ gfc_expr_set_symbols_referenced (ref->u.ar.end[i]);
+ gfc_expr_set_symbols_referenced (ref->u.ar.stride[i]);
+ }
+ break;
+
+ case REF_COMPONENT:
+ break;
+
+ case REF_SUBSTRING:
+ gfc_expr_set_symbols_referenced (ref->u.ss.start);
+ gfc_expr_set_symbols_referenced (ref->u.ss.end);
+ break;
+
+ default:
+ gcc_unreachable ();
+ break;
+ }
}
View Lorry Controller Status