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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 68f47d4bbba0eb9847bbbf98b936607b2f137295..907e32a7cbcecf8e2b4e559b1db3eb3b075df5f1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2014-10-10  Tobias Burnus  <burnus@net-b.de>
+
+       * 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 ";".
+
 2014-10-09  Francois-Xavier Coudert  <fxcoudert@gcc.gnu.org>
 
        * f95-lang.c (gfc_init_builtin_functions): Add more floating-point

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index a089be481289a22c0a16e1ae7ef164b2a0f71f4c..e4e41cbe0c1f1eeef4bc9ffbf0706b1ad592d86a 100644 (file)
--- 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))

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0809379205beefda9b08cea84b27c52a68e45c7d..6f258db961fb471c23f6b4fda5547f9a0e7be935 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2759,7 +2759,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 (bool, bool);
+void gfc_set_implicit_none (bool, bool, locus *);
 void gfc_check_function_type (gfc_namespace *);
 bool gfc_is_intrinsic_typename (const char *);
 

diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 0ccbd1f204cf010047cc1ac5234565f3f3f1c08b..3eb58f4c8f429a0a08d50d5aa610bf7f4175aeaa 100644 (file)
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -114,17 +114,10 @@ static int new_flag[GFC_LETTERS];
 /* Handle a correctly parsed IMPLICIT NONE.  */
 
 void
-gfc_set_implicit_none (bool type, bool external)
+gfc_set_implicit_none (bool type, bool external, locus *loc)
 {
   int i;
 
-  if (gfc_current_ns->seen_implicit_none
-      || gfc_current_ns->has_implicit_none_export)
-    {
-      gfc_error_now ("Duplicate IMPLICIT NONE statement at %C");
-      return;
-    }
-
   if (external)
     gfc_current_ns->has_implicit_none_export = 1;
 
@@ -135,8 +128,8 @@ gfc_set_implicit_none (bool type, bool external)
        {
          if (gfc_current_ns->set_flag[i])
            {
-             gfc_error_now ("IMPLICIT NONE (type) statement at %C following an "
-                            "IMPLICIT statement");
+             gfc_error_now ("IMPLICIT NONE (type) statement at %L following an "
+                            "IMPLICIT statement", loc);
              return;
            }
          gfc_clear_ts (&gfc_current_ns->default_type[i]);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0fb4c9edef5f90aa4f7c502474c3124371ce3acb..13a553e9ba650a35946669a99d1fd614f814ee7b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2014-10-10  Tobias Burnus  <burnus@net-b.de>
+
+       * gfortran.dg/implicit_16.f90: New.
+
 2014-10-09  Paolo Carlini  <paolo.carlini@oracle.com>
 
        * g++.dg/cpp0x/constexpr-using3.C: New.

diff --git a/gcc/testsuite/gfortran.dg/implicit_16.f90 b/gcc/testsuite/gfortran.dg/implicit_16.f90
new file mode 100644 (file)
index 0000000..b44be67
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/implicit_16.f90
@@ -0,0 +1,40 @@
+! { dg-do compile }
+! { dg-options "" }
+!
+! Support Fortran 2015's IMPLICIT NONE with empty spec list
+!
+! And IMPLICIT with ";" followed by an additional statement.
+! Contributed by Alan Greynolds
+!
+
+module m
+  type t
+  end type t
+end module m
+
+subroutine sub0
+implicit integer (a-h,o-z); parameter (i=0)
+end subroutine sub0
+
+subroutine sub1
+implicit integer (a-h,o-z)!test
+parameter (i=0)
+end subroutine sub1
+
+subroutine sub2
+use m
+implicit type(t) (a-h,o-z); parameter (i=0)
+end subroutine sub2
+
+
+subroutine sub3
+use m
+implicit type(t) (a-h,o-z)! Foobar
+parameter (i=0)
+end subroutine sub3
+
+subroutine sub4
+implicit none ()
+call test()
+i = 1 ! { dg-error "Symbol 'i' at .1. has no IMPLICIT type" }
+end subroutine sub4