From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 8035 invoked by alias); 30 Sep 2007 13:52:52 -0000 Received: (qmail 8016 invoked by uid 22791); 30 Sep 2007 13:52:51 -0000 X-Spam-Check-By: sourceware.org Received: from mu-out-0910.google.com (HELO mu-out-0910.google.com) (209.85.134.186) by sourceware.org (qpsmtpd/0.31) with ESMTP; Sun, 30 Sep 2007 13:52:49 +0000 Received: by mu-out-0910.google.com with SMTP id w9so4345066mue for ; Sun, 30 Sep 2007 06:52:46 -0700 (PDT) Received: by 10.78.176.20 with SMTP id y20mr1446435hue.1191160365903; Sun, 30 Sep 2007 06:52:45 -0700 (PDT) Received: from ?192.168.2.6? ( [90.193.94.8]) by mx.google.com with ESMTPS id i7sm264231nfh.2007.09.30.06.52.43 (version=TLSv1/SSLv3 cipher=OTHER); Sun, 30 Sep 2007 06:52:44 -0700 (PDT) Mime-Version: 1.0 (Apple Message framework v752.3) To: "fortran@gcc.gnu.org Fortran" , gcc-patches list Message-Id: Content-Type: multipart/mixed; boundary=Apple-Mail-1-252280247 From: FX Coudert Subject: [fortran,patch] Properly match character kinds Date: Sun, 30 Sep 2007 16:09:00 -0000 X-Mailer: Apple Mail (2.752.3) Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org X-SW-Source: 2007-09/txt/msg02095.txt.bz2 --Apple-Mail-1-252280247 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset=US-ASCII; delsp=yes; format=flowed Content-length: 593 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 --Apple-Mail-1-252280247 Content-Transfer-Encoding: 7bit Content-Type: application/octet-stream; x-unix-mode=0644; name=pr33529.ChangeLog Content-Disposition: attachment; filename=pr33529.ChangeLog Content-length: 347 2007-09-30 Francois-Xavier Coudert PR fortran/33529 * decl.c (match_char_kind): New function. (match_char_spec): Use match_char_kind. 2007-09-30 Francois-Xavier Coudert PR fortran/33529 * gfortran.dg/char_type_len_2.f90: Adjust error message. * gfortran.dg/char_decl_2.f90: New test. --Apple-Mail-1-252280247 Content-Transfer-Encoding: 7bit Content-Type: application/octet-stream; x-unix-mode=0644; name=pr33529.diff Content-Disposition: attachment; filename=pr33529.diff Content-length: 6867 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 = [ , LEN = ] ). */ 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 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 --Apple-Mail-1-252280247--