From 96ee3a4acd31befaabea989a2ceaa2225990519b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 12 Dec 2007 19:54:26 +0100 Subject: re PR fortran/34254 ("character(kind=c_char) function" fails if c_char is not host associated) 2007-12-12 Tobias Burnus 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 PR fortran/34254 * gfortran.dg/function_kinds_3.f90: New. From-SVN: r130793 --- gcc/fortran/decl.c | 29 ++++++++++++++++++++++++++--- 1 file changed, 26 insertions(+), 3 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 4c72277..072477e 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) -- cgit v1.1