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