decl.c (add_global_entry): Take locus.

2013-06-01  Tobias Burnus  <burnus@net-b.de>

        * decl.c (add_global_entry): Take locus.
        (gfc_match_entry): Update call.
        (gfc_match_end): Better error location.
        * parse.c (parse_block_data, parse_module, add_global_procedure,
        add_global_program): Use better locus data.

From-SVN: r199580

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8447e7a3496b6d001108dc71a2e21945d5f146f1..4d76a444f93c5a7a62893b8aa942807087fd521a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2013-06-01  Tobias Burnus  <burnus@net-b.de>
+
+       * decl.c (add_global_entry): Take locus.
+       (gfc_match_entry): Update call.
+       (gfc_match_end): Better error location.
+       * parse.c (parse_block_data, parse_module, add_global_procedure,
+       add_global_program): Use better locus data.
+
 2013-05-31  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57456

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 6ab9cc784380487c0f65d601069e79ff27fd55e7..f1aa31e07be7997c6e08edd932e19e248959841f 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -5354,7 +5354,8 @@ cleanup:
    to return false upon finding an existing global entry.  */
 
 static bool
-add_global_entry (const char *name, const char *binding_label, bool sub)
+add_global_entry (const char *name, const char *binding_label, bool sub,
+                 locus *where)
 {
   gfc_gsymbol *s;
   enum gfc_symbol_type type;
@@ -5369,14 +5370,14 @@ add_global_entry (const char *name, const char *binding_label, bool sub)
 
       if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
        {
-         gfc_global_used(s, NULL);
+         gfc_global_used (s, where);
          return false;
        }
       else
        {
          s->type = type;
          s->sym_name = name;
-         s->where = gfc_current_locus;
+         s->where = *where;
          s->defined = 1;
          s->ns = gfc_current_ns;
        }
@@ -5391,7 +5392,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub)
 
       if (s->defined || (s->type != GSYM_UNKNOWN && s->type != type))
        {
-         gfc_global_used(s, NULL);
+         gfc_global_used (s, where);
          return false;
        }
       else
@@ -5399,7 +5400,7 @@ add_global_entry (const char *name, const char *binding_label, bool sub)
          s->type = type;
          s->sym_name = name;
          s->binding_label = binding_label;
-         s->where = gfc_current_locus;
+         s->where = *where;
          s->defined = 1;
          s->ns = gfc_current_ns;
        }
@@ -5528,6 +5529,7 @@ gfc_match_entry (void)
 
   /* Check what next non-whitespace character is so we can tell if there
      is the required parens if we have a BIND(C).  */
+  old_loc = gfc_current_locus;
   gfc_gobble_whitespace ();
   peek_char = gfc_peek_ascii_char ();
 
@@ -5555,7 +5557,8 @@ gfc_match_entry (void)
        }
 
       if (!gfc_current_ns->parent
-         && !add_global_entry (name, entry->binding_label, true))
+         && !add_global_entry (name, entry->binding_label, true,
+                               &old_loc))
        return MATCH_ERROR;
 
       /* An entry in a subroutine.  */
@@ -5574,7 +5577,6 @@ gfc_match_entry (void)
            ENTRY f() RESULT (r)
         can't be written as
            ENTRY f RESULT (r).  */
-      old_loc = gfc_current_locus;
       if (gfc_match_eos () == MATCH_YES)
        {
          gfc_current_locus = old_loc;
@@ -5624,7 +5626,8 @@ gfc_match_entry (void)
        }
 
       if (!gfc_current_ns->parent
-         && !add_global_entry (name, entry->binding_label, false))
+         && !add_global_entry (name, entry->binding_label, false,
+                               &old_loc))
        return MATCH_ERROR;
     }
 
@@ -6108,6 +6111,7 @@ gfc_match_end (gfc_statement *st)
       goto cleanup;
     }
 
