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

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

gcc/f/stc.c

 /* 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),

gcc/f/ste.c

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