aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog22
-rw-r--r--gcc/fortran/decl.c12
-rw-r--r--gcc/fortran/gfortran.h9
-rw-r--r--gcc/fortran/io.c8
-rw-r--r--gcc/fortran/match.c13
-rw-r--r--gcc/fortran/primary.c8
-rw-r--r--gcc/fortran/resolve.c54
-rw-r--r--gcc/fortran/symbol.c71
8 files changed, 110 insertions, 87 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1592d8b..b13f4f5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2006-01-18 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
+
+ PR fortran/18540
+ PR fortran/18937
+ * gfortran.h (BBT_HEADER): Move definition up.
+ (gfc_st_label): Add BBT_HEADER, remove 'prev' and 'next'.
+ * io.c (format_asterisk): Adapt initializer.
+ * resolve.c (resolve_branch): Allow FORTRAN 66 cross-block GOTOs
+ as extension.
+ * symbol.c (compare_st_labels): New function.
+ (gfc_free_st_label, free_st_labels, gfc_get_st_label): Convert to
+ using balanced binary tree.
+ * decl.c (match_char_length, gfc_match_old_kind_spec): Do away
+ with 'cnt'.
+ (warn_unused_label): Adapt to binary tree.
+ * match.c (gfc_match_small_literal_int): Only set cnt if non-NULL.
+ * primary.c (match_kind_param): Do away with cnt.
+
2006-01-18 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20869
@@ -22,7 +40,7 @@
argument checking. Replace strcmp's with comparisons with generic
codes.
-2006-01-16 Rafael Ãvila de Espíndola <rafael.espindola@gmail.com>
+2006-01-16 Rafael Ávila de Espíndol <rafael.espindola@gmail.com>
* gfortranspec.c (lang_specific_spec_functions): Remove.
@@ -59,7 +77,7 @@
* trans.c (gfc_add_expr_to_block): Do not fold tcc_statement
nodes.
-2006-01-11 Tobias Schl"uter <tobias.schlueter@physik.uni-muenchen.de>
+2006-01-11 Tobias Schlüter <tobias.schlueter@physik.uni-muenchen.de>
* parse.c (next_fixed): Remove superfluous string concatenation.
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 91e5820..e786b31 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1,5 +1,5 @@
/* Declaration statement matcher
- Copyright (C) 2002, 2004, 2005 Free Software Foundation, Inc.
+ Copyright (C) 2002, 2004, 2005, 2006 Free Software Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -508,15 +508,14 @@ char_len_param_value (gfc_expr ** expr)
static match
match_char_length (gfc_expr ** expr)
{
- int length, cnt;
+ int length;
match m;
m = gfc_match_char ('*');
if (m != MATCH_YES)
return m;
- /* cnt is unused, here. */
- m = gfc_match_small_literal_int (&length, &cnt);
+ m = gfc_match_small_literal_int (&length, NULL);
if (m == MATCH_ERROR)
return m;
@@ -1280,13 +1279,12 @@ match
gfc_match_old_kind_spec (gfc_typespec * ts)
{
match m;
- int original_kind, cnt;
+ int original_kind;
if (gfc_match_char ('*') != MATCH_YES)
return MATCH_NO;
- /* cnt is unsed, here. */
- m = gfc_match_small_literal_int (&ts->kind, &cnt);
+ m = gfc_match_small_literal_int (&ts->kind, NULL);
if (m != MATCH_YES)
return MATCH_ERROR;
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 66db8d8..b00a9b3 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -436,6 +436,9 @@ typedef enum gfc_generic_isym_id gfc_generic_isym_id;
/************************* Structures *****************************/
+/* Used for keeping things in balanced binary trees. */
+#define BBT_HEADER(self) int priority; struct self *left, *right
+
/* Symbol attribute structure. */
typedef struct
{
@@ -676,6 +679,8 @@ gfc_namelist;
/* TODO: Make format/statement specifics a union. */
typedef struct gfc_st_label
{
+ BBT_HEADER(gfc_st_label);
+
int value;
gfc_sl_type defined, referenced;
@@ -685,8 +690,6 @@ typedef struct gfc_st_label
tree backend_decl;
locus where;
-
- struct gfc_st_label *prev, *next;
}
gfc_st_label;
@@ -817,8 +820,6 @@ gfc_entry_list;
several symtrees pointing to the same symbol node via USE
statements. */
-#define BBT_HEADER(self) int priority; struct self *left, *right
-
typedef struct gfc_symtree
{
BBT_HEADER (gfc_symtree);
diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index e72fe5d..c88c74a 100644
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -1,6 +1,6 @@
/* Deal with I/O statements & related stuff.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -28,8 +28,8 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
#include "parse.h"
gfc_st_label format_asterisk =
- { -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL, 0,
- {NULL, NULL}, NULL, NULL};
+ {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
+ 0, {NULL, NULL}};
typedef struct
{
diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index a07de60..7dd4e1a 100644
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -1,6 +1,6 @@
/* Matching subroutines in all sizes, shapes and colors.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -138,7 +138,8 @@ gfc_match_eos (void)
/* Match a literal integer on the input, setting the value on
MATCH_YES. Literal ints occur in kind-parameters as well as
- old-style character length specifications. */
+ old-style character length specifications. If cnt is non-NULL it
+ will be set to the number of digits. */
match
gfc_match_small_literal_int (int *value, int *cnt)
@@ -151,7 +152,8 @@ gfc_match_small_literal_int (int *value, int *cnt)
gfc_gobble_whitespace ();
c = gfc_next_char ();
- *cnt = 0;
+ if (cnt)
+ *cnt = 0;
if (!ISDIGIT (c))
{
@@ -183,7 +185,8 @@ gfc_match_small_literal_int (int *value, int *cnt)
gfc_current_locus = old_loc;
*value = i;
- *cnt = j;
+ if (cnt)
+ *cnt = j;
return MATCH_YES;
}
diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index b60e0c1..56cff2c 100644
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -1,6 +1,6 @@
/* Primary expression subroutines
- Copyright (C) 2000, 2001, 2002, 2004, 2005 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -40,10 +40,8 @@ match_kind_param (int *kind)
gfc_symbol *sym;
const char *p;
match m;
- int cnt;
- /* cnt is unused, here. */
- m = gfc_match_small_literal_int (kind, &cnt);
+ m = gfc_match_small_literal_int (kind, NULL);
if (m != MATCH_NO)
return m;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index f51fcf8..af95316 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -3580,9 +3580,12 @@ resolve_branch (gfc_st_label * label, gfc_code * code)
if (found == NULL)
{
- /* still nothing, so illegal. */
- gfc_error_now ("Label at %L is not in the same block as the "
- "GOTO statement at %L", &lp->where, &code->loc);
+ /* The label is not in an enclosing block, so illegal. This was
+ allowed in Fortran 66, so we allow it as extension. We also
+ forego further checks if we run into this. */
+ gfc_notify_std (GFC_STD_LEGACY,
+ "Label at %L is not in the same block as the "
+ "GOTO statement at %L", &lp->where, &code->loc);
return;
}
@@ -5217,38 +5220,33 @@ gfc_elemental (gfc_symbol * sym)
/* Warn about unused labels. */
static void
-warn_unused_label (gfc_namespace * ns)
+warn_unused_label (gfc_st_label * label)
{
- gfc_st_label *l;
-
- l = ns->st_labels;
- if (l == NULL)
+ if (label == NULL)
return;
- while (l->next)
- l = l->next;
+ warn_unused_label (label->left);
- for (; l; l = l->prev)
- {
- if (l->defined == ST_LABEL_UNKNOWN)
- continue;
+ if (label->defined == ST_LABEL_UNKNOWN)
+ return;
- switch (l->referenced)
- {
- case ST_LABEL_UNKNOWN:
- gfc_warning ("Label %d at %L defined but not used", l->value,
- &l->where);
- break;
+ switch (label->referenced)
+ {
+ case ST_LABEL_UNKNOWN:
+ gfc_warning ("Label %d at %L defined but not used", label->value,
+ &label->where);
+ break;
- case ST_LABEL_BAD_TARGET:
- gfc_warning ("Label %d at %L defined but cannot be used", l->value,
- &l->where);
- break;
+ case ST_LABEL_BAD_TARGET:
+ gfc_warning ("Label %d at %L defined but cannot be used",
+ label->value, &label->where);
+ break;
- default:
- break;
- }
+ default:
+ break;
}
+
+ warn_unused_label (label->right);
}
@@ -5713,7 +5711,7 @@ gfc_resolve (gfc_namespace * ns)
/* Warn about unused labels. */
if (gfc_option.warn_unused_labels)
- warn_unused_label (ns);
+ warn_unused_label (ns->st_labels);
gfc_current_ns = old_ns;
}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index c3e15f2..c4d2cf0 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -1,6 +1,6 @@
/* Maintain binary trees of symbols.
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation,
- Inc.
+ Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software
+ Foundation, Inc.
Contributed by Andy Vaught
This file is part of GCC.
@@ -1487,25 +1487,30 @@ gfc_get_component_attr (symbol_attribute * attr, gfc_component * c)
/******************** Statement label management ********************/
-/* Free a single gfc_st_label structure, making sure the list is not
+/* Comparison function for statement labels, used for managing the
+ binary tree. */
+
+static int
+compare_st_labels (void * a1, void * b1)
+{
+ int a = ((gfc_st_label *)a1)->value;
+ int b = ((gfc_st_label *)b1)->value;
+
+ return (b - a);
+}
+
+
+/* Free a single gfc_st_label structure, making sure the tree is not
messed up. This function is called only when some parse error
occurs. */
void
gfc_free_st_label (gfc_st_label * label)
{
-
if (label == NULL)
return;
- if (label->prev)
- label->prev->next = label->next;
-
- if (label->next)
- label->next->prev = label->prev;
-
- if (gfc_current_ns->st_labels == label)
- gfc_current_ns->st_labels = label->next;
+ gfc_delete_bbt (&gfc_current_ns->st_labels, label, compare_st_labels);
if (label->format != NULL)
gfc_free_expr (label->format);
@@ -1513,20 +1518,20 @@ gfc_free_st_label (gfc_st_label * label)
gfc_free (label);
}
-/* Free a whole list of gfc_st_label structures. */
+/* Free a whole tree of gfc_st_label structures. */
static void
-free_st_labels (gfc_st_label * l1)
+free_st_labels (gfc_st_label * label)
{
- gfc_st_label *l2;
+ if (label == NULL)
+ return;
- for (; l1; l1 = l2)
- {
- l2 = l1->next;
- if (l1->format != NULL)
- gfc_free_expr (l1->format);
- gfc_free (l1);
- }
+ free_st_labels (label->left);
+ free_st_labels (label->right);
+
+ if (label->format != NULL)
+ gfc_free_expr (label->format);
+ gfc_free (label);
}
@@ -1539,11 +1544,17 @@ gfc_get_st_label (int labelno)
gfc_st_label *lp;
/* First see if the label is already in this namespace. */
- for (lp = gfc_current_ns->st_labels; lp; lp = lp->next)
- if (lp->value == labelno)
- break;
- if (lp != NULL)
- return lp;
+ lp = gfc_current_ns->st_labels;
+ while (lp)
+ {
+ if (lp->value == labelno)
+ return lp;
+
+ if (lp->value < labelno)
+ lp = lp->left;
+ else
+ lp = lp->right;
+ }
lp = gfc_getmem (sizeof (gfc_st_label));
@@ -1551,11 +1562,7 @@ gfc_get_st_label (int labelno)
lp->defined = ST_LABEL_UNKNOWN;
lp->referenced = ST_LABEL_UNKNOWN;
- lp->prev = NULL;
- lp->next = gfc_current_ns->st_labels;
- if (gfc_current_ns->st_labels)
- gfc_current_ns->st_labels->prev = lp;
- gfc_current_ns->st_labels = lp;
+ gfc_insert_bbt (&gfc_current_ns->st_labels, lp, compare_st_labels);
return lp;
}
generated by cgit v1.1 at 2025-03-01 13:07:03 +0000