This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] IMPLICIT fixes


Hi all,

this patch fixes Alan's issue with IMPLICIT followed by ";". I am not sure whether using the _eos machinery is really needed â especially as "!" seem to be already handled.

Additionally, I missed the inner "[...]" for the new:

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


Namely, "IMPLICIT NONE ()" is also valid - but was rejected before. As implicit-none-spec implies type,* that's now also handled. (* "An IMPLICIT statement specifies the mapping for the letters in its letter-spec-list. IMPLICIT NONE with an implicit-none-spec of TYPE or with no implicit-none-spec-list specifies the null mapping for all the letters.")

And finally, Dominque correctly observed that the location of some of the error messages was rather off, e.g. if there was a long comment following the actual statement. Hence, I have modified the code to provide a better error message.

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

Tobias
2014-10-09  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.

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))
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0809379..6f258db 100644
--- 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 0ccbd1f..3eb58f4 100644
--- 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/gfortran.dg/implicit_16.f90 b/gcc/testsuite/gfortran.dg/implicit_16.f90
new file mode 100644
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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]