From 1107b970c6701a65fbf0e74ad6dbfe329a580352 Mon Sep 17 00:00:00 2001 From: Paul Brook Date: Sat, 3 Jul 2004 23:25:46 +0000 Subject: [PATCH] decl.c (gfc_match_implicit_range): Don't use typespec. * 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 --- gcc/fortran/ChangeLog | 13 ++++ gcc/fortran/decl.c | 73 +++++++++++------- gcc/fortran/gfortran.h | 5 +- gcc/fortran/parse.c | 1 - gcc/fortran/symbol.c | 75 +++++++------------ gcc/testsuite/ChangeLog | 12 ++- .../compile/implicit_1.f90 | 32 ++++++++ 7 files changed, 126 insertions(+), 85 deletions(-) create mode 100644 gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 89a15bd894e..a477814081b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2004-07-04 Paul Brook + + * 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 * match.c (var_element): Remove unused variable. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5c5b7281115..94573ac9df5 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -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 () () */ - m = match_char_spec (&ts); - } + m = match_implicit_range (); if (m == MATCH_YES) { - /* Looks like we have the (). */ + /* We may have (). */ 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 () (). */ - 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 (). */ + 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) @@ -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); diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index d35506ae6e6..86113ad0495 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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 *); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 3f9ca813c65..15a53ea3e45 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1019,7 +1019,6 @@ accept_statement (gfc_statement st) break; case ST_IMPLICIT: - gfc_set_implicit (); break; case ST_FUNCTION: diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 8887741b27e..9208d2205d9 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -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) -{ - 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; @@ -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; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index cc8bd6e0c4a..1ca7e1a0a1f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,7 +1,11 @@ -2004-07-03 Scott Brumbaugh - - PR c++/3761 - * g++.dg/lookup/crash4.C: New test. +2004-07-04 Paul Brook + + * gfortran.fortran-torture/compile/implicit_1.f90: New test. + +2004-07-03 Scott Brumbaugh + + PR c++/3761 + * g++.dg/lookup/crash4.C: New test. 2004-07-02 Zack Weinberg diff --git a/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 b/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 new file mode 100644 index 00000000000..f56bd63b462 --- /dev/null +++ b/gcc/testsuite/gfortran.fortran-torture/compile/implicit_1.f90 @@ -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 + -- 2.30.2