OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gfc_match_implicit_range): Don't use typespec.

Browse Source 
* decl.c (gfc_match_implicit_range): Don't use typespec.
	(gfc_match_implicit): Handle character selectors.
	* gfortran.h (gfc_set_implicit): Remove prototype.
	(gfc_add_new_implicit_range, gfc_merge_new_implicit): Update.
	* parse.c (accept_statement): Don't call gfc_set_implicit.
	* symbol.c (new_ts): Remove.
	(gfc_set_implicit_none): Use same loop bounds as other functions.
	(gfc_set_implicit): Remove.
	(gfc_clear_new_implicit, gfc_add_new_implicit_range): Only set flags.
	(gfc_merge_new_implicit): Combine with gfc_set_implicit.
testsuite/
	* gfortran.fortran-torture/compile/implicit_1.f90: New test.

From-SVN: r84063
This commit is contained in:
Paul Brook 2004-07-03 23:25:46 +00:00
parent 614ed70a59
commit 1107b970c6
7 changed files with 127 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View File

@ -1,3 +1,16 @@
2004-07-04 Paul Brook <paul@codesourcery.com>
* decl.c (gfc_match_implicit_range): Don't use typespec.
(gfc_match_implicit): Handle character selectors.
* gfortran.h (gfc_set_implicit): Remove prototype.
(gfc_add_new_implicit_range, gfc_merge_new_implicit): Update.
* parse.c (accept_statement): Don't call gfc_set_implicit.
* symbol.c (new_ts): Remove.
(gfc_set_implicit_none): Use same loop bounds as other functions.
(gfc_set_implicit): Remove.
(gfc_clear_new_implicit, gfc_add_new_implicit_range): Only set flags.
(gfc_merge_new_implicit): Combine with gfc_set_implicit.
2004-06-30 Richard Henderson <rth@redhat.com>
* match.c (var_element): Remove unused variable.

75
gcc/fortran/decl.c
View File

@ -1001,7 +1001,7 @@ gfc_match_implicit_none (void)
/* Match the letter range(s) of an IMPLICIT statement. */
static match
match_implicit_range (gfc_typespec * ts)
match_implicit_range (void)
{
int c, c1, c2, inner;
locus cur_loc;
@ -1068,7 +1068,7 @@ match_implicit_range (gfc_typespec * ts)
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)
if (gfc_add_new_implicit_range (c1, c2) != SUCCESS)
goto bad;
}
@ -1116,11 +1116,11 @@ gfc_match_implicit (void)
return MATCH_ERROR;
}
/* First cleanup. */
gfc_clear_new_implicit ();
do
{
/* First cleanup. */
gfc_clear_new_implicit ();
/* A basic type is mandatory here. */
m = match_type_spec (&ts, 1);
if (m == MATCH_ERROR)
@ -1129,39 +1129,56 @@ gfc_match_implicit (void)
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);
}
m = match_implicit_range ();
if (m == MATCH_YES)
{
/* Looks like we have the <TYPE> (<RANGE>). */
/* We may have <TYPE> (<RANGE>). */
gfc_gobble_whitespace ();
c = gfc_next_char ();
if ((c == '\n') || (c == ','))
continue;
{
/* Check for CHARACTER with no length parameter. */
if (ts.type == BT_CHARACTER && !ts.cl)
{
ts.kind = gfc_default_character_kind ();
ts.cl = gfc_get_charlen ();
ts.cl->next = gfc_current_ns->cl_list;
gfc_current_ns->cl_list = ts.cl;
ts.cl->length = gfc_int_expr (1);
}
/* Record the Successful match. */
if (gfc_merge_new_implicit (&ts) != SUCCESS)
return MATCH_ERROR;
continue;
}
gfc_current_locus = cur_loc;
}
/* Last chance -- check <TYPE> (<KIND>) (<RANGE>). */
m = gfc_match_kind_spec (&ts);
/* Discard the (incorrectly) matched range. */
gfc_clear_new_implicit ();
/* Last chance -- check <TYPE> <SELECTOR> (<RANGE>). */
if (ts.type == BT_CHARACTER)
m = match_char_spec (&ts);
else
{
m = gfc_match_kind_spec (&ts);
if (m == MATCH_NO)
{
m = gfc_match_old_kind_spec (&ts);
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
goto syntax;
}
}
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);
m = match_implicit_range ();
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
@ -1172,14 +1189,12 @@ gfc_match_implicit (void)
if ((c != '\n') && (c != ','))
goto syntax;
if (gfc_merge_new_implicit (&ts) != SUCCESS)
return MATCH_ERROR;
}
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;
return MATCH_YES;
syntax:
gfc_syntax_error (ST_IMPLICIT);

5
gcc/fortran/gfortran.h
View File

@ -1435,10 +1435,9 @@ extern int gfc_index_integer_kind;
/* symbol.c */
void gfc_clear_new_implicit (void);
try gfc_add_new_implicit_range (int, int, gfc_typespec *);
try gfc_merge_new_implicit (void);
try gfc_add_new_implicit_range (int, int);
try gfc_merge_new_implicit (gfc_typespec *);
void gfc_set_implicit_none (void);
void gfc_set_implicit (void);
gfc_typespec *gfc_get_default_type (gfc_symbol *, gfc_namespace *);
try gfc_set_default_type (gfc_symbol *, int, gfc_namespace *);

