mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-04 02:50:29 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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 2006-01-18 21:54:49 +01:00
parent 61da04bdad
commit 5cf5458549
8 changed files with 110 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
gcc/fortran/ChangeLog
View File

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

12
gcc/fortran/decl.c
View File

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

9
gcc/fortran/gfortran.h
View File

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

8
gcc/fortran/io.c
View File

@ -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
{

13
gcc/fortran/match.c
View File

@ -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;
}

8
gcc/fortran/primary.c
View File

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

54
gcc/fortran/resolve.c
View File

@ -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;
}

71
gcc/fortran/symbol.c
View File

@ -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;
}