[fortran,patch] Properly match character kinds

[fortran,patch] Properly match character kinds

[FX Coudert]

[-- Attachment #1: Type: text/plain, Size: 593 bytes --]

Hi all,

This patch fixes PR33529: we currently don't do proper matching of  
character kinds, because we expect them to be litteral integer  
constants and, though luck, that's certainly not guaranteed :)  So  
this borrows bits of code from gfc_match_kind_spec() to do it  
properly, calling gfc_match_init_expr() in turn. I copied some code  
around instead of simply sharing it, because there are some important  
differences between the matching of character kinds and integer/ 
logical/real/complex kinds, so it looked better that way.

Regtested on x86_64-linux, OK for mainline?

FX



[-- Attachment #2: pr33529.ChangeLog --]
[-- Type: application/octet-stream, Size: 347 bytes --]

2007-09-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/33529
	* decl.c (match_char_kind): New function.
	(match_char_spec): Use match_char_kind.


2007-09-30  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>

	PR fortran/33529
	* gfortran.dg/char_type_len_2.f90: Adjust error message.
	* gfortran.dg/char_decl_2.f90: New test.


[-- Attachment #3: pr33529.diff --]
[-- Type: application/octet-stream, Size: 6867 bytes --]

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 128673)
+++ gcc/fortran/decl.c	(working copy)
@@ -1845,20 +1845,80 @@ no_match:
 }
 
 
+static match
+match_char_kind (int * kind, int * is_iso_c)
+{
+  locus where;
+  gfc_expr *e;
+  match m, n;
+  const char *msg;
+
+  m = MATCH_NO;
+  e = NULL;
+  where = gfc_current_locus;
+
+  n = gfc_match_init_expr (&e);
+  if (n == MATCH_NO)
+    gfc_error ("Expected initialization expression at %C");
+  if (n != MATCH_YES)
+    return MATCH_ERROR;
+
+  if (e->rank != 0)
+    {
+      gfc_error ("Expected scalar initialization expression at %C");
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  msg = gfc_extract_int (e, kind);
+  *is_iso_c = e->ts.is_iso_c;
+  if (msg != NULL)
+    {
+      gfc_error (msg);
+      m = MATCH_ERROR;
+      goto no_match;
+    }
+
+  gfc_free_expr (e);
+
+  /* Ignore errors to this point, if we've gotten here.  This means
+     we ignore the m=MATCH_ERROR from above.  */
+  if (gfc_validate_kind (BT_CHARACTER, *kind, true) < 0)
+    {
+      gfc_error ("Kind %d is not supported for CHARACTER at %C", *kind);
+      m = MATCH_ERROR;
+    }
+  else
+     /* All tests passed.  */
+     m = MATCH_YES;
+
+  if (m == MATCH_ERROR)
+     gfc_current_locus = where;
+  
+  /* Return what we know from the test(s).  */
+  return m;
+
+no_match:
+  gfc_free_expr (e);
+  gfc_current_locus = where;
+  return m;
+}
+
 /* Match the various kind/length specifications in a CHARACTER
    declaration.  We don't return MATCH_NO.  */
 
 static match
 match_char_spec (gfc_typespec *ts)
 {
-  int kind, seen_length;
+  int kind, seen_length, is_iso_c;
   gfc_charlen *cl;
   gfc_expr *len;
   match m;
-  gfc_expr *kind_expr = NULL;
-  kind = gfc_default_character_kind;
+
   len = NULL;
   seen_length = 0;
+  kind = 0;
+  is_iso_c = 0;
 
   /* Try the old-style specification first.  */
   old_char_selector = 0;
@@ -1882,7 +1942,7 @@ match_char_spec (gfc_typespec *ts)
   /* Try the weird case:  ( KIND = <int> [ , LEN = <len-param> ] ).  */
   if (gfc_match (" kind =") == MATCH_YES)
     {
-      m = gfc_match_small_int_expr(&kind, &kind_expr);
+      m = match_char_kind (&kind, &is_iso_c);
        
       if (m == MATCH_ERROR)
 	goto done;
@@ -1918,13 +1978,8 @@ match_char_spec (gfc_typespec *ts)
       if (gfc_match (" , kind =") != MATCH_YES)
 	goto syntax;
 
-      gfc_match_small_int_expr(&kind, &kind_expr);
-
-      if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0)
-	{
-	  gfc_error ("Kind %d is not a CHARACTER kind at %C", kind);
-	  return MATCH_YES;
-	}
+      if (match_char_kind (&kind, &is_iso_c) == MATCH_ERROR)
+	goto done;
 
       goto rparen;
     }
@@ -1946,7 +2001,7 @@ match_char_spec (gfc_typespec *ts)
 
   gfc_match (" kind =");	/* Gobble optional text.  */
 
-  m = gfc_match_small_int_expr(&kind, &kind_expr);
+  m = match_char_kind (&kind, &is_iso_c);
   if (m == MATCH_ERROR)
     goto done;
   if (m == MATCH_NO)
@@ -1965,23 +2020,9 @@ syntax:
   return m;
 
 done:
-  if (gfc_validate_kind (BT_CHARACTER, kind, true) < 0)
-    {
-      gfc_error ("Kind %d is not a CHARACTER kind at %C", kind);
-      m = MATCH_ERROR;
-    }
-
-  if (seen_length == 1 && len != NULL
-      && len->ts.type != BT_INTEGER && len->ts.type != BT_UNKNOWN)
-    {
-      gfc_error ("Expression at %C must be of INTEGER type");
-      m = MATCH_ERROR;
-    }
-
   if (m != MATCH_YES)
     {
       gfc_free_expr (len);
-      gfc_free_expr (kind_expr);
       return m;
     }
 
@@ -1996,30 +2037,24 @@ done:
     cl->length = len;
 
   ts->cl = cl;
-  ts->kind = kind;
+  ts->kind = kind == 0 ? gfc_default_character_kind : kind;
 
   /* We have to know if it was a c interoperable kind so we can
      do accurate type checking of bind(c) procs, etc.  */
-  if (kind_expr != NULL)
-    {
-      /* Mark this as c interoperable if being declared with one
-	 of the named constants from iso_c_binding.  */
-      ts->is_c_interop = kind_expr->ts.is_iso_c;
-      gfc_free_expr (kind_expr);
-    }
+  if (kind != 0)
+    /* Mark this as c interoperable if being declared with one
+       of the named constants from iso_c_binding.  */
+    ts->is_c_interop = is_iso_c;
   else if (len != NULL)
-    {
-      /* Here, we might have parsed something such as:
-	 character(c_char)
-	 In this case, the parsing code above grabs the c_char when
-	 looking for the length (line 1690, roughly).  it's the last
-	 testcase for parsing the kind params of a character variable.
-	 However, it's not actually the length.	 this seems like it
-	 could be an error.  
-	 To see if the user used a C interop kind, test the expr
-	 of the so called length, and see if it's C interoperable.  */
-      ts->is_c_interop = len->ts.is_iso_c;
-    }
+    /* Here, we might have parsed something such as: character(c_char)
+       In this case, the parsing code above grabs the c_char when
+       looking for the length (line 1690, roughly).  it's the last
+       testcase for parsing the kind params of a character variable.
+       However, it's not actually the length.	 this seems like it
+       could be an error.  
+       To see if the user used a C interop kind, test the expr
+       of the so called length, and see if it's C interoperable.  */
+    ts->is_c_interop = len->ts.is_iso_c;
   
   return MATCH_YES;
 }
Index: gcc/testsuite/gfortran.dg/char_type_len_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_type_len_2.f90	(revision 128673)
+++ gcc/testsuite/gfortran.dg/char_type_len_2.f90	(working copy)
@@ -2,7 +2,9 @@
 ! PR31251 Non-integer character length leads to segfault
 ! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
   character(len=2.3) :: s ! { dg-error "must be of INTEGER type" }
-  character(kind=1,len=4.3) : t ! { dg-error "must be of INTEGER type" }
-  character(len=,,7.2,kind=1) : u ! { dg-error "Syntax error in CHARACTER declaration" }
-  character(len=7,kind=2) : v ! ! { dg-error "Kind 2 is not a CHARACTER kind" }
+  character(kind=1,len=4.3) :: t ! { dg-error "must be of INTEGER type" }
+  character(len=,,7.2,kind=1) :: u ! { dg-error "Syntax error in CHARACTER declaration" }
+  character(len=7,kind=2) :: v ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
+  character(kind=2) :: w ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
+  character(kind=2,len=7) :: x ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
   end
Index: gcc/testsuite/gfortran.dg/char_decl_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_decl_2.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/char_decl_2.f90	(revision 0)
@@ -0,0 +1,4 @@
+! { dg-do run }
+  character (kind=kind("a")) :: u
+  if (kind(u) /= kind("a")) call abort
+  end

Re: [fortran,patch] Properly match character kinds

[Steve Kargl]

On Sun, Sep 30, 2007 at 02:52:41PM +0100, FX Coudert wrote:
> 
> This patch fixes PR33529: we currently don't do proper matching of  
> character kinds, because we expect them to be litteral integer  
> constants and, though luck, that's certainly not guaranteed :)  So  
> this borrows bits of code from gfc_match_kind_spec() to do it  
> properly, calling gfc_match_init_expr() in turn. I copied some code  
> around instead of simply sharing it, because there are some important  
> differences between the matching of character kinds and integer/ 
> logical/real/complex kinds, so it looked better that way.
> 

OK.

-- 
Steve