procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/36275 ([F03] Binding label can be any scalar char initialisation expression)

Browse source 
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.

	* gfortran.dg/binding_label_tests_2.f03: Adjust error messages.
	* gfortran.dg/binding_label_tests_27.f90: New file.

From-SVN: r212123
This commit is contained in:
Francois-Xavier Coudert 2014-06-29 14:14:16 +00:00 • committed by François-Xavier Coudert
parent 516a84f7c0
commit 3b37ccd4ff
6 changed files with 132 additions and 140 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
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

115
gcc/fortran/decl.c
View file

@ -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 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 allow_binding_name)
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;
/* Get the closing quotation. */
if (double_quote == MATCH_YES)
if (gfc_match_init_expr (&e) != 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;
}
gfc_free_expr (e);
return MATCH_ERROR;
}
else
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 "'" char. */
return MATCH_ERROR;
}
gfc_error ("NAME= specifier at %C should be a constant expression");
gfc_free_expr (e);
return MATCH_ERROR;
}
}
if (e->expr_type != EXPR_CONSTANT || e->ts.type != BT_CHARACTER
|| e->ts.kind != gfc_default_character_kind || e->rank != 0)
{
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)

93
gcc/fortran/match.c
View file

@ -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. */

7
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,10 @@
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

21
gcc/testsuite/gfortran.dg/binding_label_tests_2.f03
View file

@ -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" }

27
gcc/testsuite/gfortran.dg/binding_label_tests_27.f90 Normal file
View file

@ -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