1
gcc/fortran/parse.c
View File

@ -1019,7 +1019,6 @@ accept_statement (gfc_statement st)
break;
case ST_IMPLICIT:
gfc_set_implicit ();
break;
case ST_FUNCTION:

75
gcc/fortran/symbol.c
View File

@ -96,13 +96,9 @@ static gfc_symbol *changed_syms = NULL;
/*********** IMPLICIT NONE and IMPLICIT statement handlers ***********/
/* The following static variables hold the default types set by
IMPLICIT statements. We have to store kind information because of
IMPLICIT DOUBLE PRECISION statements. IMPLICIT NONE stores a
BT_UNKNOWN into all elements. The arrays of flags indicate whether
a particular element has been explicitly set or not. */
/* The following static variable indicates whether a particular element has
been explicitly set or not. */
static gfc_typespec new_ts[GFC_LETTERS];
static int new_flag[GFC_LETTERS];
@ -113,48 +109,30 @@ gfc_set_implicit_none (void)
{
int i;
for (i = 'a'; i <= 'z'; i++)
for (i = 0; i < GFC_LETTERS; i++)
{
gfc_clear_ts (&gfc_current_ns->default_type[i - 'a']);
gfc_current_ns->set_flag[i - 'a'] = 1;
gfc_clear_ts (&gfc_current_ns->default_type[i]);
gfc_current_ns->set_flag[i] = 1;
}
}
/* Sets the implicit types parsed by gfc_match_implicit(). */
/* Reset the implicit range flags. */
void
gfc_set_implicit (void)
gfc_clear_new_implicit (void)
{
int i;
for (i = 0; i < GFC_LETTERS; i++)
if (new_flag[i])
{
gfc_current_ns->default_type[i] = new_ts[i];
gfc_current_ns->set_flag[i] = 1;
}
new_flag[i] = 0;
}
/* Wipe anything a previous IMPLICIT statement may have tried to do. */
void gfc_clear_new_implicit (void)
{
int i;
/* Prepare for a new implicit range. Sets flags in new_flag[]. */
for (i = 0; i < GFC_LETTERS; i++)
{
gfc_clear_ts (&new_ts[i]);
if (new_flag[i])
new_flag[i] = 0;
}
}
/* Prepare for a new implicit range. Sets flags in new_flag[] and
copies the typespec to new_ts[]. */
try gfc_add_new_implicit_range (int c1, int c2, gfc_typespec * ts)
try
gfc_add_new_implicit_range (int c1, int c2)
{
int i;
@ -170,7 +148,6 @@ try gfc_add_new_implicit_range (int c1, int c2, gfc_typespec * ts)
return FAILURE;
}
new_ts[i] = *ts;
new_flag[i] = 1;
}
@ -178,27 +155,29 @@ try gfc_add_new_implicit_range (int c1, int c2, gfc_typespec * ts)
}
/* Add a matched implicit range for gfc_set_implicit(). An implicit
statement has been fully matched at this point. We now need to
check if merging the new implicit types back into the existing
types will work. */
/* Add a matched implicit range for gfc_set_implicit(). Check if merging
the new implicit types back into the existing types will work. */
try
gfc_merge_new_implicit (void)
gfc_merge_new_implicit (gfc_typespec * ts)
{
int i;
for (i = 0; i < GFC_LETTERS; i++)
if (new_flag[i])
{
if (gfc_current_ns->set_flag[i])
{
gfc_error ("Letter %c already has an IMPLICIT type at %C",
i + 'A');
return FAILURE;
}
}
{
if (new_flag[i])
{
if (gfc_current_ns->set_flag[i])
{
gfc_error ("Letter %c already has an IMPLICIT type at %C",
i + 'A');
return FAILURE;
}
gfc_current_ns->default_type[i] = *ts;
gfc_current_ns->set_flag[i] = 1;
}
}
return SUCCESS;
}

12
gcc/testsuite/ChangeLog
View File

@ -1,7 +1,11 @@
2004-07-03 Scott Brumbaugh <scottb.lists@verizon.net>
PR c++/3761
* g++.dg/lookup/crash4.C: New test.
2004-07-04 Paul Brook <paul@codesourcery.com>
* gfortran.fortran-torture/compile/implicit_1.f90: New test.
2004-07-03 Scott Brumbaugh <scottb.lists@verizon.net>
PR c++/3761
* g++.dg/lookup/crash4.C: New test.
2004-07-02 Zack Weinberg <zack@codesourcery.com>

32
gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 Normal file
View File

@ -0,0 +1,32 @@
! Test implicit character declarations.
! This requires some coordination between the typespec and variable name range
! matchers to get it right.
module implicit_1
integer, parameter :: x = 10
integer, parameter :: y = 6
integer, parameter :: z = selected_int_kind(4)
end module
subroutine foo(n)
use implicit_1
! Test various combinations with and without character length
! and type kind specifiers
implicit character(len=5) (a)
implicit character(n) (b)
implicit character*6 (c-d)
implicit character (e)
implicit character(x-y) (f)
implicit integer(z) (g)
implicit character (z)
a1 = 'Hello'
b1 = 'world'
c1 = 'wibble'
d1 = 'hmmm'
e1 = 'n'
f1 = 'test'
g1 = 1
x1 = 1.0
y1 = 2.0
z1 = 'A'
end