Skip to content

R
riscv-gcc-1
Commit 439251f7 by Tobias Schlüter
Options

Revert previous accidental commit. 

From-SVN: r83875
parent fbc9b453
Showing with 209 additions and 218 deletions
gcc/fortran/decl.c
......@@ -874,12 +874,12 @@ done:
to the matched specification. This is necessary for FUNCTION and
IMPLICIT statements.
If implicit_flag is nonzero, then we don't check for the optional
kind specification. Not doing so is needed for matching an IMPLICIT
If kind_flag is nonzero, then we check for the optional kind
specification. Not doing so is needed for matching an IMPLICIT
statement correctly. */
static match
match_type_spec (gfc_typespec * ts, int implicit_flag)
match
gfc_match_type_spec (gfc_typespec * ts, int kind_flag)
{
char name[GFC_MAX_SYMBOL_LEN + 1];
gfc_symbol *sym;
......@@ -898,10 +898,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
if (gfc_match (" character") == MATCH_YES)
{
ts->type = BT_CHARACTER;
if (implicit_flag == 0)
return match_char_spec (ts);
else
return MATCH_YES;
return match_char_spec (ts);
}
if (gfc_match (" real") == MATCH_YES)
......@@ -963,7 +960,7 @@ match_type_spec (gfc_typespec * ts, int implicit_flag)
get_kind:
/* For all types except double, derived and character, look for an
optional kind specifier. MATCH_NO is actually OK at this point. */
if (implicit_flag == 1)
if (kind_flag == 0)
return MATCH_YES;
if (gfc_current_form == FORM_FREE)
......@@ -985,210 +982,6 @@ get_kind:
}
/* Match an IMPLICIT NONE statement. Actually, this statement is
already matched in parse.c, or we would not end up here in the
first place. So the only thing we need to check, is if there is
trailing garbage. If not, the match is successful. */
match
gfc_match_implicit_none (void)
{
return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
}
/* Match the letter range(s) of an IMPLICIT statement. */
static match
match_implicit_range (gfc_typespec * ts)
{
int c, c1, c2, inner;
locus cur_loc;
cur_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if (c != '(')
{
gfc_error ("Missing character range in IMPLICIT at %C");
goto bad;
}
inner = 1;
while (inner)
{
gfc_gobble_whitespace ();
c1 = gfc_next_char ();
if (!ISALPHA (c1))
goto bad;
gfc_gobble_whitespace ();
c = gfc_next_char ();
switch (c)
{
case ')':
inner = 0; /* Fall through */
case ',':
c2 = c1;
break;
case '-':
gfc_gobble_whitespace ();
c2 = gfc_next_char ();
if (!ISALPHA (c2))
goto bad;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c != ',') && (c != ')'))
goto bad;
if (c == ')')
inner = 0;
break;
default:
goto bad;
}
if (c1 > c2)
{
gfc_error ("Letters must be in alphabetic order in "
"IMPLICIT statement at %C");
goto bad;
}
/* See if we can add the newly matched range to the pending
implicits from this IMPLICIT statement. We do not check for
conflicts with whatever earlier IMPLICIT statements may have
set. This is done when we've successfully finished matching
the current one. */
if (gfc_add_new_implicit_range (c1, c2, ts) != SUCCESS)
goto bad;
}
return MATCH_YES;
bad:
gfc_syntax_error (ST_IMPLICIT);
gfc_current_locus = cur_loc;
return MATCH_ERROR;
}
/* Match an IMPLICIT statement, storing the types for
gfc_set_implicit() if the statement is accepted by the parser.
There is a strange looking, but legal syntactic construction
possible. It looks like:
IMPLICIT INTEGER (a-b) (c-d)
This is legal if "a-b" is a constant expression that happens to
equal one of the legal kinds for integers. The real problem
happens with an implicit specification that looks like:
IMPLICIT INTEGER (a-b)
In this case, a typespec matcher that is "greedy" (as most of the
matchers are) gobbles the character range as a kindspec, leaving
nothing left. We therefore have to go a bit more slowly in the
matching process by inhibiting the kindspec checking during
typespec matching and checking for a kind later. */
match
gfc_match_implicit (void)
{
gfc_typespec ts;
locus cur_loc;
int c;
match m;
/* We don't allow empty implicit statements. */
if (gfc_match_eos () == MATCH_YES)
{
gfc_error ("Empty IMPLICIT statement at %C");
return MATCH_ERROR;
}
/* First cleanup. */
gfc_clear_new_implicit ();
do
{
/* A basic type is mandatory here. */
m = match_type_spec (&ts, 1);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
cur_loc = gfc_current_locus;
m = match_implicit_range (&ts);
if (m != MATCH_YES && ts.type == BT_CHARACTER)
{
/* looks like we are matching CHARACTER (<len>) (<range>) */
m = match_char_spec (&ts);
}
if (m == MATCH_YES)
{
/* Looks like we have the <TYPE> (<RANGE>). */
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c == '\n') || (c == ','))
continue;
gfc_current_locus = cur_loc;
}
/* Last chance -- check <TYPE> (<KIND>) (<RANGE>). */
m = gfc_match_kind_spec (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
{
m = gfc_match_old_kind_spec (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
}
m = match_implicit_range (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c != '\n') && (c != ','))
goto syntax;
}
while (c == ',');
/* All we need to now is try to merge the new implicit types back
into the existing types. This will fail if another implicit
type is already defined for a letter. */
return (gfc_merge_new_implicit () == SUCCESS) ?
MATCH_YES : MATCH_ERROR;
syntax:
gfc_syntax_error (ST_IMPLICIT);
error:
return MATCH_ERROR;
}
/* Matches an attribute specification including array specs. If
successful, leaves the variables current_attr and current_as
holding the specification. Also sets the colon_seen variable for
......@@ -1449,7 +1242,7 @@ gfc_match_data_decl (void)
gfc_symbol *sym;
match m;
m = match_type_spec (&current_ts, 0);
m = gfc_match_type_spec (&current_ts, 1);
if (m != MATCH_YES)
return m;
......@@ -1539,7 +1332,7 @@ match_prefix (gfc_typespec * ts)
loop:
if (!seen_type && ts != NULL
&& match_type_spec (ts, 0) == MATCH_YES
&& gfc_match_type_spec (ts, 1) == MATCH_YES
&& gfc_match_space () == MATCH_YES)
{
......
gcc/fortran/match.c
......@@ -2048,6 +2048,204 @@ cleanup:
}
/* Match an IMPLICIT NONE statement. Actually, this statement is
already matched in parse.c, or we would not end up here in the
first place. So the only thing we need to check, is if there is
trailing garbage. If not, the match is successful. */
match
gfc_match_implicit_none (void)
{
return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO;
}
/* Match the letter range(s) of an IMPLICIT statement. */
static match
match_implicit_range (gfc_typespec * ts)
{
int c, c1, c2, inner;
locus cur_loc;
cur_loc = gfc_current_locus;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if (c != '(')
{
gfc_error ("Missing character range in IMPLICIT at %C");
goto bad;
}
inner = 1;
while (inner)
{
gfc_gobble_whitespace ();
c1 = gfc_next_char ();
if (!ISALPHA (c1))
goto bad;
gfc_gobble_whitespace ();
c = gfc_next_char ();
switch (c)
{
case ')':
inner = 0; /* Fall through */
case ',':
c2 = c1;
break;
case '-':
gfc_gobble_whitespace ();
c2 = gfc_next_char ();
if (!ISALPHA (c2))
goto bad;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c != ',') && (c != ')'))
goto bad;
if (c == ')')
inner = 0;
break;
default:
goto bad;
}
if (c1 > c2)
{
gfc_error ("Letters must be in alphabetic order in "
"IMPLICIT statement at %C");
goto bad;
}
/* See if we can add the newly matched range to the pending
implicits from this IMPLICIT statement. We do not check for
conflicts with whatever earlier IMPLICIT statements may have
set. This is done when we've successfully finished matching
the current one. */
if (gfc_add_new_implicit_range (c1, c2, ts) != SUCCESS)
goto bad;
}
return MATCH_YES;
bad:
gfc_syntax_error (ST_IMPLICIT);
gfc_current_locus = cur_loc;
return MATCH_ERROR;
}
/* Match an IMPLICIT statement, storing the types for
gfc_set_implicit() if the statement is accepted by the parser.
There is a strange looking, but legal syntactic construction
possible. It looks like:
IMPLICIT INTEGER (a-b) (c-d)
This is legal if "a-b" is a constant expression that happens to
equal one of the legal kinds for integers. The real problem
happens with an implicit specification that looks like:
IMPLICIT INTEGER (a-b)
In this case, a typespec matcher that is "greedy" (as most of the
matchers are) gobbles the character range as a kindspec, leaving
nothing left. We therefore have to go a bit more slowly in the
matching process by inhibiting the kindspec checking during
typespec matching and checking for a kind later. */
match
gfc_match_implicit (void)
{
gfc_typespec ts;
locus cur_loc;
int c;
match m;
/* We don't allow empty implicit statements. */
if (gfc_match_eos () == MATCH_YES)
{
gfc_error ("Empty IMPLICIT statement at %C");
return MATCH_ERROR;
}
/* First cleanup. */
gfc_clear_new_implicit ();
do
{
/* A basic type is mandatory here. */
m = gfc_match_type_spec (&ts, 0);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
cur_loc = gfc_current_locus;
m = match_implicit_range (&ts);
if (m == MATCH_YES)
{
/* Looks like we have the <TYPE> (<RANGE>). */
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c == '\n') || (c == ','))
continue;
gfc_current_locus = cur_loc;
}
/* Last chance -- check <TYPE> (<KIND>) (<RANGE>). */
m = gfc_match_kind_spec (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
{
m = gfc_match_old_kind_spec (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
}
m = match_implicit_range (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c != '\n') && (c != ','))
goto syntax;
}
while (c == ',');
/* All we need to now is try to merge the new implicit types back
into the existing types. This will fail if another implicit
type is already defined for a letter. */
return (gfc_merge_new_implicit () == SUCCESS) ?
MATCH_YES : MATCH_ERROR;
syntax:
gfc_syntax_error (ST_IMPLICIT);
error:
return MATCH_ERROR;
}
/* Given a name, return a pointer to the common head structure,
creating it if it does not exist.
TODO: Add to global symbol tree. */
......
gcc/fortran/match.h
......@@ -75,6 +75,8 @@ match gfc_match_deallocate (void);
match gfc_match_return (void);
match gfc_match_call (void);
match gfc_match_common (void);
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
match gfc_match_block_data (void);
match gfc_match_namelist (void);
match gfc_match_module (void);
......@@ -96,6 +98,7 @@ gfc_common_head *gfc_get_common (char *);
match gfc_match_null (gfc_expr **);
match gfc_match_kind_spec (gfc_typespec *);
match gfc_match_old_kind_spec (gfc_typespec *);
match gfc_match_type_spec (gfc_typespec *, int);
match gfc_match_end (gfc_statement *);
match gfc_match_data_decl (void);
......@@ -105,9 +108,6 @@ match gfc_match_entry (void);
match gfc_match_subroutine (void);
match gfc_match_derived_decl (void);
match gfc_match_implicit_none (void);
match gfc_match_implicit (void);
/* Matchers for attribute declarations */
match gfc_match_allocatable (void);
match gfc_match_dimension (void);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment