* 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
+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.
/* 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;
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;
}
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)
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);
- if (m == MATCH_ERROR)
- goto error;
- if (m == MATCH_NO)
+ /* 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_old_kind_spec (&ts);
- if (m == MATCH_ERROR)
- goto error;
+ m = gfc_match_kind_spec (&ts);
if (m == MATCH_NO)
- goto syntax;
+ {
+ 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;
- m = match_implicit_range (&ts);
+ m = match_implicit_range ();
if (m == MATCH_ERROR)
goto error;
if (m == MATCH_NO)
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);
/* 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 *);
break;
case ST_IMPLICIT:
- gfc_set_implicit ();
break;
case ST_FUNCTION:
/*********** 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];
{
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)
-{
- 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;
- }
-}
-
-
-/* Wipe anything a previous IMPLICIT statement may have tried to do. */
-void gfc_clear_new_implicit (void)
+gfc_clear_new_implicit (void)
{
int i;
for (i = 0; i < GFC_LETTERS; i++)
- {
- gfc_clear_ts (&new_ts[i]);
- if (new_flag[i])
- new_flag[i] = 0;
- }
+ new_flag[i] = 0;
}
-/* Prepare for a new implicit range. Sets flags in new_flag[] and
- copies the typespec to new_ts[]. */
+/* Prepare for a new implicit range. Sets flags in new_flag[]. */
-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;
return FAILURE;
}
- new_ts[i] = *ts;
new_flag[i] = 1;
}
}
-/* 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;
}
-2004-07-03 Scott Brumbaugh <scottb.lists@verizon.net>\r
-\r
- PR c++/3761\r
- * g++.dg/lookup/crash4.C: New test.\r
+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>
--- /dev/null
+! 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
+
projects / gcc.git / commitdiff