From: Tobias Burnus <burnus@net-b.de>
Date: Wed, 12 Dec 2007 18:54:26 +0000 (+0100)
Subject: re PR fortran/34254 ("character(kind=c_char) function" fails if c_char is not host... 
X-Git-Tag: releases/gcc-4.3.0~1090
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=96ee3a4acd31befaabea989a2ceaa2225990519b;p=thirdparty%2Fgcc.git

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

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 9f288603403e..52de3c2b9094 100644
--- 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 4c722777af2c..072477ef3ac1 100644
--- 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 85cd1e3d5b47..78f1b06a40a7 100644
--- 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
index 000000000000..b1dd2b4a2d00
--- /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" } }