[PATCH,fortran] Relax restrictions on KIND in SELECT CASE constructs

[Steve Kargl]

On Fri, Dec 17, 2004 at 12:49:51PM -0800, Steve Kargl wrote:
> 
> The attached patch relaxes gfortran's restriction to match C805.
> 
> 2004-12-17  Steven G. Kargl  <kargls@comcast.net>
> 
>      * resolve.c (validate_case_label_expr): Fix handling of mismatched KINDs.
> 

Here's a better patch.

-- 
Steve
-------------- next part --------------
Index: resolve.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.24
diff -u -r1.24 resolve.c
--- resolve.c	15 Dec 2004 03:56:05 -0000	1.24
+++ resolve.c	18 Dec 2004 00:34:58 -0000
@@ -2713,30 +2713,42 @@
 
 /* Check to see if an expression is suitable for use in a CASE
    statement.  Makes sure that all case expressions are scalar
-   constants of the same type/kind.  Return FAILURE if anything
+   constants of the same type.  Only the CHARACTER type must have
+   the same kind as the case-expr.  Return FAILURE if anything
    is wrong.  */
 
 static try
 validate_case_label_expr (gfc_expr * e, gfc_expr * case_expr)
 {
-  gfc_typespec case_ts = case_expr->ts;
 
   if (e == NULL) return SUCCESS;
 
-  if (e->ts.type != case_ts.type)
+  if (e->ts.type != case_expr->ts.type)
     {
       gfc_error ("Expression in CASE statement at %L must be of type %s",
-		 &e->where, gfc_basic_typename (case_ts.type));
+		 &e->where, gfc_basic_typename (case_expr->ts.type));
       return FAILURE;
     }
 
-  if (e->ts.kind != case_ts.kind)
+  /* C805 (R808) For a given case-construct, each case-value shall be of
+     the same type as case-expr.  For character type, length differences
+     are allowed, but the kind type parameters shall be the same.  */
+
+  if (case_expr->ts.type == BT_CHARACTER && e->ts.kind != case_expr->ts.kind)
     {
       gfc_error("Expression in CASE statement at %L must be kind %d",
-                &e->where, case_ts.kind);
+                &e->where, case_expr->ts.kind);
       return FAILURE;
     }
 
+  if (e->ts.kind != case_expr->ts.kind)
+    {
+      if (e->ts.kind == gfc_kind_max(e, case_expr))
+	gfc_convert_type_warn (case_expr, &e->ts, 2, 0);
+      else
+	gfc_convert_type_warn (e, &case_expr->ts, 2, 0);
+    }
+
   if (e->rank != 0)
     {
       gfc_error ("Expression in CASE statement at %L must be scalar",