re PR fortran/34254 ("character(kind=c_char) function" fails if c_char is not host...

2007-12-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34254
        * decl.c (match_char_kind): Support use-associated/imported
        kind parameters.
        (gfc_match_kind_spec): Support als BT_CHARACTER, when
        re-scanning kind spec.

2007-12-12  Tobias Burnus  <burnus@net-b.de>

        PR fortran/34254
        * gfortran.dg/function_kinds_3.f90: New.

From-SVN: r130793

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9f288603403e64e763224931f15c9406f65331a9..52de3c2b909488e6dec4b69e865d550bf34ae340 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-12-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34254
+       * decl.c (match_char_kind): Support use-associated/imported
+       kind parameters.
+       (gfc_match_kind_spec): Support als BT_CHARACTER, when
+       re-scanning kind spec.
+
 2007-12-11  Aldy Hernandez  <aldyh@redhat.com>
 
        * decl.c (add_global_entry): Make type unsigned.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 4c722777af2c30417e8e41686bfccff90061f04d..072477ef3ac1eb3241e8b7bc32f50b96b4c2ff0c 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1843,6 +1843,7 @@ gfc_match_kind_spec (gfc_typespec *ts, bool kind_expr_only)
   locus where, loc;
   gfc_expr *e;
   match m, n;
+  char c;
   const char *msg;
 
   m = MATCH_NO;
@@ -1932,11 +1933,17 @@ kind_expr:
     {
       gfc_error ("Kind %d not supported for type %s at %C", ts->kind,
                 gfc_basic_typename (ts->type));
-      m = MATCH_ERROR;
+      gfc_current_locus = where;
+      return MATCH_ERROR;
     }
-  else if (gfc_match_char (')') != MATCH_YES)
+
+  gfc_gobble_whitespace ();
+  if ((c = gfc_next_char ()) != ')' && (ts->type != BT_CHARACTER || c != ','))
     {
-      gfc_error ("Missing right parenthesis at %C");
+      if (ts->type == BT_CHARACTER)
+       gfc_error ("Missing right parenthesis or comma at %C");
+      else
+       gfc_error ("Missing right parenthesis at %C");
       m = MATCH_ERROR;
     }
   else
@@ -1969,6 +1976,22 @@ match_char_kind (int * kind, int * is_iso_c)
   where = gfc_current_locus;
 
   n = gfc_match_init_expr (&e);
+
+  if (n != MATCH_YES
+      && (gfc_current_state () == COMP_INTERFACE
+         || gfc_current_state () == COMP_NONE
+         || gfc_current_state () == COMP_CONTAINS))
+    {
+      /* Signal using kind = -1 that the expression might include
+        use-associated or imported parameters and try again after
+        the specification expressions.  */
+      gfc_free_expr (e);
+      *kind = -1;
+      gfc_function_kind_locus = where;
+      gfc_undo_symbols ();
+      return MATCH_YES;
+    }
+
   if (n == MATCH_NO)
     gfc_error ("Expected initialization expression at %C");
   if (n != MATCH_YES)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 85cd1e3d5b47b36a72df748f245a25932d4ff639..78f1b06a40a7ca3151882408698ec9714842f68d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-12  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/34254
+       * gfortran.dg/function_kinds_3.f90: New.
+
 2007-12-12  Andreas Krebbel  <krebbel1@de.ibm.com>
 
        * gcc.target/s390/20071212-1.c: New testcase.

diff --git a/gcc/testsuite/gfortran.dg/function_kinds_3.f90 b/gcc/testsuite/gfortran.dg/function_kinds_3.f90
new file mode 100644 (file)
index 0000000..b1dd2b4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/function_kinds_3.f90
@@ -0,0 +1,31 @@
+! { dg-do compile }
+!
+! PR fortran/34254
+!
+! The character-kind parameter was not accepted.
+!
+module m
+  integer, parameter :: char_t = kind('a')
+end module m
+
+character(1,char_t) function test1()
+  use m
+  test1 = 'A'
+end function test1
+
+character(len=1,kind=char_t) function test2()
+  use m
+  test2 = 'A'
+end function test2
+
+character(kind=char_t,len=1) function test3()
+  use m
+  test3 = 'A'
+end function test3
+
+character(1,kind=char_t) function test4()
+  use m
+  test4 = 'A'
+end function test4
+
+! { dg-final { cleanup-modules "m" } }