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

gcc/fortran/ChangeLog

+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.
 

gcc/fortran/decl.c

 /* 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;
 

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);

gcc/fortran/io.c

 /* 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
 {

gcc/fortran/match.c

 /* 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,6 +152,7 @@ gfc_match_small_literal_int (int *value, int *cnt)
 
   gfc_gobble_whitespace ();
   c = gfc_next_char ();
+  if (cnt)
     *cnt = 0;
 
   if (!ISDIGIT (c))
@@ -183,6 +185,7 @@ gfc_match_small_literal_int (int *value, int *cnt)
   gfc_current_locus = old_loc;
 
   *value = i;
+  if (cnt)
     *cnt = j;
   return MATCH_YES;
 }

gcc/fortran/primary.c

 /* 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;
 

gcc/fortran/resolve.c

@@ -3580,8 +3580,11 @@ 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 "
+      /* 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)
+  switch (label->referenced)
     {
     case ST_LABEL_UNKNOWN:
-	  gfc_warning ("Label %d at %L defined but not used", l->value,
-		       &l->where);
+      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);
+      gfc_warning ("Label %d at %L defined but cannot be used",
+		   label->value, &label->where);
       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;
 }

gcc/fortran/symbol.c

 /* 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,23 +1544,25 @@ 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)
+  lp = gfc_current_ns->st_labels;
+  while (lp)
+    {
       if (lp->value == labelno)
-      break;
-  if (lp != NULL)
 	return lp;
 
+      if (lp->value < labelno)
+	lp = lp->left;
+      else
+	lp = lp->right;
+    }
+
   lp = gfc_getmem (sizeof (gfc_st_label));
 
   lp->value = 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;
 }