re PR fortran/78226 (Fill out location information everywhere)

2016-12-10  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/78226
	* error.c (gfc_warning_internal):  New function.
	* frontend-passes.c (gfc_run_passes):  Call check_locus if
	CHECKING_P is defined.
	(check_locus_code):  New function.
	(check_locus_expr):  New function.
	(check_locus):  New function.
	* gfortran.h:  Add prototype for gfc_warning_internal.

From-SVN: r243520

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 42e0d61682af77c7cae5926b347a78c86c95e0db..1597a89e1f4b0d517230a4bebfcc7a9bfae37ba6 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2016-12-10  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/78226
+       * error.c (gfc_warning_internal):  New function.
+       * frontend-passes.c (gfc_run_passes):  Call check_locus if
+       CHECKING_P is defined.
+       (check_locus_code):  New function.
+       (check_locus_expr):  New function.
+       (check_locus):  New function.
+       * gfortran.h:  Add prototype for gfc_warning_internal.
+
 2016-12-10 Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/78350

diff --git a/gcc/fortran/error.c b/gcc/fortran/error.c
index 757f7e295a1fe84432fa05af7351295b6592db0e..dcd9647dac6832d395c0e4e4e2e8c9368c244742 100644 (file)
--- a/gcc/fortran/error.c
+++ b/gcc/fortran/error.c
@@ -1160,6 +1160,24 @@ gfc_warning_now (int opt, const char *gmsgid, ...)
   return ret;
 }
 
+/* Internal warning, do not buffer.  */
+
+bool
+gfc_warning_internal (int opt, const char *gmsgid, ...)
+{
+  va_list argp;
+  diagnostic_info diagnostic;
+  rich_location rich_loc (line_table, UNKNOWN_LOCATION);
+  bool ret;
+
+  va_start (argp, gmsgid);
+  diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc,
+                      DK_WARNING);
+  diagnostic.option_index = opt;
+  ret = report_diagnostic (&diagnostic);
+  va_end (argp);
+  return ret;
+}
 
 /* Immediate error (i.e. do not buffer).  */
 

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 44d2a4218b7efc19ffb75d027e89882320dcfd90..82812f883ed5fb0f810a639ec956a995756c9549 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -48,6 +48,10 @@ static gfc_code * create_do_loop (gfc_expr *, gfc_expr *, gfc_expr *,
                                  locus *, gfc_namespace *,
                                  char *vname=NULL);
 
+#ifdef CHECKING_P
+static void check_locus (gfc_namespace *);
+#endif
+
 /* How deep we are inside an argument list.  */
 
 static int count_arglist;
@@ -127,6 +131,10 @@ gfc_run_passes (gfc_namespace *ns)
   doloop_list.release ();
   int w, e;
 
+#ifdef CHECKING_P
+  check_locus (ns);
+#endif
+
   if (flag_frontend_optimize)
     {
       optimize_namespace (ns);
@@ -145,6 +153,53 @@ gfc_run_passes (gfc_namespace *ns)
     realloc_strings (ns);
 }
 
+#ifdef CHECKING_P
+
+/* Callback function: Warn if there is no location information in a
+   statement.  */
+
+static int
+check_locus_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+                 void *data ATTRIBUTE_UNUSED)
+{
+  current_code = c;
+  if (c && *c && (((*c)->loc.nextc == NULL) || ((*c)->loc.lb == NULL)))
+    gfc_warning_internal (0, "No location in statement");
+
+  return 0;
+}
+
+
+/* Callback function: Warn if there is no location information in an
+   expression.  */
+
+static int
+check_locus_expr (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+                 void *data ATTRIBUTE_UNUSED)
+{
+
+  if (e && *e && (((*e)->where.nextc == NULL || (*e)->where.lb == NULL)))
+    gfc_warning_internal (0, "No location in expression near %L",
+                         &((*current_code)->loc));
+  return 0;
+}
+
+/* Run check for missing location information.  */
+
+static void
+check_locus (gfc_namespace *ns)
+{
+  gfc_code_walker (&ns->code, check_locus_code, check_locus_expr, NULL);
+
+  for (ns = ns->contained; ns; ns = ns->sibling)
+    {
+      if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
+       check_locus (ns);
+    }
+}
+
+#endif
+
 /* Callback for each gfc_code node invoked from check_realloc_strings.
    For an allocatable LHS string which also appears as a variable on
    the RHS, replace

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index fd64af241b154cd8cb44ec54522c3ea70120866c..24dadf26a12a0c2d1fc50012099e1d3716f2f596 100644 (file)
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2786,6 +2786,7 @@ const char *gfc_print_wide_char (gfc_char_t);
 
 bool gfc_warning (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 bool gfc_warning_now (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
+bool gfc_warning_internal (int opt, const char *, ...) ATTRIBUTE_GCC_GFC(2,3);
 bool gfc_warning_now_at (location_t loc, int opt, const char *gmsgid, ...)
   ATTRIBUTE_GCC_GFC(3,4);