+  old_loc = gfc_current_locus;
   if (gfc_match_eos () == MATCH_YES)
     {
       if (!eos_ok && (*st == ST_END_SUBROUTINE || *st == ST_END_FUNCTION))
@@ -6131,10 +6135,12 @@ gfc_match_end (gfc_statement *st)
   /* Verify that we've got the sort of end-block that we're expecting.  */
   if (gfc_match (target) != MATCH_YES)
     {
-      gfc_error ("Expecting %s statement at %C", gfc_ascii_statement (*st));
+      gfc_error ("Expecting %s statement at %L", gfc_ascii_statement (*st),
+                &old_loc);
       goto cleanup;
     }
 
+  old_loc = gfc_current_locus;
   /* If we're at the end, make sure a block name wasn't required.  */
   if (gfc_match_eos () == MATCH_YES)
     {
@@ -6147,8 +6153,8 @@ gfc_match_end (gfc_statement *st)
       if (!block_name)
        return MATCH_YES;
 
-      gfc_error ("Expected block name of '%s' in %s statement at %C",
-                block_name, gfc_ascii_statement (*st));
+      gfc_error ("Expected block name of '%s' in %s statement at %L",
+                block_name, gfc_ascii_statement (*st), &old_loc);
 
       return MATCH_ERROR;
     }

diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index a223a2cb70450ba08a33a430aba2cd26bd5d021c..f98a21399e328382915fc86708229066ff411f75 100644 (file)
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -4270,11 +4270,11 @@ parse_block_data (void)
       s = gfc_get_gsymbol (gfc_new_block->name);
       if (s->defined
          || (s->type != GSYM_UNKNOWN && s->type != GSYM_BLOCK_DATA))
-       gfc_global_used(s, NULL);
+       gfc_global_used (s, &gfc_new_block->declared_at);
       else
        {
         s->type = GSYM_BLOCK_DATA;
-        s->where = gfc_current_locus;
+        s->where = gfc_new_block->declared_at;
         s->defined = 1;
        }
     }
@@ -4302,11 +4302,11 @@ parse_module (void)
 
   s = gfc_get_gsymbol (gfc_new_block->name);
   if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_MODULE))
-    gfc_global_used(s, NULL);
+    gfc_global_used (s, &gfc_new_block->declared_at);
   else
     {
       s->type = GSYM_MODULE;
-      s->where = gfc_current_locus;
+      s->where = gfc_new_block->declared_at;
       s->defined = 1;
     }
 
@@ -4360,7 +4360,7 @@ add_global_procedure (bool sub)
          || (s->type != GSYM_UNKNOWN
              && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
        {
-         gfc_global_used (s, NULL);
+         gfc_global_used (s, &gfc_new_block->declared_at);
          /* Silence follow-up errors.  */
          gfc_new_block->binding_label = NULL;
        }
@@ -4368,7 +4368,7 @@ add_global_procedure (bool sub)
        {
          s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
          s->sym_name = gfc_new_block->name;
-         s->where = gfc_current_locus;
+         s->where = gfc_new_block->declared_at;
          s->defined = 1;
          s->ns = gfc_current_ns;
        }
@@ -4385,7 +4385,7 @@ add_global_procedure (bool sub)
          || (s->type != GSYM_UNKNOWN
              && s->type != (sub ? GSYM_SUBROUTINE : GSYM_FUNCTION)))
        {
-         gfc_global_used (s, NULL);
+         gfc_global_used (s, &gfc_new_block->declared_at);
          /* Silence follow-up errors.  */
          gfc_new_block->binding_label = NULL;
        }
@@ -4394,7 +4394,7 @@ add_global_procedure (bool sub)
          s->type = sub ? GSYM_SUBROUTINE : GSYM_FUNCTION;
          s->sym_name = gfc_new_block->name;
          s->binding_label = gfc_new_block->binding_label;
-         s->where = gfc_current_locus;
+         s->where = gfc_new_block->declared_at;
          s->defined = 1;
          s->ns = gfc_current_ns;
        }
@@ -4414,11 +4414,11 @@ add_global_program (void)
   s = gfc_get_gsymbol (gfc_new_block->name);
 
   if (s->defined || (s->type != GSYM_UNKNOWN && s->type != GSYM_PROGRAM))
-    gfc_global_used(s, NULL);
+    gfc_global_used (s, &gfc_new_block->declared_at);
   else
     {
       s->type = GSYM_PROGRAM;
-      s->where = gfc_current_locus;
+      s->where = gfc_new_block->declared_at;
       s->defined = 1;
       s->ns = gfc_current_ns;
     }