From 8b7a967ed4c20e00fc966e3d30a09fed74216dc7 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 6 Oct 2014 07:57:57 +0200 Subject: [PATCH] libgfortran.h (GFC_STD_F2015): Add. 2014-10-06 Tobias Burnus 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 --- gcc/fortran/ChangeLog | 15 +++++ gcc/fortran/decl.c | 52 ++++++++++++++++- gcc/fortran/gfortran.h | 5 +- gcc/fortran/interface.c | 8 ++- gcc/fortran/parse.c | 5 +- gcc/fortran/symbol.c | 29 +++++++--- gcc/testsuite/ChangeLog | 6 ++ gcc/testsuite/gfortran.dg/implicit_14.f90 | 8 +++ gcc/testsuite/gfortran.dg/implicit_15.f90 | 70 +++++++++++++++++++++++ gcc/testsuite/gfortran.dg/implicit_4.f90 | 6 +- 10 files changed, 187 insertions(+), 17 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/implicit_14.f90 create mode 100644 gcc/testsuite/gfortran.dg/implicit_15.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 03b3b66a8dd..5e6ad8e48e4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +2014-10-06 Tobias Burnus + + * 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 PR fortran/36534 diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 0e0364cb54e..a089be48128 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 f1c78cc810e..f6f95f8b840 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 f6233b77b37..1eb09ac250d 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 91650614ada..4539beb19a2 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 8e1d8b3b408..0ccbd1f204c 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 bd7055c5372..28593775481 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2014-10-06 Tobias Burnus + + * 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 * 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 00000000000..5b1a3b6cd4d --- /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 00000000000..02a5fefbda6 --- /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 2e871b09d89..a5dc89a4e91 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 -- 2.30.2