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

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

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

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 *);
 

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);

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

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;

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.

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

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

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