re PR fortran/18540 (Jumping into blocks gives error rather than warning)

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.

Also converted the ChangeLog to use latin1 characters.

From-SVN: r109914

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1592d8b6091261d04b6faac43b8caf371443f0d3..b13f4f50ffc1321976c830b1c0aaf566b9e98bb0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2006-01-18  Tobias Schl\81ü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 \81Ávila de Esp\81í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\81ü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 91e5820031e59457093e815271381283d271ed70..e786b318927783896e2438cd019d19943e0ad15b 100644 (file)
--- 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 66db8d804f12b9001bea98333df622c83ab56996..b00a9b35b538162e2fd40dddd522a1085c31f71b 100644 (file)
--- 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 e72fe5d01caf9c8ea12834bc079c3a8f22862692..c88c74a7d23ce95f101de17e64ae2ac6751a5692 100644 (file)
--- 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 a07de602fbf60d93ad7b7bb11288fa058d5985d3..7dd4e1a8c63f4ab70f4f6764e4611b53cd8ed58b 100644 (file)
--- 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 b60e0c1283406fcc84ab683ab07942c880f0f316..56cff2c29a91b9f305c4f5c0831a902bd2ce2fa5 100644 (file)
--- 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 f51fcf8bcc4b93bb0f9a1d4dad22adc85be0c1b9..af9531679262110ac700d69a9520ca714dd8dd57 100644 (file)
--- 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 c3e15f2d1dd945a1c401ab71804a2836f521f026..c4d2cf02649a8c0004deaf7f5097f006ab6d814a 100644 (file)
--- 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;
 }