[Fortran, Patch] Implement IMPLICIT NONE

[Tobias Burnus <burnus at net-b dot de>]

I don't want to implement Fortran 90's implicit none, which is of course 
already supported. However, I would like to implement as vendor extension:

  IMPLICIT NONE (external)

which forces at that least an "external" or "procedure" is used or an 
explicit interface available, if one tries to invoke a procedure. 
Background for the change is my recent bug:
   internal co_broadcast
   call co_broadcasr(...)

While I have implemented is as vendor extension (-std=gnu), of course, 
the syntax doesn't come out of the blue but is in the current Fortran 
2015 draft (14-007r2):

R563 implicit-stmt  is  IMPLICIT implicit-spec-list
                    or  IMPLICIT NONE [ ( [ implicit-none-spec-list ] ) ]
R566 implicit-none-spec  is  EXTERNAL
                         or  TYPE


Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias

2014-10-02  Tobias Burnus  <burnus@net-b.de>

gcc/fortran/
	* 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.

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 0e0364c..bbf35ce 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 a type IMPLICIT NONE "
+		 "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..3f17152 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 ("Type IMPLICIT NONE 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/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..7924b42
--- /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 a type IMPLICIT NONE statement" }
+procedure() :: foo
+call foo()
+end subroutine sub9
+
+subroutine sub10
+implicit integer(a-z)
+implicit none ( external, type ) ! { dg-error "Type IMPLICIT NONE 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..9bf8d86 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 a type IMPLICIT NONE statement" }
 end subroutine b
 
 subroutine c