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
This commit is contained in:
Tobias Schlüter
parent
61da04bdad
commit
5cf5458549
|
|
@ -1,3 +1,21 @@
|
|||
2006-01-18 Tobias Schl<68>ü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 <EFBFBD>Ávila de Esp<EFBFBD>í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<EFBFBD>üter <tobias.schlueter@physik.uni-muenchen.de>
|
||||
|
||||
* parse.c (next_fixed): Remove superfluous string concatenation.
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 (label->defined == ST_LABEL_UNKNOWN)
|
||||
return;
|
||||
|
||||
switch (label->referenced)
|
||||
{
|
||||
if (l->defined == ST_LABEL_UNKNOWN)
|
||||
continue;
|
||||
case ST_LABEL_UNKNOWN:
|
||||
gfc_warning ("Label %d at %L defined but not used", label->value,
|
||||
&label->where);
|
||||
break;
|
||||
|
||||
switch (l->referenced)
|
||||
{
|
||||
case ST_LABEL_UNKNOWN:
|
||||
gfc_warning ("Label %d at %L defined but not 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;
|
||||
|
||||
case ST_LABEL_BAD_TARGET:
|
||||
gfc_warning ("Label %d at %L defined but cannot be used", l->value,
|
||||
&l->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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue