gfortran.h (gfc_set_implicit_none): Update prototype.

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

gcc/fortran/
        * gfortran.h (gfc_set_implicit_none): Update prototype.
        * symbol.c (gfc_set_implicit_none): Take and
        use error location. Move diagnostic from here to ...
        * decl.c (gfc_match_implicit_none): ... here. And
        update call. Handle empty implicit-none-spec.
        (gfc_match_implicit): Handle statement-separator ";".

gcc/testsuite/
        * gfortran.dg/implicit_16.f90: New.

From-SVN: r216057

1 files changed, 42 insertions, 22 deletions

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a089be4..e4e41cb 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -2951,6 +2951,14 @@ gfc_match_implicit_none (void)
   char name[GFC_MAX_SYMBOL_LEN + 1];
   bool type = false;
   bool external = false;
+  locus cur_loc = gfc_current_locus;
+
+  if (gfc_current_ns->seen_implicit_none
+      || gfc_current_ns->has_implicit_none_export)
+    {
+      gfc_error ("Duplicate IMPLICIT NONE statement at %C");
+      return MATCH_ERROR;
+    }
 
   gfc_gobble_whitespace ();
   c = gfc_peek_ascii_char ();
@@ -2959,27 +2967,35 @@ gfc_match_implicit_none (void)
       (void) gfc_next_ascii_char ();
       if (!gfc_notify_std (GFC_STD_F2015, "IMPORT NONE with spec list at %C"))
 	return MATCH_ERROR;
-      for(;;)
+
+      gfc_gobble_whitespace ();
+      if (gfc_peek_ascii_char () == ')')
 	{
-	  m = gfc_match (" %n", name);
-          if (m != MATCH_YES)
-	    return MATCH_ERROR;
+	  (void) gfc_next_ascii_char ();
+	  type = true;
+	}
+      else
+	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;
+	    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;
-	}
+	    gfc_gobble_whitespace ();
+	    c = gfc_next_ascii_char ();
+	    if (c == ',')
+	      continue;
+	    if (c == ')')
+	      break;
+	    return MATCH_ERROR;
+	  }
     }
   else
     type = true;
@@ -2987,7 +3003,7 @@ gfc_match_implicit_none (void)
   if (gfc_match_eos () != MATCH_YES)
     return MATCH_ERROR;
 
-  gfc_set_implicit_none (type, external);
+  gfc_set_implicit_none (type, external, &cur_loc);
 
   return MATCH_YES;
 }
@@ -3140,8 +3156,8 @@ gfc_match_implicit (void)
 	{
 	  /* We may have <TYPE> (<RANGE>).  */
 	  gfc_gobble_whitespace ();
-	  c = gfc_next_ascii_char ();
-	  if ((c == '\n') || (c == ','))
+          c = gfc_peek_ascii_char ();
+	  if (c == ',' || c == '\n' || c == ';' || c == '!')
 	    {
 	      /* Check for CHARACTER with no length parameter.  */
 	      if (ts.type == BT_CHARACTER && !ts.u.cl)
@@ -3155,6 +3171,10 @@ gfc_match_implicit (void)
 	      /* Record the Successful match.  */
 	      if (!gfc_merge_new_implicit (&ts))
 		return MATCH_ERROR;
+	      if (c == ',')
+		c = gfc_next_ascii_char ();
+	      else if (gfc_match_eos () == MATCH_ERROR)
+		goto error;
 	      continue;
 	    }
 
@@ -3190,7 +3210,7 @@ gfc_match_implicit (void)
 
       gfc_gobble_whitespace ();
       c = gfc_next_ascii_char ();
-      if ((c != '\n') && (c != ','))
+      if (c != ',' && gfc_match_eos () != MATCH_YES)
 	goto syntax;
 
       if (!gfc_merge_new_implicit (&ts))