summaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog72
-rw-r--r--gcc/fortran/arith.c11
-rw-r--r--gcc/fortran/data.c5
-rw-r--r--gcc/fortran/decl.c4
-rw-r--r--gcc/fortran/gfortran.h1
-rw-r--r--gcc/fortran/intrinsic.c2
-rw-r--r--gcc/fortran/io.c3
-rw-r--r--gcc/fortran/iresolve.c7
-rw-r--r--gcc/fortran/match.c8
-rw-r--r--gcc/fortran/matchexp.c5
-rw-r--r--gcc/fortran/module.c6
-rw-r--r--gcc/fortran/parse.c3
-rw-r--r--gcc/fortran/primary.c32
-rw-r--r--gcc/fortran/resolve.c17
-rw-r--r--gcc/fortran/trans-array.c17
-rw-r--r--gcc/fortran/trans-common.c4
-rw-r--r--gcc/fortran/trans-const.c1
-rw-r--r--gcc/fortran/trans-expr.c2
-rw-r--r--gcc/fortran/trans-intrinsic.c11
-rw-r--r--gcc/fortran/trans-openmp.c30
-rw-r--r--gcc/fortran/trans-types.c3
21 files changed, 132 insertions, 112 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 862fffa663a..8b6c4ce6a9c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,75 @@
+2009-11-28 Jakub Jelinek <jakub@redhat.com>
+
+ * trans-common.c (create_common): Remove unused offset variable.
+ * io.c (gfc_match_wait): Remove unused loc variable.
+ * trans-openmp.c (gfc_trans_omp_clauses): Remove unused old_clauses
+ variable.
+ (gfc_trans_omp_do): Remove unused outermost variable.
+ * iresolve.c (gfc_resolve_alarm_sub, gfc_resolve_fseek_sub): Remove
+ unused status variable.
+ * module.c (number_use_names): Remove unused c variable.
+ (load_derived_extensions): Remove unused nuse variable.
+ * trans-expr.c (gfc_conv_substring): Remove unused var variable.
+ * trans-types.c (gfc_get_array_descr_info): Remove unused offset_off
+ variable.
+ * matchexp.c (match_primary): Remove unused where variable.
+ * trans-intrinsic.c (gfc_conv_intrinsic_bound): Remove unused cond2
+ variable.
+ (gfc_conv_intrinsic_sizeof): Remove unused source variable.
+ (gfc_conv_intrinsic_transfer): Remove unused stride variable.
+ (gfc_conv_intrinsic_function): Remove unused isym variable.
+ * arith.c (gfc_hollerith2real, gfc_hollerith2complex,
+ gfc_hollerith2logical): Remove unused len variable.
+ * parse.c (parse_derived): Remove unused derived_sym variable.
+ * decl.c (variable_decl): Remove unused old_locus variable.
+ * resolve.c (check_class_members): Remove unused tbp_sym variable.
+ (resolve_ordinary_assign): Remove unused assign_proc variable.
+ (resolve_equivalence): Remove unused value_name variable.
+ * data.c (get_array_index): Remove unused re variable.
+ * trans-array.c (gfc_conv_array_transpose): Remove unused src_info
+ variable.
+ (gfc_conv_resolve_dependencies): Remove unused aref and temp_dim
+ variables.
+ (gfc_conv_loop_setup): Remove unused dim and len variables.
+ (gfc_walk_variable_expr): Remove unused head variable.
+ * match.c (match_typebound_call): Remove unused var variable.
+ * intrinsic.c (gfc_convert_chartype): Remove unused from_ts variable.
+
+2009-11-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/41807
+ * trans-const.c (gfc_conv_const): Set se->expr to a constant on error.
+
+2009-11-26 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/41278
+ * trans-array.c (gfc_conv_array_transpose): Delete unnecessary assert.
+
+2009-11-26 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/42048
+ PR fortran/42167
+ * gfortran.h (gfc_is_function_return_value): New prototype.
+ * match.c (gfc_match_call): Use new function
+ 'gfc_is_function_return_value'.
+ * primary.c (gfc_is_function_return_value): New function to check if a
+ symbol is the return value of an encompassing function.
+ (match_actual_arg,gfc_match_rvalue,match_variable): Use new function
+ 'gfc_is_function_return_value'.
+ * resolve.c (resolve_common_blocks,resolve_actual_arglist): Ditto.
+
+2009-11-25 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/42162
+ * trans-openmp.c (gfc_trans_omp_do): When dovar isn't a VAR_DECL,
+ don't use simple loop and handle clauses properly.
+
+2009-11-24 Jerry DeLisle <jvdelisle@gcc.gnu.org>
+
+ PR fortran/42008
+ * decl.c (variable_decl): Do not error on initialization within a
+ derived type specification of a pure procedure.
+
2009-11-24 Janus Weil <janus@gcc.gnu.org>
PR fortran/42045
diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index 82a43ad7178..bd0ca6122cf 100644
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1,5 +1,5 @@
/* Compiler arithmetic
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -2668,9 +2668,6 @@ gfc_expr *
gfc_hollerith2real (gfc_expr *src, int kind)
{
gfc_expr *result;
- int len;
-
- len = src->value.character.length;
result = gfc_get_expr ();
result->expr_type = EXPR_CONSTANT;
@@ -2692,9 +2689,6 @@ gfc_expr *
gfc_hollerith2complex (gfc_expr *src, int kind)
{
gfc_expr *result;
- int len;
-
- len = src->value.character.length;
result = gfc_get_expr ();
result->expr_type = EXPR_CONSTANT;
@@ -2741,9 +2735,6 @@ gfc_expr *
gfc_hollerith2logical (gfc_expr *src, int kind)
{
gfc_expr *result;
- int len;
-
- len = src->value.character.length;
result = gfc_get_expr ();
result->expr_type = EXPR_CONSTANT;
diff --git a/gcc/fortran/data.c b/gcc/fortran/data.c
index 6cddb3c7b71..0d04d65aa29 100644
--- a/gcc/fortran/data.c
+++ b/gcc/fortran/data.c
@@ -1,5 +1,5 @@
/* Supporting functions for resolving DATA statement.
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Lifang Zeng <zlf605@hotmail.com>
@@ -46,7 +46,6 @@ get_array_index (gfc_array_ref *ar, mpz_t *offset)
{
gfc_expr *e;
int i;
- gfc_try re;
mpz_t delta;
mpz_t tmp;
@@ -56,7 +55,7 @@ get_array_index (gfc_array_ref *ar, mpz_t *offset)
for (i = 0; i < ar->dimen; i++)
{
e = gfc_copy_expr (ar->start[i]);
- re = gfc_simplify_expr (e, 1);
+ gfc_simplify_expr (e, 1);
if ((gfc_is_constant_expr (ar->as->lower[i]) == 0)
|| (gfc_is_constant_expr (ar->as->upper[i]) == 0)
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 08d2bd69ddf..23ac5c39424 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1656,12 +1656,10 @@ variable_decl (int elem)
match m;
gfc_try t;
gfc_symbol *sym;
- locus old_locus;
initializer = NULL;
as = NULL;
cp_as = NULL;
- old_locus = gfc_current_locus;
/* When we get here, we've just matched a list of attributes and
maybe a type and a double colon. The next thing we expect to see
@@ -1865,7 +1863,7 @@ variable_decl (int elem)
m = MATCH_ERROR;
}
- if (gfc_pure (NULL))
+ if (gfc_pure (NULL) && gfc_state_stack->state != COMP_DERIVED)
{
gfc_error ("Initialization of pointer at %C is not allowed in "
"a PURE procedure");
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 74a31d2661c..cc3ccf5527c 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2751,6 +2751,7 @@ symbol_attribute gfc_expr_attr (gfc_expr *);
match gfc_match_rvalue (gfc_expr **);
match gfc_match_varspec (gfc_expr*, int, bool, bool);
int gfc_check_digit (char, int);
+bool gfc_is_function_return_value (gfc_symbol *, gfc_namespace *);
/* trans.c */
void gfc_generate_code (gfc_namespace *);
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 3e8e3f2e5a4..a62dd92375b 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4054,14 +4054,12 @@ gfc_try
gfc_convert_chartype (gfc_expr *expr, gfc_typespec *ts)
{
gfc_intrinsic_sym *sym;
- gfc_typespec from_ts;
locus old_where;
gfc_expr *new_expr;
int rank;
mpz_t *shape;
gcc_assert (expr->ts.type == BT_CHARACTER && ts->type == BT_CHARACTER);
- from_ts = expr->ts; /* expr->ts gets clobbered */
sym = find_char_conv (&expr->ts, ts);
gcc_assert (sym);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index d6b64c4120c..9b0ee8d17ca 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -4060,7 +4060,6 @@ gfc_match_wait (void)
{
gfc_wait *wait;
match m;
- locus loc;
m = gfc_match_char ('(');
if (m == MATCH_NO)
@@ -4068,8 +4067,6 @@ gfc_match_wait (void)
wait = XCNEW (gfc_wait);
- loc = gfc_current_locus;
-
m = match_wait_element (wait);
if (m == MATCH_ERROR)
goto cleanup;
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index ee8609e696b..960be088531 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -1,5 +1,5 @@
/* Intrinsic function resolution.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught & Katherine Holcomb
@@ -2573,13 +2573,12 @@ void
gfc_resolve_alarm_sub (gfc_code *c)
{
const char *name;
- gfc_expr *seconds, *handler, *status;
+ gfc_expr *seconds, *handler;
gfc_typespec ts;
gfc_clear_ts (&ts);
seconds = c->ext.actual->expr;
handler = c->ext.actual->next->expr;
- status = c->ext.actual->next->next->expr;
ts.type = BT_INTEGER;
ts.kind = gfc_c_int_kind;
@@ -3261,14 +3260,12 @@ gfc_resolve_fseek_sub (gfc_code *c)
gfc_expr *unit;
gfc_expr *offset;
gfc_expr *whence;
- gfc_expr *status;
gfc_typespec ts;
gfc_clear_ts (&ts);
unit = c->ext.actual->expr;
offset = c->ext.actual->next->expr;
whence = c->ext.actual->next->next->expr;
- status = c->ext.actual->next->next->next->expr;
if (unit->ts.kind != gfc_c_int_kind)
{
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 13f68ab8c65..153dfdb3073 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1,5 +1,5 @@
/* Matching subroutines in all sizes, shapes and colors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -2901,12 +2901,9 @@ done:
static match
match_typebound_call (gfc_symtree* varst)
{
- gfc_symbol* var;
gfc_expr* base;
match m;
- var = varst->n.sym;
-
base = gfc_get_expr ();
base->expr_type = EXPR_VARIABLE;
base->symtree = varst;
@@ -2975,7 +2972,8 @@ gfc_match_call (void)
/* If this is a variable of derived-type, it probably starts a type-bound
procedure call. */
- if ((sym->attr.flavor != FL_PROCEDURE || sym == gfc_current_ns->proc_name)
+ if ((sym->attr.flavor != FL_PROCEDURE
+ || gfc_is_function_return_value (sym, gfc_current_ns))
&& (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS))
return match_typebound_call (st);
diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.c
index f7573655316..f66623f82d0 100644
--- a/gcc/fortran/matchexp.c
+++ b/gcc/fortran/matchexp.c
@@ -1,5 +1,5 @@
/* Expression parser.
- Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -149,7 +149,6 @@ match_primary (gfc_expr **result)
{
match m;
gfc_expr *e;
- locus where;
m = gfc_match_literal_constant (result, 0);
if (m != MATCH_NO)
@@ -164,8 +163,6 @@ match_primary (gfc_expr **result)
return m;
/* Match an expression in parentheses. */
- where = gfc_current_locus;
-
if (gfc_match_char ('(') != MATCH_YES)
return MATCH_NO;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 43acd450062..36095a2b722 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -741,8 +741,7 @@ static int
number_use_names (const char *name, bool interface)
{
int i = 0;
- const char *c;
- c = find_use_name_n (name, &i, interface);
+ find_use_name_n (name, &i, interface);
return i;
}
@@ -3977,7 +3976,7 @@ load_equiv (void)
static void
load_derived_extensions (void)
{
- int symbol, nuse, j;
+ int symbol, j;
gfc_symbol *derived;
gfc_symbol *dt;
gfc_symtree *st;
@@ -4013,7 +4012,6 @@ load_derived_extensions (void)
mio_internal_string (module);
/* Only use one use name to find the symbol. */
- nuse = number_use_names (name, false);
j = 1;
p = find_use_name_n (name, &j, false);
if (p)
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 95a327bf23d..c5d35484a3a 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1940,7 +1940,6 @@ parse_derived (void)
int compiling_type, seen_private, seen_sequence, seen_component, error_flag;
gfc_statement st;
gfc_state_data s;
- gfc_symbol *derived_sym = NULL;
gfc_symbol *sym;
gfc_component *c;
@@ -2061,8 +2060,6 @@ endType:
/* need to verify that all fields of the derived type are
* interoperable with C if the type is declared to be bind(c)
*/
- derived_sym = gfc_current_block();
-
sym = gfc_current_block ();
for (c = sym->components; c; c = c->next)
{
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index c0777c48b85..113729fb059 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1347,6 +1347,25 @@ gfc_match_literal_constant (gfc_expr **result, int signflag)
}
+/* This checks if a symbol is the return value of an encompassing function.
+ Function nesting can be maximally two levels deep, but we may have
+ additional local namespaces like BLOCK etc. */
+
+bool
+gfc_is_function_return_value (gfc_symbol *sym, gfc_namespace *ns)
+{
+ if (!sym->attr.function || (sym->result != sym))
+ return false;
+ while (ns)
+ {
+ if (ns->proc_name == sym)
+ return true;
+ ns = ns->parent;
+ }
+ return false;
+}
+
+
/* Match a single actual argument value. An actual argument is
usually an expression, but can also be a procedure name. If the
argument is a single name, it is not always possible to tell
@@ -1415,9 +1434,7 @@ match_actual_arg (gfc_expr **result)
is being defined, then we have a variable. */
if (sym->attr.function && sym->result == sym)
{
- if (gfc_current_ns->proc_name == sym
- || (gfc_current_ns->parent != NULL
- && gfc_current_ns->parent->proc_name == sym))
+ if (gfc_is_function_return_value (sym, gfc_current_ns))
break;
if (sym->attr.entry
@@ -2521,9 +2538,7 @@ gfc_match_rvalue (gfc_expr **result)
return MATCH_ERROR;
}
- if (gfc_current_ns->proc_name == sym
- || (gfc_current_ns->parent != NULL
- && gfc_current_ns->parent->proc_name == sym))
+ if (gfc_is_function_return_value (sym, gfc_current_ns))
goto variable;
if (sym->attr.entry
@@ -2998,10 +3013,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
if (sym->attr.function
&& !sym->attr.external
&& sym->result == sym
- && ((sym == gfc_current_ns->proc_name
- && sym == gfc_current_ns->proc_name->result)
- || (gfc_current_ns->parent
- && sym == gfc_current_ns->parent->proc_name->result)
+ && (gfc_is_function_return_value (sym, gfc_current_ns)
|| (sym->attr.entry
&& sym->ns == gfc_current_ns)
|| (sym->attr.entry
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 740679edd2d..b6853129d59 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -776,7 +776,7 @@ resolve_common_blocks (gfc_symtree *common_root)
gfc_error ("COMMON block '%s' at %L is also an intrinsic procedure",
sym->name, &common_root->n.common->where);
else if (sym->attr.result
- ||(sym->attr.function && gfc_current_ns->proc_name == sym))
+ || gfc_is_function_return_value (sym, gfc_current_ns))
gfc_notify_std (GFC_STD_F2003, "Fortran 2003: COMMON block '%s' at %L "
"that is also a function result", sym->name,
&common_root->n.common->where);
@@ -1400,10 +1400,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype,
/* If the symbol is the function that names the current (or
parent) scope, then we really have a variable reference. */
- if (sym->attr.function && sym->result == sym
- && (sym->ns->proc_name == sym
- || (sym->ns->parent != NULL
- && sym->ns->parent->proc_name == sym)))
+ if (gfc_is_function_return_value (sym, sym->ns))
goto got_variable;
/* If all else fails, see if we have a specific intrinsic. */
@@ -5125,7 +5122,6 @@ check_members (gfc_symbol *derived)
static void
check_class_members (gfc_symbol *derived)
{
- gfc_symbol* tbp_sym;
gfc_expr *e;
gfc_symtree *tbp;
gfc_class_esym_list *etmp;
@@ -5145,8 +5141,6 @@ check_class_members (gfc_symbol *derived)
if (tbp->n.tb->is_generic)
{
- tbp_sym = NULL;
-
/* If we have to match a passed class member, force the actual
expression to have the correct type. */
if (!tbp->n.tb->nopass)
@@ -5159,8 +5153,6 @@ check_class_members (gfc_symbol *derived)
e->value.compcall.base_object->ts.u.derived = derived;
}
}
- else
- tbp_sym = tbp->n.tb->u.specific->n.sym;
e->value.compcall.tbp = tbp->n.tb;
e->value.compcall.name = tbp->name;
@@ -7613,14 +7605,12 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
if (gfc_extend_assign (code, ns) == SUCCESS)
{
- gfc_symbol* assign_proc;
gfc_expr** rhsptr;
if (code->op == EXEC_ASSIGN_CALL)
{
lhs = code->ext.actual->expr;
rhsptr = &code->ext.actual->next->expr;
- assign_proc = code->symtree->n.sym;
}
else
{
@@ -7635,7 +7625,6 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
tbp = code->expr1->value.compcall.tbp;
gcc_assert (!tbp->is_generic);
- assign_proc = tbp->u.specific->n.sym;
}
/* Make a temporary rhs when there is a default initializer
@@ -11693,10 +11682,8 @@ resolve_equivalence (gfc_equiv *eq)
seq_type eq_type, last_eq_type;
gfc_typespec *last_ts;
int object, cnt_protected;
- const char *value_name;
const char *msg;
- value_name = NULL;
last_ts = &eq->expr->symtree->n.sym->ts;
first_sym = eq->expr->symtree->n.sym;
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 4e94373133a..6486bb60ec6 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -837,7 +837,7 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
{
tree dest, src, dest_index, src_index;
gfc_loopinfo *loop;
- gfc_ss_info *dest_info, *src_info;
+ gfc_ss_info *dest_info;
gfc_ss *dest_ss, *src_ss;
gfc_se src_se;
int n;
@@ -847,10 +847,8 @@ gfc_conv_array_transpose (gfc_se * se, gfc_expr * expr)
src_ss = gfc_walk_expr (expr);
dest_ss = se->ss;
- src_info = &src_ss->data.info;
dest_info = &dest_ss->data.info;
gcc_assert (dest_info->dimen == 2);
- gcc_assert (src_info->dimen == 2);
/* Get a descriptor for EXPR. */
gfc_init_se (&src_se, NULL);
@@ -3459,13 +3457,9 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
gfc_ss *ss;
gfc_ref *lref;
gfc_ref *rref;
- gfc_ref *aref;
int nDepend = 0;
- int temp_dim = 0;
loop->temp_ss = NULL;
- aref = dest->data.info.ref;
- temp_dim = 0;
for (ss = rss; ss != gfc_ss_terminator; ss = ss->next)
{
@@ -3514,7 +3508,6 @@ gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest,
if (depends[n])
loop->order[dim++] = n;
}
- temp_dim = dim;
for (n = 0; n < loop->dimen; n++)
{
if (! depends[n])
@@ -3557,12 +3550,10 @@ void
gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
{
int n;
- int dim;
gfc_ss_info *info;
gfc_ss_info *specinfo;
gfc_ss *ss;
tree tmp;
- tree len;
gfc_ss *loopspec[GFC_MAX_DIMENSIONS];
bool dynamic[GFC_MAX_DIMENSIONS];
gfc_constructor *c;
@@ -3743,7 +3734,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
loop->temp_ss->string_length);
tmp = loop->temp_ss->data.temp.type;
- len = loop->temp_ss->string_length;
n = loop->temp_ss->data.temp.dimen;
memset (&loop->temp_ss->data.info, 0, sizeof (gfc_ss_info));
loop->temp_ss->type = GFC_SS_SECTION;
@@ -3775,8 +3765,6 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
for (n = 0; n < info->dimen; n++)
{
- dim = info->dim[n];
-
/* If we are specifying the range the delta is already set. */
if (loopspec[n] != ss)
{
@@ -6180,7 +6168,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
gfc_ref *ref;
gfc_array_ref *ar;
gfc_ss *newss;
- gfc_ss *head;
int n;
for (ref = expr->ref; ref; ref = ref->next)
@@ -6253,8 +6240,6 @@ gfc_walk_variable_expr (gfc_ss * ss, gfc_expr * expr)
newss->data.info.dimen = 0;
newss->data.info.ref = ref;
- head = newss;
-
/* We add SS chains for all the subscripts in the section. */
for (n = 0; n < ar->dimen; n++)
{
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 1fb3c40f113..62a2e018210 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -1,5 +1,5 @@
/* Common block and equivalence list handling
- Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007, 2008
+ Copyright (C) 2000, 2003, 2004, 2005, 2006, 2007, 2008, 2009
Free Software Foundation, Inc.
Contributed by Canqun Yang <canqun@nudt.edu.cn>
@@ -636,7 +636,6 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
if (is_init)
{
tree ctor, tmp;
- HOST_WIDE_INT offset = 0;
VEC(constructor_elt,gc) *v = NULL;
if (field != NULL_TREE && field_init != NULL_TREE)
@@ -652,7 +651,6 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
s->sym->attr.pointer || s->sym->attr.allocatable);
CONSTRUCTOR_APPEND_ELT (v, s->field, tmp);
- offset = s->offset + s->length;
}
}
diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.c
index e2cd40bc954..74520889d7e 100644
--- a/gcc/fortran/trans-const.c
+++ b/gcc/fortran/trans-const.c
@@ -356,6 +356,7 @@ gfc_conv_constant (gfc_se * se, gfc_expr * expr)
if (expr->expr_type != EXPR_CONSTANT)
{
gfc_error ("non-constant initialization expression at %L", &expr->where);
+ se->expr = gfc_conv_constant_to_tree (gfc_int_expr (0));
return;
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 6646b266a6d..77de6bd5773 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -356,7 +356,6 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
{
tree tmp;
tree type;
- tree var;
tree fault;
gfc_se start;
gfc_se end;
@@ -365,7 +364,6 @@ gfc_conv_substring (gfc_se * se, gfc_ref * ref, int kind,
type = gfc_get_character_type (kind, ref->u.ss.length);
type = build_pointer_type (type);
- var = NULL_TREE;
gfc_init_se (&start, se);
gfc_conv_expr_type (&start, ref->u.ss.start, gfc_charlen_type_node);
gfc_add_block_to_block (&se->pre, &start.pre);
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index c3d7dfbab3c..4273b8226e8 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -832,7 +832,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
tree type;
tree bound;
tree tmp;
- tree cond, cond1, cond2, cond3, cond4, size;
+ tree cond, cond1, cond3, cond4, size;
tree ubound;
tree lbound;
gfc_se argse;
@@ -970,7 +970,6 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
tree stride = gfc_conv_descriptor_stride_get (desc, bound);
cond1 = fold_build2 (GE_EXPR, boolean_type_node, ubound, lbound);
- cond2 = fold_build2 (LE_EXPR, boolean_type_node, ubound, lbound);
cond3 = fold_build2 (GE_EXPR, boolean_type_node, stride,
gfc_index_zero_node);
@@ -4090,7 +4089,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
gfc_expr *arg;
gfc_ss *ss;
gfc_se argse;
- tree source;
tree source_bytes;
tree type;
tree tmp;
@@ -4106,7 +4104,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
if (ss == gfc_ss_terminator)
{
gfc_conv_expr_reference (&argse, arg);
- source = argse.expr;
type = TREE_TYPE (build_fold_indirect_ref_loc (input_location,
argse.expr));
@@ -4123,7 +4120,6 @@ gfc_conv_intrinsic_sizeof (gfc_se *se, gfc_expr *expr)
source_bytes = gfc_create_var (gfc_array_index_type, "bytes");
argse.want_pointer = 0;
gfc_conv_expr_descriptor (&argse, arg, ss);
- source = gfc_conv_descriptor_data_get (argse.expr);
type = gfc_get_element_type (TREE_TYPE (argse.expr));
/* Obtain the argument's word length. */
@@ -4228,7 +4224,6 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
tree size_bytes;
tree upper;
tree lower;
- tree stride;
tree stmt;
gfc_actual_arglist *arg;
gfc_se argse;
@@ -4332,7 +4327,6 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr)
tree idx;
idx = gfc_rank_cst[n];
gfc_add_modify (&argse.pre, source_bytes, tmp);
- stride = gfc_conv_descriptor_stride_get (argse.expr, idx);
lower = gfc_conv_descriptor_lbound_get (argse.expr, idx);
upper = gfc_conv_descriptor_ubound_get (argse.expr, idx);
tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
@@ -5065,13 +5059,10 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr)
void
gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr)
{
- gfc_intrinsic_sym *isym;
const char *name;
int lib, kind;
tree fndecl;
- isym = expr->value.function.isym;
-
name = &expr->value.function.name[2];
if (expr->rank > 0 && !expr->inline_noncopying_intrinsic)
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 4d461cfa488..a7f95669b49 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -700,7 +700,7 @@ static tree
gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
locus where)
{
- tree omp_clauses = NULL_TREE, chunk_size, c, old_clauses;
+ tree omp_clauses = NULL_TREE, chunk_size, c;
int list;
enum omp_clause_code clause_code;
gfc_se se;
@@ -759,7 +759,6 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses,
default:
gcc_unreachable ();
}
- old_clauses = omp_clauses;
omp_clauses
= gfc_trans_omp_reduction_list (n, omp_clauses, reduction_code,
where);
@@ -1134,14 +1133,13 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
stmtblock_t block;
stmtblock_t body;
gfc_omp_clauses *clauses = code->ext.omp_clauses;
- gfc_code *outermost;
int i, collapse = clauses->collapse;
tree dovar_init = NULL_TREE;
if (collapse <= 0)
collapse = 1;
- outermost = code = code->block->next;
+ code = code->block->next;
gcc_assert (code->op == EXEC_DO);
init = make_tree_vec (collapse);
@@ -1160,6 +1158,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
{
int simple = 0;
int dovar_found = 0;
+ tree dovar_decl;
if (clauses)
{
@@ -1200,12 +1199,19 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
gfc_conv_expr_val (&se, code->ext.iterator->step);
gfc_add_block_to_block (pblock, &se.pre);
step = gfc_evaluate_now (se.expr, pblock);
+ dovar_decl = dovar;
/* Special case simple loops. */
- if (integer_onep (step))
- simple = 1;
- else if (tree_int_cst_equal (step, integer_minus_one_node))
- simple = -1;
+ if (TREE_CODE (dovar) == VAR_DECL)
+ {
+ if (integer_onep (step))
+ simple = 1;
+ else if (tree_int_cst_equal (step, integer_minus_one_node))
+ simple = -1;
+ }
+ else
+ dovar_decl
+ = gfc_trans_omp_variable (code->ext.iterator->var->symtree->n.sym);
/* Loop body. */
if (simple)
@@ -1249,7 +1255,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
if (!dovar_found)
{
tmp = build_omp_clause (input_location, OMP_CLAUSE_PRIVATE);
- OMP_CLAUSE_DECL (tmp) = dovar;
+ OMP_CLAUSE_DECL (tmp) = dovar_decl;
omp_clauses = gfc_trans_add_clause (tmp, omp_clauses);
}
else if (dovar_found == 2)
@@ -1269,7 +1275,7 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
tmp = fold_build2 (MODIFY_EXPR, type, dovar, tmp);
for (c = omp_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (c) == dovar)
+ && OMP_CLAUSE_DECL (c) == dovar_decl)
{
OMP_CLAUSE_LASTPRIVATE_STMT (c) = tmp;
break;
@@ -1279,11 +1285,11 @@ gfc_trans_omp_do (gfc_code *code, stmtblock_t *pblock,
{
for (c = par_clauses; c ; c = OMP_CLAUSE_CHAIN (c))
if (OMP_CLAUSE_CODE (c) == OMP_CLAUSE_LASTPRIVATE
- && OMP_CLAUSE_DECL (c) == dovar)
+ && OMP_CLAUSE_DECL (c) == dovar_decl)
{
tree l = build_omp_clause (input_location,
OMP_CLAUSE_LASTPRIVATE);
- OMP_CLAUSE_DECL (l) = dovar;
+ OMP_CLAUSE_DECL (l) = dovar_decl;
OMP_CLAUSE_CHAIN (l) = omp_clauses;
OMP_CLAUSE_LASTPRIVATE_STMT (l) = tmp;
omp_clauses = l;
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 9096ad40849..18644779fc1 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2490,7 +2490,7 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
int rank, dim;
bool indirect = false;
tree etype, ptype, field, t, base_decl;
- tree data_off, offset_off, dim_off, dim_size, elem_size;
+ tree data_off, dim_off, dim_size, elem_size;
tree lower_suboff, upper_suboff, stride_suboff;
if (! GFC_DESCRIPTOR_TYPE_P (type))
@@ -2546,7 +2546,6 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
field = TYPE_FIELDS (TYPE_MAIN_VARIANT (type));
data_off = byte_position (field);
field = TREE_CHAIN (field);
- offset_off = byte_position (field);
field = TREE_CHAIN (field);
field = TREE_CHAIN (field);
dim_off = byte_position (field);
View Lorry Controller Status