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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 03b3b66a8dd50a08defa2c2ff442710d3550de1e..5e6ad8e48e4762ab261854b489d182236d2bc872 100644 (file)
--- 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 0e0364cb54eb9e00eb4d6bb43afaedcbff1165d5..a089be481289a22c0a16e1ae7ef164b2a0f71f4c 100644 (file)
--- 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 f1c78cc810e2b99a4ca5765482de2fd38a9232da..f6f95f8b8403a40ed61417202dd49ca97196704a 100644 (file)
--- 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 f6233b77b3785016eabd4e2de4c07d60e57d8268..1eb09ac250da8c195634c1abc610f7afea296d8d 100644 (file)
--- 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 91650614adafbfadbc598cc381a5beefab149f04..4539beb19a2c88eb1a20c32a4702b50a3a2abc27 100644 (file)
--- 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 8e1d8b3b408c69b9ae44d4c2162a4b0e073f6bbf..0ccbd1f204cf010047cc1ac5234565f3f3f1c08b 100644 (file)
--- 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 bd7055c53729365f3368fad348e756885d889d4f..2859377548127ff6e8ef55caeefc1ebb53ca75ce 100644 (file)
--- 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 (file)
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 (file)
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 2e871b09d89aa555302f193199bb1d2adee18c04..a5dc89a4e9175ce2a325ec43abe5b58bbf9e9eee 100644 (file)
--- 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