From: FX Coudert <fxcoudert@gmail.com>
To: "fortran@gcc.gnu.org Fortran" <fortran@gcc.gnu.org>,
gcc-patches list <gcc-patches@gcc.gnu.org>
Subject: [fortran,patch] Properly match character kinds
Date: Sun, 30 Sep 2007 16:09:00 -0000 [thread overview]
Message-ID: <D9D5FF15-BB03-4D45-998B-EE61AA1C29FB@gmail.com> (raw)
[-- 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
next reply other threads:[~2007-09-30 13:52 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-09-30 16:09 FX Coudert [this message]
2007-10-04 4:06 ` Steve Kargl
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=D9D5FF15-BB03-4D45-998B-EE61AA1C29FB@gmail.com \
--to=fxcoudert@gmail.com \
--cc=fortran@gcc.gnu.org \
--cc=gcc-patches@gcc.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).