diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 64 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/symbol.c | 13 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_16.f90 | 40 |
6 files changed, 99 insertions, 33 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 68f47d4..907e32a 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2014-10-10 Tobias Burnus <burnus@net-b.de> + + * gfortran.h (gfc_set_implicit_none): Update prototype. + * symbol.c (gfc_set_implicit_none): Take and + use error location. Move diagnostic from here to ... + * decl.c (gfc_match_implicit_none): ... here. And + update call. Handle empty implicit-none-spec. + (gfc_match_implicit): Handle statement-separator ";". + 2014-10-09 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> * f95-lang.c (gfc_init_builtin_functions): Add more floating-point diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index a089be4..e4e41cb 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2951,6 +2951,14 @@ gfc_match_implicit_none (void) char name[GFC_MAX_SYMBOL_LEN + 1]; bool type = false; bool external = false; + locus cur_loc = gfc_current_locus; + + if (gfc_current_ns->seen_implicit_none + || gfc_current_ns->has_implicit_none_export) + { + gfc_error ("Duplicate IMPLICIT NONE statement at %C"); + return MATCH_ERROR; + } gfc_gobble_whitespace (); c = gfc_peek_ascii_char (); @@ -2959,27 +2967,35 @@ gfc_match_implicit_none (void) (void) gfc_next_ascii_char (); if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C")) return MATCH_ERROR; - for(;;) + + gfc_gobble_whitespace (); + if (gfc_peek_ascii_char () == ')') { - m = gfc_match (" %n", name); - if (m != MATCH_YES) - return MATCH_ERROR; + (void) gfc_next_ascii_char (); + type = true; + } + else + for(;;) + { + m = gfc_match (" %n", name); + if (m != MATCH_YES) + return MATCH_ERROR; - if (strcmp (name, "type") == 0) - type = true; - else if (strcmp (name, "external") == 0) - external = true; - else - return MATCH_ERROR; + if (strcmp (name, "type") == 0) + type = true; + else if (strcmp (name, "external") == 0) + external = true; + else + return MATCH_ERROR; - gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if (c == ',') - continue; - if (c == ')') - break; - return MATCH_ERROR; - } + gfc_gobble_whitespace (); + c = gfc_next_ascii_char (); + if (c == ',') + continue; + if (c == ')') + break; + return MATCH_ERROR; + } } else type = true; @@ -2987,7 +3003,7 @@ gfc_match_implicit_none (void) if (gfc_match_eos () != MATCH_YES) return MATCH_ERROR; - gfc_set_implicit_none (type, external); + gfc_set_implicit_none (type, external, &cur_loc); return MATCH_YES; } @@ -3140,8 +3156,8 @@ gfc_match_implicit (void) { /* We may have <TYPE> (<RANGE>). */ gfc_gobble_whitespace (); - c = gfc_next_ascii_char (); - if ((c == '\n') || (c == ',')) + c = gfc_peek_ascii_char (); + if (c == ',' || c == '\n' || c == ';' || c == '!') { /* Check for CHARACTER with no length parameter. */ if (ts.type == BT_CHARACTER && !ts.u.cl) @@ -3155,6 +3171,10 @@ gfc_match_implicit (void) /* Record the Successful match. */ if (!gfc_merge_new_implicit (&ts)) return MATCH_ERROR; + if (c == ',') + c = gfc_next_ascii_char (); + else if (gfc_match_eos () == MATCH_ERROR) + goto error; continue; } @@ -3190,7 +3210,7 @@ gfc_match_implicit (void) gfc_gobble_whitespace (); c = gfc_next_ascii_char (); - if ((c != '\n') && (c != ',')) + if (c != ',' && gfc_match_eos () != MATCH_YES) goto syntax; if (!gfc_merge_new_implicit (&ts)) diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 0809379..6f258db 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -2759,7 +2759,7 @@ extern int gfc_character_storage_size; void gfc_clear_new_implicit (void); bool gfc_add_new_implicit_range (int, int); bool gfc_merge_new_implicit (gfc_typespec *); -void gfc_set_implicit_none (bool, bool); +void gfc_set_implicit_none (bool, bool, locus *); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 0ccbd1f..3eb58f4 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -114,17 +114,10 @@ static int new_flag[GFC_LETTERS]; /* Handle a correctly parsed IMPLICIT NONE. */ void -gfc_set_implicit_none (bool type, bool external) +gfc_set_implicit_none (bool type, bool external, locus *loc) { int i; - if (gfc_current_ns->seen_implicit_none - || gfc_current_ns->has_implicit_none_export) - { - gfc_error_now ("Duplicate IMPLICIT NONE statement at %C"); - return; - } - if (external) gfc_current_ns->has_implicit_none_export = 1; @@ -135,8 +128,8 @@ gfc_set_implicit_none (bool type, bool external) { if (gfc_current_ns->set_flag[i]) { - gfc_error_now ("IMPLICIT NONE (type) statement at %C following an " - "IMPLICIT statement"); + gfc_error_now ("IMPLICIT NONE (type) statement at %L following an " + "IMPLICIT statement", loc); return; } gfc_clear_ts (&gfc_current_ns->default_type[i]); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0fb4c9e..13a553e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2014-10-10 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/implicit_16.f90: New. + 2014-10-09 Paolo Carlini <paolo.carlini@oracle.com> * g++.dg/cpp0x/constexpr-using3.C: New. diff --git a/gcc/testsuite/gfortran.dg/implicit_16.f90 b/gcc/testsuite/gfortran.dg/implicit_16.f90 new file mode 100644 index 0000000..b44be67 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_16.f90 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "" } +! +! Support Fortran 2015's IMPLICIT NONE with empty spec list +! +! And IMPLICIT with ";" followed by an additional statement. +! Contributed by Alan Greynolds +! + +module m + type t + end type t +end module m + +subroutine sub0 +implicit integer (a-h,o-z); parameter (i=0) +end subroutine sub0 + +subroutine sub1 +implicit integer (a-h,o-z)!test +parameter (i=0) +end subroutine sub1 + +subroutine sub2 +use m +implicit type(t) (a-h,o-z); parameter (i=0) +end subroutine sub2 + + +subroutine sub3 +use m +implicit type(t) (a-h,o-z)! Foobar +parameter (i=0) +end subroutine sub3 + +subroutine sub4 +implicit none () +call test() +i = 1 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" } +end subroutine sub4 |