diff options
author | Tobias Burnus <burnus@net-b.de> | 2014-10-06 07:57:57 +0200 |
---|---|---|
committer | Tobias Burnus <burnus@gcc.gnu.org> | 2014-10-06 07:57:57 +0200 |
commit | 8b7a967ed4c20e00fc966e3d30a09fed74216dc7 (patch) | |
tree | 3fd948e1c22f57c5745797415d9f60822a38992e | |
parent | 116886341f638b539387bc900bc513ebe5ad6696 (diff) | |
download | gcc-8b7a967ed4c20e00fc966e3d30a09fed74216dc7.zip gcc-8b7a967ed4c20e00fc966e3d30a09fed74216dc7.tar.gz gcc-8b7a967ed4c20e00fc966e3d30a09fed74216dc7.tar.bz2 |
libgfortran.h (GFC_STD_F2015): Add.
2014-10-06 Tobias Burnus <burnus@net-b.de>
gcc/fortran/
* libgfortran.h (GFC_STD_F2015): Add.
* decl.c (gfc_match_implicit_none): Handle spec list.
(gfc_match_implicit): Move double intrinsic warning here.
* gfortran.h (gfc_namespace): Add has_implicit_none_export:1.
(gfc_set_implicit_none): Update interface.
* interface.c (gfc_procedure_use): Add implicit-none external
error check.
* parse.c (accept_statement): Remove call.
(verify_st_order): Permit that external-implict-none follows
implicit statement.
* symbol.c (gfc_set_implicit_none): Handle external/type
implicit none.
gcc/testsuite/
* gfortran.dg/implicit_14.f90: New.
* gfortran.dg/implicit_15.f90: New.
* gfortran.dg/implicit_4.f90: Update dg-error.
From-SVN: r215914
-rw-r--r-- | gcc/fortran/ChangeLog | 15 | ||||
-rw-r--r-- | gcc/fortran/decl.c | 52 | ||||
-rw-r--r-- | gcc/fortran/gfortran.h | 5 | ||||
-rw-r--r-- | gcc/fortran/interface.c | 8 | ||||
-rw-r--r-- | gcc/fortran/parse.c | 5 | ||||
-rw-r--r-- | gcc/fortran/symbol.c | 29 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_14.f90 | 8 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_15.f90 | 70 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/implicit_4.f90 | 6 |
10 files changed, 187 insertions, 17 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 03b3b66..5e6ad8e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2014-10-06 Tobias Burnus <burnus@net-b.de> + + * libgfortran.h (GFC_STD_F2015): Add. + * decl.c (gfc_match_implicit_none): Handle spec list. + (gfc_match_implicit): Move double intrinsic warning here. + * gfortran.h (gfc_namespace): Add has_implicit_none_export:1. + (gfc_set_implicit_none): Update interface. + * interface.c (gfc_procedure_use): Add implicit-none external + error check. + * parse.c (accept_statement): Remove call. + (verify_st_order): Permit that external-implict-none follows + implicit statement. + * symbol.c (gfc_set_implicit_none): Handle external/type + implicit none. + 2014-10-04 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> PR fortran/36534 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0e0364c..a089be4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2946,7 +2946,50 @@ get_kind: match gfc_match_implicit_none (void) { - return (gfc_match_eos () == MATCH_YES) ? MATCH_YES : MATCH_NO; + char c; + match m; + char name[GFC_MAX_SYMBOL_LEN + 1]; + bool type = false; + bool external = false; + + gfc_gobble_whitespace (); + c = gfc_peek_ascii_char (); + if (c == '(') + { + (void) gfc_next_ascii_char (); + if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C")) + return MATCH_ERROR; + 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; + + gfc_gobble_whitespace (); + c = gfc_next_ascii_char (); + if (c == ',') + continue; + if (c == ')') + break; + return MATCH_ERROR; + } + } + else + type = true; + + if (gfc_match_eos () != MATCH_YES) + return MATCH_ERROR; + + gfc_set_implicit_none (type, external); + + return MATCH_YES; } @@ -3062,6 +3105,13 @@ gfc_match_implicit (void) char c; match m; + if (gfc_current_ns->seen_implicit_none) + { + gfc_error ("IMPLICIT statement at %C following an IMPLICIT NONE (type) " + "statement"); + return MATCH_ERROR; + } + gfc_clear_ts (&ts); /* We don't allow empty implicit statements. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index f1c78cc..f6f95f8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1655,6 +1655,9 @@ typedef struct gfc_namespace /* Set to 1 if namespace is an interface body with "IMPORT" used. */ unsigned has_import_set:1; + /* Set to 1 if the namespace uses "IMPLICT NONE (export)". */ + unsigned has_implicit_none_export:1; + /* Set to 1 if resolved has been called for this namespace. Holds -1 during resolution. */ signed resolved:2; @@ -2754,7 +2757,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 (void); +void gfc_set_implicit_none (bool, bool); void gfc_check_function_type (gfc_namespace *); bool gfc_is_intrinsic_typename (const char *); diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index f6233b7..1eb09ac 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3252,8 +3252,14 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where) for calling a ISO_C_BINDING because c_loc and c_funloc are pseudo-unknown. Additionally, warn about procedures not explicitly declared at all if requested. */ - if (sym->attr.if_source == IFSRC_UNKNOWN && ! sym->attr.is_iso_c) + if (sym->attr.if_source == IFSRC_UNKNOWN && !sym->attr.is_iso_c) { + if (sym->ns->has_implicit_none_export && sym->attr.proc == PROC_UNKNOWN) + { + gfc_error ("Procedure '%s' called at %L is not explicitly declared", + sym->name, where); + return false; + } if (gfc_option.warn_implicit_interface) gfc_warning ("Procedure '%s' called with an implicit interface at %L", sym->name, where); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 9165061..4539beb 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -1950,9 +1950,6 @@ accept_statement (gfc_statement st) switch (st) { case ST_IMPLICIT_NONE: - gfc_set_implicit_none (); - break; - case ST_IMPLICIT: break; @@ -2142,7 +2139,7 @@ verify_st_order (st_state *p, gfc_statement st, bool silent) break; case ST_IMPLICIT_NONE: - if (p->state > ORDER_IMPLICIT_NONE) + if (p->state > ORDER_IMPLICIT) goto order; /* The '>' sign cannot be a '>=', because a FORMAT or ENTRY diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c index 8e1d8b3..0ccbd1f 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.c @@ -114,22 +114,34 @@ static int new_flag[GFC_LETTERS]; /* Handle a correctly parsed IMPLICIT NONE. */ void -gfc_set_implicit_none (void) +gfc_set_implicit_none (bool type, bool external) { int i; - if (gfc_current_ns->seen_implicit_none) + if (gfc_current_ns->seen_implicit_none + || gfc_current_ns->has_implicit_none_export) { - gfc_error ("Duplicate IMPLICIT NONE statement at %C"); + gfc_error_now ("Duplicate IMPLICIT NONE statement at %C"); return; } - gfc_current_ns->seen_implicit_none = 1; + if (external) + gfc_current_ns->has_implicit_none_export = 1; - for (i = 0; i < GFC_LETTERS; i++) + if (type) { - gfc_clear_ts (&gfc_current_ns->default_type[i]); - gfc_current_ns->set_flag[i] = 1; + gfc_current_ns->seen_implicit_none = 1; + for (i = 0; i < GFC_LETTERS; i++) + { + if (gfc_current_ns->set_flag[i]) + { + gfc_error_now ("IMPLICIT NONE (type) statement at %C following an " + "IMPLICIT statement"); + return; + } + gfc_clear_ts (&gfc_current_ns->default_type[i]); + gfc_current_ns->set_flag[i] = 1; + } } } @@ -2383,6 +2395,9 @@ gfc_get_namespace (gfc_namespace *parent, int parent_types) } } + if (parent_types && ns->parent != NULL) + ns->has_implicit_none_export = ns->parent->has_implicit_none_export; + ns->refs = 1; return ns; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bd7055c..2859377 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-10-06 Tobias Burnus <burnus@net-b.de> + + * gfortran.dg/implicit_14.f90: New. + * gfortran.dg/implicit_15.f90: New. + * gfortran.dg/implicit_4.f90: Update dg-error. + 2014-10-04 Jan Hubicka <hubicka@ucw.cz> * g++.dg/ipa/devirt-42.C: Update template. diff --git a/gcc/testsuite/gfortran.dg/implicit_14.f90 b/gcc/testsuite/gfortran.dg/implicit_14.f90 new file mode 100644 index 0000000..5b1a3b6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_14.f90 @@ -0,0 +1,8 @@ +! { dg-do compile } +! { dg-options "-std=f2008ts" } +! +! Support Fortran 2015's IMPLICIT NONE with spec list +! (currently implemented as vendor extension) + +implicit none (type) ! { dg-error "GNU Extension: IMPORT NONE with spec list at \\(1\\)" } +end diff --git a/gcc/testsuite/gfortran.dg/implicit_15.f90 b/gcc/testsuite/gfortran.dg/implicit_15.f90 new file mode 100644 index 0000000..02a5fef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implicit_15.f90 @@ -0,0 +1,70 @@ +! { dg-do compile } +! { dg-options "" } +! +! Support Fortran 2015's IMPLICIT NONE with spec list +! + +subroutine sub1 +implicit none (type) +call test() +i = 1 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" } +end subroutine sub1 + +subroutine sub2 +implicit none ( external ) +call foo() ! { dg-error "Procedure 'foo' called at .1. is not explicitly declared" } +i = 2 +end subroutine sub2 + +subroutine sub3 +implicit none ( external, type, external, type ) +call foo() ! { dg-error "Procedure 'foo' called at .1. is not explicitly declared" } +i = 3 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" } +end subroutine sub3 + +subroutine sub4 +implicit none ( external ,type) +external foo +call foo() +i = 4 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" } +end subroutine sub4 + +subroutine sub5 ! OK +implicit integer(a-z) +implicit none ( external ) +procedure() :: foo +call foo() +i = 5 +end subroutine sub5 + +subroutine sub6 ! OK +implicit none ( external ) +implicit integer(a-z) +procedure() :: foo +call foo() +i = 5 +end subroutine sub6 + +subroutine sub7 +implicit none ( external ) +implicit none ! { dg-error "Duplicate IMPLICIT NONE statement" } +end subroutine sub7 + +subroutine sub8 +implicit none +implicit none ( type ) ! { dg-error "Duplicate IMPLICIT NONE statement" } +end subroutine sub8 + +subroutine sub9 +implicit none ( external, type ) +implicit integer(a-z) ! { dg-error "IMPLICIT statement at .1. following an IMPLICIT NONE .type. statement" } +procedure() :: foo +call foo() +end subroutine sub9 + +subroutine sub10 +implicit integer(a-z) +implicit none ( external, type ) ! { dg-error "IMPLICIT NONE .type. statement at .1. following an IMPLICIT statement" } +procedure() :: foo +call foo() +end subroutine sub10 diff --git a/gcc/testsuite/gfortran.dg/implicit_4.f90 b/gcc/testsuite/gfortran.dg/implicit_4.f90 index 2e871b0..a5dc89a 100644 --- a/gcc/testsuite/gfortran.dg/implicit_4.f90 +++ b/gcc/testsuite/gfortran.dg/implicit_4.f90 @@ -5,13 +5,13 @@ IMPLICIT NONE ! { dg-error "Duplicate" } END SUBROUTINE a -IMPLICIT REAL(b-j) ! { dg-error "cannot follow" } -implicit none ! { dg-error "cannot follow" } +IMPLICIT REAL(b-j) +implicit none ! { dg-error "Type IMPLICIT NONE statement at .1. following an IMPLICIT statement" } END SUBROUTINE a subroutine b implicit none -implicit real(g-k) ! { dg-error "Cannot specify" } +implicit real(g-k) ! { dg-error "IMPLICIT statement at .1. following an IMPLICIT NONE .type. statement" } end subroutine b subroutine c |