+2014-06-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ 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-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/29383
}
+/* 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 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
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. */
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;
- }
-
- /* 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;
+ if (gfc_match_init_expr (&e) != MATCH_YES)
+ {
+ gfc_free_expr (e);
+ return MATCH_ERROR;
+ }
- /* Get the closing quotation. */
- if (double_quote == MATCH_YES)
+ if (!gfc_simplify_expr(e, 0))
{
- 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;
- }
+ 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)
}
-/* 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. */
+2014-06-29 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ 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.
+
2014-06-29 Andreas Schwab <schwab@linux-m68k.org>
* gfortran.dg/ieee/ieee_6.f90: Allow inexact together with
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" }
--- /dev/null
+! { 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
projects / platform / upstream / gcc.git / commitdiff