From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 31414 invoked by alias); 28 Jun 2014 15:47:16 -0000 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 Received: (qmail 31394 invoked by uid 89); 28 Jun 2014 15:47:15 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.9 required=5.0 tests=AWL,BAYES_00,FREEMAIL_FROM,RCVD_IN_DNSWL_LOW,SPF_PASS autolearn=ham version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-wi0-f172.google.com Received: from mail-wi0-f172.google.com (HELO mail-wi0-f172.google.com) (209.85.212.172) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES128-SHA encrypted) ESMTPS; Sat, 28 Jun 2014 15:47:13 +0000 Received: by mail-wi0-f172.google.com with SMTP id hi2so4166692wib.11 for ; Sat, 28 Jun 2014 08:47:10 -0700 (PDT) X-Received: by 10.180.81.37 with SMTP id w5mr18349303wix.65.1403970430097; Sat, 28 Jun 2014 08:47:10 -0700 (PDT) Received: from touille.home (89-93-42-136.hfc.dyn.abo.bbox.fr. [89.93.42.136]) by mx.google.com with ESMTPSA id u10sm9291963wix.11.2014.06.28.08.47.07 for (version=TLSv1 cipher=ECDHE-RSA-RC4-SHA bits=128/128); Sat, 28 Jun 2014 08:47:08 -0700 (PDT) From: FX Content-Type: multipart/mixed; boundary="Apple-Mail=_30B7CBF1-B7AC-4032-8714-CF2778B168C1" Message-Id: <481DCBE9-3424-4E05-BAC8-9B595EA262C6@gmail.com> Mime-Version: 1.0 (Mac OS X Mail 7.3 \(1878.2\)) Subject: Re: [fortran,patch] Binding label can be any initialisation expression Date: Sat, 28 Jun 2014 15:47:00 -0000 References: <8C199830-FC6E-4EA3-A8D4-C1521BDBF4C7@gmail.com> To: gfortran , gcc-patches In-Reply-To: X-SW-Source: 2014-06/txt/msg02297.txt.bz2 --Apple-Mail=_30B7CBF1-B7AC-4032-8714-CF2778B168C1 Content-Transfer-Encoding: quoted-printable Content-Type: text/plain; charset=windows-1252 Content-length: 1276 ping*2 > ping >=20 > To reinforce the message in my earlier email: we can fine-tune the list o= f allowed characters in identifiers later, but I=92d like to get this patch= in already (so it gets large exposure before the 4.10 release). >=20 > FX >=20 >=20 >=20 >> Binding label can be any initialisation expression. Well, only scalar c= haracter of the default kind, but still=85 >>=20 >> This patch achieves this goal by following the obvious plan, which has n= ot changed since I wrote it in PR 36275 in 2008 :) >> The custom matcher for binding label, in gfc_match_bind_c(), is removed = and the generic matcher gfc_match_init_expr() is called, followed by checks= that the expression obtained fulfills the constraints of a C identifier. >>=20 >> So, now is the time to think about PR 38839 (what characters to allow as= a binding label): right now, I allow alphadecimals, underscore and dollar.= From the PR comments, it seems like @ and ` might be also allowed for univ= ersal-character names, but they are not supported by GCC on platforms I tes= ted right now. Let me know what you think, but I don=92t think we should wo= rry to much about it. >>=20 >> Bootstrapped and regtested on x86_64-apple-darwin13, comes with testcase= s. >> OK to commit? >>=20 >> FX --Apple-Mail=_30B7CBF1-B7AC-4032-8714-CF2778B168C1 Content-Disposition: attachment; filename=bind_c.diff Content-Type: application/octet-stream; name="bind_c.diff" Content-Transfer-Encoding: 7bit Content-length: 10523 Index: gcc/fortran/decl.c =================================================================== --- gcc/fortran/decl.c (revision 211315) +++ gcc/fortran/decl.c (working copy) @@ -5779,6 +5779,54 @@ gfc_match_subroutine (void) } +/* Check that the NAME identifier in a BIND attribute or statement + is conform to C identifier rules. */ + +match +check_bind_name_identifier (char **name) +{ + char *n = *name, *p; + + /* Remove leading spaces. */ + while (*n == ' ') + n++; + + /* On an empty string, free memory and set name to NULL. */ + if (*n == '\0') + { + free (*name); + *name = NULL; + return MATCH_YES; + } + + /* Remove trailing spaces. */ + p = n + strlen(n) - 1; + while (*p == ' ') + *(p--) = '\0'; + + /* Insert the identifier into the symbol table. */ + p = xstrdup (n); + free (*name); + *name = p; + + /* Now check all that identifier is valid under C rules. */ + if (ISDIGIT (*p)) + { + gfc_error ("Invalid C identifier in NAME= specifier at %C"); + return MATCH_ERROR; + } + + for (; *p; p++) + if (!(ISALNUM (*p) || *p == '_' || *p == '$')) + { + gfc_error ("Invalid C identifier in NAME= specifier at %C"); + return MATCH_ERROR; + } + + return MATCH_YES; +} + + /* Match a BIND(C) specifier, with the optional 'name=' specifier if given, and set the binding label in either the given symbol (if not NULL), or in the current_ts. The symbol may be NULL because we may @@ -5793,10 +5841,8 @@ gfc_match_subroutine (void) match gfc_match_bind_c (gfc_symbol *sym, bool allow_binding_name) { - /* binding label, if exists */ - const char* binding_label = NULL; - match double_quote; - match single_quote; + char *binding_label = NULL; + gfc_expr *e = NULL; /* Initialize the flag that specifies whether we encountered a NAME= specifier or not. */ @@ -5821,44 +5867,37 @@ gfc_match_bind_c (gfc_symbol *sym, bool has_name_equals = 1; - /* Get the opening quote. */ - double_quote = MATCH_YES; - single_quote = MATCH_YES; - double_quote = gfc_match_char ('"'); - if (double_quote != MATCH_YES) - single_quote = gfc_match_char ('\''); - if (double_quote != MATCH_YES && single_quote != MATCH_YES) - { - gfc_error ("Syntax error in NAME= specifier for binding label " - "at %C"); - return MATCH_ERROR; - } + if (gfc_match_init_expr (&e) != MATCH_YES) + { + gfc_free_expr (e); + return MATCH_ERROR; + } - /* Grab the binding label, using functions that will not lower - case the names automatically. */ - if (gfc_match_name_C (&binding_label) != MATCH_YES) - return MATCH_ERROR; - - /* Get the closing quotation. */ - if (double_quote == MATCH_YES) - { - if (gfc_match_char ('"') != MATCH_YES) - { - gfc_error ("Missing closing quote '\"' for binding label at %C"); - /* User started string with '"' so looked to match it. */ - return MATCH_ERROR; - } + if (!gfc_simplify_expr(e, 0)) + { + gfc_error ("NAME= specifier at %C should be a constant expression"); + gfc_free_expr (e); + return MATCH_ERROR; } - else + + if (e->expr_type != EXPR_CONSTANT || e->ts.type != BT_CHARACTER + || e->ts.kind != gfc_default_character_kind || e->rank != 0) { - if (gfc_match_char ('\'') != MATCH_YES) - { - gfc_error ("Missing closing quote '\'' for binding label at %C"); - /* User started string with "'" char. */ - return MATCH_ERROR; - } + gfc_error ("NAME= specifier at %C should be a scalar of " + "default character kind"); + gfc_free_expr(e); + return MATCH_ERROR; } - } + + // Get a C string from the Fortran string constant + binding_label = gfc_widechar_to_char (e->value.character.string, + e->value.character.length); + gfc_free_expr(e); + + // Check that it is valid (old gfc_match_name_C) + if (check_bind_name_identifier (&binding_label) != MATCH_YES) + return MATCH_ERROR; + } /* Get the required right paren. */ if (gfc_match_char (')') != MATCH_YES) Index: gcc/fortran/match.c =================================================================== --- gcc/fortran/match.c (revision 211315) +++ gcc/fortran/match.c (working copy) @@ -569,99 +569,6 @@ gfc_match_name (char *buffer) } -/* Match a valid name for C, which is almost the same as for Fortran, - except that you can start with an underscore, etc.. It could have - been done by modifying the gfc_match_name, but this way other - things C allows can be done, such as no limits on the length. - Also, by rewriting it, we use the gfc_next_char_C() to prevent the - input characters from being automatically lower cased, since C is - case sensitive. The parameter, buffer, is used to return the name - that is matched. Return MATCH_ERROR if the name is not a valid C - name, MATCH_NO if what we're seeing isn't a name, and MATCH_YES if - we successfully match a C name. */ - -match -gfc_match_name_C (const char **buffer) -{ - locus old_loc; - size_t i = 0; - gfc_char_t c; - char* buf; - size_t cursz = 16; - - old_loc = gfc_current_locus; - gfc_gobble_whitespace (); - - /* Get the next char (first possible char of name) and see if - it's valid for C (either a letter or an underscore). */ - c = gfc_next_char_literal (INSTRING_WARN); - - /* If the user put nothing expect spaces between the quotes, it is valid - and simply means there is no name= specifier and the name is the Fortran - symbol name, all lowercase. */ - if (c == '"' || c == '\'') - { - gfc_current_locus = old_loc; - return MATCH_YES; - } - - if (!ISALPHA (c) && c != '_') - { - gfc_error ("Invalid C name in NAME= specifier at %C"); - return MATCH_ERROR; - } - - buf = XNEWVEC (char, cursz); - /* Continue to read valid variable name characters. */ - do - { - gcc_assert (gfc_wide_fits_in_byte (c)); - - buf[i++] = (unsigned char) c; - - if (i >= cursz) - { - cursz *= 2; - buf = XRESIZEVEC (char, buf, cursz); - } - - old_loc = gfc_current_locus; - - /* Get next char; param means we're in a string. */ - c = gfc_next_char_literal (INSTRING_WARN); - } while (ISALNUM (c) || c == '_'); - - /* The binding label will be needed later anyway, so just insert it - into the symbol table. */ - buf[i] = '\0'; - *buffer = IDENTIFIER_POINTER (get_identifier (buf)); - XDELETEVEC (buf); - gfc_current_locus = old_loc; - - /* See if we stopped because of whitespace. */ - if (c == ' ') - { - gfc_gobble_whitespace (); - c = gfc_peek_ascii_char (); - if (c != '"' && c != '\'') - { - gfc_error ("Embedded space in NAME= specifier at %C"); - return MATCH_ERROR; - } - } - - /* If we stopped because we had an invalid character for a C name, report - that to the user by returning MATCH_NO. */ - if (c != '"' && c != '\'') - { - gfc_error ("Invalid C name in NAME= specifier at %C"); - return MATCH_ERROR; - } - - return MATCH_YES; -} - - /* Match a symbol on the input. Modifies the pointer to the symbol pointer if successful. */ Index: gcc/testsuite/gfortran.dg/binding_label_tests_2.f03 =================================================================== --- gcc/testsuite/gfortran.dg/binding_label_tests_2.f03 (revision 211315) +++ gcc/testsuite/gfortran.dg/binding_label_tests_2.f03 (working copy) @@ -7,25 +7,28 @@ contains subroutine ok() end subroutine ok - subroutine sub0() bind(c, name=" 1") ! { dg-error "Invalid C name" } + subroutine sub0() bind(c, name=" 1") ! { dg-error "Invalid C identifier" } end subroutine sub0 ! { dg-error "Expecting END MODULE" } - subroutine sub1() bind(c, name="$") ! { dg-error "Invalid C name" } - end subroutine sub1 ! { dg-error "Expecting END MODULE" } + subroutine sub1() bind(c, name="$") + end subroutine sub1 - subroutine sub2() bind(c, name="abc$") ! { dg-error "Invalid C name" } - end subroutine sub2 ! { dg-error "Expecting END MODULE" } + subroutine sub2() bind(c, name="abc$") + end subroutine sub2 - subroutine sub3() bind(c, name="abc d") ! { dg-error "Embedded space" } + subroutine sub3() bind(c, name="abc d") ! { dg-error "Invalid C identifier" } end subroutine sub3 ! { dg-error "Expecting END MODULE" } - subroutine sub5() BIND(C, name=" myvar 2 ") ! { dg-error "Embedded space" } + subroutine sub4() bind(c, name="2foo") ! { dg-error "Invalid C identifier" } + end subroutine sub4 ! { dg-error "Expecting END MODULE" } + + subroutine sub5() BIND(C, name=" myvar 2 ") ! { dg-error "Invalid C identifier" } end subroutine sub5 ! { dg-error "Expecting END MODULE" } - subroutine sub6() bind(c, name=" ) ! { dg-error "Invalid C name" } + subroutine sub6() bind(c, name=" ) ! { dg-error "Invalid C identifier" } end subroutine sub6 ! { dg-error "Expecting END MODULE" } - subroutine sub7() bind(c, name=) ! { dg-error "Syntax error" } + subroutine sub7() bind(c, name=) ! { dg-error "Invalid character" } end subroutine sub7 ! { dg-error "Expecting END MODULE" } subroutine sub8() bind(c, name) ! { dg-error "Syntax error" } Index: gcc/testsuite/gfortran.dg/binding_label_tests_27.f90 =================================================================== --- gcc/testsuite/gfortran.dg/binding_label_tests_27.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/binding_label_tests_27.f90 (working copy) @@ -0,0 +1,27 @@ +! { dg-do compile } + +module p + + implicit none + integer i1, i2, i3, i4, i5, i6, i7, i8, i9, i10 + + character(len=*), parameter :: s = "toto" + character(len=*), parameter :: t(2) = ["x", "y"] + + bind(c,name=" foo ") :: i1 + bind(c, name=trim("Hello ") // "There") :: i2 + bind(c, name=1_"name") :: i3 + bind(c, name=4_"") :: i4 ! { dg-error "scalar of default character kind" } + bind(c, name=1) :: i5 ! { dg-error "scalar of default character kind" } + bind(c, name=1.0) :: i6 ! { dg-error "scalar of default character kind" } + bind(c, name=["","",""]) :: i7 ! { dg-error "scalar of default character kind" } + bind(c, name=s) :: i8 + bind(c, name=t(2)) :: i9 + +end module + +subroutine foobar(s) + character(len=*) :: s + integer :: i + bind(c, name=s) :: i ! { dg-error "constant expression" } +end subroutine --Apple-Mail=_30B7CBF1-B7AC-4032-8714-CF2778B168C1 Content-Disposition: attachment; filename=bind_c.ChangeLog Content-Type: application/octet-stream; name="bind_c.ChangeLog" Content-Transfer-Encoding: 7bit Content-length: 480 2014-06-08 Francois-Xavier Coudert PR fortran/36275 PR fortran/38839 * decl.c (check_bind_name_identifier): New function. (gfc_match_bind_c): Match any constant expression as binding label. * match.c (gfc_match_name_C): Remove. 2014-06-08 Francois-Xavier Coudert PR fortran/36275 PR fortran/38839 * gfortran.dg/binding_label_tests_2.f03: Adjust error messages. * gfortran.dg/binding_label_tests_27.f90: New file. --Apple-Mail=_30B7CBF1-B7AC-4032-8714-CF2778B168C1--