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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@199580 138bc75d-0d04-0410-961f-82ee72b054a4

3 files changed, 35 insertions, 21 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 8447e7a3496..4d76a444f93 100644
--- 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 6ab9cc78438..f1aa31e07be 100644
--- 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 a223a2cb704..f98a21399e3 100644
--- 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;
     }