Skip to content
Projects
Groups
Snippets
Help
This project
Loading...
Sign in / Register
Toggle navigation
R
riscv-gcc-1
Overview
Overview
Details
Activity
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
lvzhengyang
riscv-gcc-1
Commits
439251f7
Commit
439251f7
authored
Jun 29, 2004
by
Tobias Schlüter
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Revert previous accidental commit.
From-SVN: r83875
parent
fbc9b453
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
with
209 additions
and
218 deletions
+209
-218
gcc/fortran/decl.c
+8
-215
gcc/fortran/match.c
+198
-0
gcc/fortran/match.h
+3
-3
No files found.
gcc/fortran/decl.c
View file @
439251f7
...
...
@@ -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
View file @
439251f7
...
...
@@ -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
View file @
439251f7
...
...
@@ -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
);
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment