procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

stc.c (ffestc_R810): Allow any kind integer in case statements.

Browse source 
2003-01-03  Bud Davis <bdavis11@directvinternet.com>

	* stc.c (ffestc_R810): Allow any kind integer in
	case statements.
	* ste.c (ffeste_R810): Give error message when
	case selector exceeds its valid values.

From-SVN: r60852
This commit is contained in:
Toon Moene 2003-01-03 22:02:29 +00:00
parent 4e8dca1c3a
commit 425c134868
3 changed files with 3245 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3232
gcc/f/ChangeLog
View file

File diff suppressed because it is too large Load diff

11
gcc/f/stc.c
View file

@ -1,5 +1,5 @@
/* stc.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 1997, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
@ -9195,18 +9195,13 @@ ffestc_R810 (ffesttCaseList cases, ffelexToken name)
ffebad_finish ();
continue;
}
if (((caseobj->expr1 != NULL)
&& ((ffeinfo_basictype (ffebld_info (caseobj->expr1))
!= s->type)
|| (ffeinfo_kindtype (ffebld_info (caseobj->expr1))
!= s->kindtype)))
!= s->type)))
|| ((caseobj->range)
&& (caseobj->expr2 != NULL)
&& ((ffeinfo_basictype (ffebld_info (caseobj->expr2))
!= s->type)
|| (ffeinfo_kindtype (ffebld_info (caseobj->expr2))
!= s->kindtype))))
!= s->type))))
{
ffebad_start (FFEBAD_CASE_TYPE_DISAGREE);
ffebad_here (0, ffelex_token_where_line (caseobj->t),

12
gcc/f/ste.c
View file

@ -1,5 +1,5 @@
/* ste.c -- Implementation File (module.c template V1.0)
Copyright (C) 1995, 1996, 2000, 2002 Free Software Foundation, Inc.
Copyright (C) 1995, 1996, 2000, 2002, 2003 Free Software Foundation, Inc.
Contributed by James Craig Burley.
This file is part of GNU Fortran.
@ -2725,7 +2725,15 @@ ffeste_R810 (ffestw block, unsigned long casenum)
}
else
pushok = pushcase (texprlow, convert, tlabel, &duplicate);
assert (pushok == 0);
assert((pushok !=2) || (pushok !=0));
if (pushok==2)
{
ffebad_start_msg ("SELECT (at %0) has duplicate cases -- check integer overflow of CASE(s)",
FFEBAD_severityFATAL);
ffebad_here (0, ffestw_line (block), ffestw_col (block));
ffebad_finish ();
ffestw_set_select_texpr (block, error_mark_node);
}
c = c->next_stmt;
/* Unlink prev. */
c->previous_stmt->previous_stmt->next_stmt = c;