re PR fortran/44054 (Handle -Werror, -Werror=, -fdiagnostics-show-option, !GCC$ diagnostic (pragmas) and color)

gcc/ChangeLog:

2014-12-11  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* diagnostic.c (diagnostic_action_after_output): Make it extern.
	Take diagnostic_t argument instead of diagnostic_info. Count also
	DK_WERROR towards max_errors.
	(diagnostic_report_diagnostic): Update call according to the above.
	(error_recursion): Likewise.
	* diagnostic.h (diagnostic_action_after_output): Declare.
	* pretty-print.c (pp_formatted_text_data): Delete.
	(pp_append_r): Call output_buffer_append_r.
	(pp_formatted_text): Call output_buffer_formatted_text.
	(pp_last_position_in_text): Call output_buffer_last_position_in_text.
	* pretty-print.h (output_buffer_formatted_text): New.
	(output_buffer_append_r): New.
	(output_buffer_last_position_in_text): New.

gcc/fortran/ChangeLog:

2014-12-11  Manuel López-Ibáñez  <manu@gcc.gnu.org>

	PR fortran/44054
	* error.c (pp_error_buffer): New static variable.
	(pp_warning_buffer): Make it a pointer.
	(gfc_output_buffer_empty_p): New.
	(gfc_error_init_1): Call gfc_buffer_error.
	(gfc_buffer_error): Do not use pp_warning_buffer.flush_p as the
	buffered_p flag.
	(gfc_clear_warning): Likewise.
	(gfc_warning_check): Call gfc_clear_warning. Only check the new
	pp_warning_buffer if the old warning_buffer was empty. Call
	diagnostic_action_after_output.
	(gfc_error_1): Renamed from gfc_error.
	(gfc_error): New.
	(gfc_clear_error): Clear also pp_error_buffer.
	(gfc_error_flag_test): Check also pp_error_buffer.
	(gfc_error_check): Likewise. Only check the new pp_error_buffer
	if the old error_buffer was empty.
	(gfc_move_output_buffer_from_to): New.
	(gfc_push_error): Use it here. Take also an output_buffer as argument.
	(gfc_pop_error): Likewise.
	(gfc_free_error): Likewise.
	(gfc_diagnostics_init): Use XNEW and placement-new to init
	pp_error_buffer and pp_warning_buffer. Set flush_p to false for
	both pp_warning_buffer and pp_error_buffer.

	* Update gfc_push_error, gfc_pop_error and gfc_free_error calls
	according to the above changes.
	* Use gfc_error_1 for all gfc_error calls that use multiple
	locations.
	* Use %qs instead of '%s' for many gfc_error calls.

From-SVN: r218627

1 files changed, 45 insertions, 45 deletions

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index edf8336..bfe8356 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -2204,9 +2204,9 @@ check_alloc_comp_init (gfc_expr *e)
       if (comp->attr.allocatable
           && ctor->expr->expr_type != EXPR_NULL)
         {
-	  gfc_error("Invalid initialization expression for ALLOCATABLE "
-	            "component '%s' in structure constructor at %L",
-	            comp->name, &ctor->expr->where);
+	  gfc_error ("Invalid initialization expression for ALLOCATABLE "
+		     "component %qs in structure constructor at %L",
+		     comp->name, &ctor->expr->where);
 	  return false;
 	}
     }
@@ -2315,7 +2315,7 @@ check_inquiry (gfc_expr *e, int not_restricted)
 	    && (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
 		|| ap->expr->symtree->n.sym->ts.deferred))
 	  {
-	    gfc_error ("Assumed or deferred character length variable '%s' "
+	    gfc_error ("Assumed or deferred character length variable %qs "
 			" in constant expression at %L",
 			ap->expr->symtree->n.sym->name,
 			&ap->expr->where);
@@ -2381,8 +2381,8 @@ check_transformational (gfc_expr *e)
 
   if (functions[i] == NULL)
     {
-      gfc_error("transformational intrinsic '%s' at %L is not permitted "
-		"in an initialization expression", name, &e->where);
+      gfc_error ("transformational intrinsic %qs at %L is not permitted "
+		 "in an initialization expression", name, &e->where);
       return MATCH_ERROR;
     }
 
@@ -2481,7 +2481,7 @@ gfc_check_init_expr (gfc_expr *e)
 	if (!gfc_is_intrinsic (sym, 0, e->where)
 	    || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
 	  {
-	    gfc_error ("Function '%s' in initialization expression at %L "
+	    gfc_error ("Function %qs in initialization expression at %L "
 		       "must be an intrinsic function",
 		       e->symtree->n.sym->name, &e->where);
 	    break;
@@ -2493,7 +2493,7 @@ gfc_check_init_expr (gfc_expr *e)
 	    && (m = check_transformational (e)) == MATCH_NO
 	    && (m = check_elemental (e)) == MATCH_NO)
 	  {
-	    gfc_error ("Intrinsic function '%s' at %L is not permitted "
+	    gfc_error ("Intrinsic function %qs at %L is not permitted "
 		       "in an initialization expression",
 		       e->symtree->n.sym->name, &e->where);
 	    m = MATCH_ERROR;
@@ -2528,8 +2528,8 @@ gfc_check_init_expr (gfc_expr *e)
 	     is invalid.  */
 	  if (!e->symtree->n.sym->value)
 	    {
-	      gfc_error("PARAMETER '%s' is used at %L before its definition "
-			"is complete", e->symtree->n.sym->name, &e->where);
+	      gfc_error ("PARAMETER %qs is used at %L before its definition "
+			 "is complete", e->symtree->n.sym->name, &e->where);
 	      t = false;
 	    }
 	  else
@@ -2548,25 +2548,25 @@ gfc_check_init_expr (gfc_expr *e)
 	  switch (e->symtree->n.sym->as->type)
 	    {
 	      case AS_ASSUMED_SIZE:
-		gfc_error ("Assumed size array '%s' at %L is not permitted "
+		gfc_error ("Assumed size array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_ASSUMED_SHAPE:
-		gfc_error ("Assumed shape array '%s' at %L is not permitted "
+		gfc_error ("Assumed shape array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_DEFERRED:
-		gfc_error ("Deferred array '%s' at %L is not permitted "
+		gfc_error ("Deferred array %qs at %L is not permitted "
 			   "in an initialization expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
 
 	      case AS_EXPLICIT:
-		gfc_error ("Array '%s' at %L is a variable, which does "
+		gfc_error ("Array %qs at %L is a variable, which does "
 			   "not reduce to a constant expression",
 			   e->symtree->n.sym->name, &e->where);
 		break;
@@ -2576,7 +2576,7 @@ gfc_check_init_expr (gfc_expr *e)
 	  }
 	}
       else
-	gfc_error ("Parameter '%s' at %L has not been declared or is "
+	gfc_error ("Parameter %qs at %L has not been declared or is "
 		   "a variable, which does not reduce to a constant "
 		   "expression", e->symtree->n.sym->name, &e->where);
 
@@ -2729,28 +2729,28 @@ external_spec_function (gfc_expr *e)
 
   if (f->attr.proc == PROC_ST_FUNCTION)
     {
-      gfc_error ("Specification function '%s' at %L cannot be a statement "
+      gfc_error ("Specification function %qs at %L cannot be a statement "
 		 "function", f->name, &e->where);
       return false;
     }
 
   if (f->attr.proc == PROC_INTERNAL)
     {
-      gfc_error ("Specification function '%s' at %L cannot be an internal "
+      gfc_error ("Specification function %qs at %L cannot be an internal "
 		 "function", f->name, &e->where);
       return false;
     }
 
   if (!f->attr.pure && !f->attr.elemental)
     {
-      gfc_error ("Specification function '%s' at %L must be PURE", f->name,
+      gfc_error ("Specification function %qs at %L must be PURE", f->name,
 		 &e->where);
       return false;
     }
 
   if (f->attr.recursive)
     {
-      gfc_error ("Specification function '%s' at %L cannot be RECURSIVE",
+      gfc_error ("Specification function %qs at %L cannot be RECURSIVE",
 		 f->name, &e->where);
       return false;
     }
@@ -2884,21 +2884,21 @@ check_restricted (gfc_expr *e)
       if (sym->attr.dummy && sym->ns == gfc_current_ns
 	  && sym->ns->proc_name && sym->ns->proc_name->attr.elemental)
 	{
-	  gfc_error ("Dummy argument '%s' not allowed in expression at %L",
+	  gfc_error ("Dummy argument %qs not allowed in expression at %L",
 		     sym->name, &e->where);
 	  break;
 	}
 
       if (sym->attr.optional)
 	{
-	  gfc_error ("Dummy argument '%s' at %L cannot be OPTIONAL",
+	  gfc_error ("Dummy argument %qs at %L cannot be OPTIONAL",
 		     sym->name, &e->where);
 	  break;
 	}
 
       if (sym->attr.intent == INTENT_OUT)
 	{
-	  gfc_error ("Dummy argument '%s' at %L cannot be INTENT(OUT)",
+	  gfc_error ("Dummy argument %qs at %L cannot be INTENT(OUT)",
 		     sym->name, &e->where);
 	  break;
 	}
@@ -2929,7 +2929,7 @@ check_restricted (gfc_expr *e)
 	  break;
 	}
 
-      gfc_error ("Variable '%s' cannot appear in the expression at %L",
+      gfc_error ("Variable %qs cannot appear in the expression at %L",
 		 sym->name, &e->where);
       /* Prevent a repetition of the error.  */
       e->error = 1;
@@ -2992,7 +2992,7 @@ gfc_specification_expr (gfc_expr *e)
       && !gfc_pure (e->symtree->n.sym)
       && (!comp || !comp->attr.pure))
     {
-      gfc_error ("Function '%s' at %L must be PURE",
+      gfc_error ("Function %qs at %L must be PURE",
 		 e->symtree->n.sym->name, &e->where);
       /* Prevent repeat error messages.  */
       e->symtree->n.sym->attr.pure = 1;
@@ -3138,7 +3138,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform)
 
       if (bad_proc)
 	{
-	  gfc_error ("'%s' at %L is not a VALUE", sym->name, &lvalue->where);
+	  gfc_error ("%qs at %L is not a VALUE", sym->name, &lvalue->where);
 	  return false;
 	}
     }
@@ -3331,7 +3331,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
   if (lhs_attr.flavor == FL_PROCEDURE && lhs_attr.use_assoc
       && !lhs_attr.proc_pointer)
     {
-      gfc_error ("'%s' in the pointer assignment at %L cannot be an "
+      gfc_error ("%qs in the pointer assignment at %L cannot be an "
 		 "l-value since it is a procedure",
 		 lvalue->symtree->n.sym->name, &lvalue->where);
       return false;
@@ -3354,7 +3354,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 
 	  if (ref->u.ar.type != AR_SECTION)
 	    {
-	      gfc_error ("Expected bounds specification for '%s' at %L",
+	      gfc_error ("Expected bounds specification for %qs at %L",
 			 lvalue->symtree->n.sym->name, &lvalue->where);
 	      return false;
 	    }
@@ -3461,7 +3461,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	      for (ns = gfc_current_ns; ns; ns = ns->parent)
 		if (sym == ns->proc_name)
 		  {
-		    gfc_error ("Function result '%s' is invalid as proc-target "
+		    gfc_error ("Function result %qs is invalid as proc-target "
 			       "in procedure pointer assignment at %L",
 			       sym->name, &rvalue->where);
 		    return false;
@@ -3470,7 +3470,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	}
       if (attr.abstract)
 	{
-	  gfc_error ("Abstract interface '%s' is invalid "
+	  gfc_error ("Abstract interface %qs is invalid "
 		     "in procedure pointer assignment at %L",
 		     rvalue->symtree->name, &rvalue->where);
 	  return false;
@@ -3480,7 +3480,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	{
 	  if (attr.proc == PROC_ST_FUNCTION)
 	    {
-	      gfc_error ("Statement function '%s' is invalid "
+	      gfc_error ("Statement function %qs is invalid "
 			 "in procedure pointer assignment at %L",
 			 rvalue->symtree->name, &rvalue->where);
 	      return false;
@@ -3493,7 +3493,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 	  if (attr.intrinsic && gfc_intrinsic_actual_ok (rvalue->symtree->name,
 							 attr.subroutine) == 0)
 	    {
-	      gfc_error ("Intrinsic '%s' at %L is invalid in procedure pointer "
+	      gfc_error ("Intrinsic %qs at %L is invalid in procedure pointer "
 			 "assignment", rvalue->symtree->name, &rvalue->where);
 	      return false;
 	    }
@@ -3501,7 +3501,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       /* Check for F08:C730.  */
       if (attr.elemental && !attr.intrinsic)
 	{
-	  gfc_error ("Nonintrinsic elemental procedure '%s' is invalid "
+	  gfc_error ("Nonintrinsic elemental procedure %qs is invalid "
 		     "in procedure pointer assignment at %L",
 		     rvalue->symtree->name, &rvalue->where);
 	  return false;
@@ -3580,14 +3580,14 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       if (s1->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (s2, err, sizeof(err)))
 	{
-	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+	  gfc_error ("Explicit interface required for %qs at %L: %s",
 		     s1->name, &lvalue->where, err);
 	  return false;
 	}
       if (s2->attr.if_source == IFSRC_UNKNOWN
 	  && gfc_explicit_interface_required (s1, err, sizeof(err)))
 	{
-	  gfc_error ("Explicit interface required for '%s' at %L: %s",
+	  gfc_error ("Explicit interface required for %qs at %L: %s",
 		     s2->name, &rvalue->where, err);
 	  return false;
 	}
@@ -3604,7 +3604,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
       if (!s2->attr.intrinsic && s2->attr.if_source == IFSRC_UNKNOWN
 	  && !s2->attr.external && !s2->attr.subroutine && !s2->attr.function)
 	{
-	  gfc_error ("Procedure pointer target '%s' at %L must be either an "
+	  gfc_error ("Procedure pointer target %qs at %L must be either an "
 		     "intrinsic, host or use associated, referenced or have "
 		     "the EXTERNAL attribute", s2->name, &rvalue->where);
 	  return false;
@@ -4758,7 +4758,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
   if (!pointer && sym->attr.flavor == FL_PARAMETER)
     {
       if (context)
-	gfc_error ("Named constant '%s' in variable definition context (%s)"
+	gfc_error ("Named constant %qs in variable definition context (%s)"
 		   " at %L", sym->name, context, &e->where);
       return false;
     }
@@ -4767,7 +4767,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       && !(sym->attr.flavor == FL_PROCEDURE && sym->attr.proc_pointer))
     {
       if (context)
-	gfc_error ("'%s' in variable definition context (%s) at %L is not"
+	gfc_error ("%qs in variable definition context (%s) at %L is not"
 		   " a variable", sym->name, context, &e->where);
       return false;
     }
@@ -4820,7 +4820,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (pointer && is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Dummy argument '%s' with INTENT(IN) in pointer"
+	    gfc_error ("Dummy argument %qs with INTENT(IN) in pointer"
 		       " association context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4828,7 +4828,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!pointer && !is_pointer && !sym->attr.pointer)
 	{
 	  if (context)
-	    gfc_error ("Dummy argument '%s' with INTENT(IN) in variable"
+	    gfc_error ("Dummy argument %qs with INTENT(IN) in variable"
 		       " definition context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4841,7 +4841,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (pointer && is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+	    gfc_error ("Variable %qs is PROTECTED and can not appear in a"
 		       " pointer association context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4849,7 +4849,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!pointer && !is_pointer)
 	{
 	  if (context)
-	    gfc_error ("Variable '%s' is PROTECTED and can not appear in a"
+	    gfc_error ("Variable %qs is PROTECTED and can not appear in a"
 		       " variable definition context (%s) at %L",
 		       sym->name, context, &e->where);
 	  return false;
@@ -4861,7 +4861,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
   if (!pointer && !own_scope && gfc_pure (NULL) && gfc_impure_variable (sym))
     {
       if (context)
-	gfc_error ("Variable '%s' can not appear in a variable definition"
+	gfc_error ("Variable %qs can not appear in a variable definition"
 		   " context (%s) at %L in PURE procedure",
 		   sym->name, context, &e->where);
       return false;
@@ -4920,11 +4920,11 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
 	  if (context)
 	    {
 	      if (assoc->target->expr_type == EXPR_VARIABLE)
-		gfc_error ("'%s' at %L associated to vector-indexed target can"
+		gfc_error ("%qs at %L associated to vector-indexed target can"
 			   " not be used in a variable definition context (%s)",
 			   name, &e->where, context);
 	      else
-		gfc_error ("'%s' at %L associated to expression can"
+		gfc_error ("%qs at %L associated to expression can"
 			   " not be used in a variable definition context (%s)",
 			   name, &e->where, context);
 	    }
@@ -4935,7 +4935,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
       if (!gfc_check_vardef_context (assoc->target, pointer, false, false, NULL))
 	{
 	  if (context)
-	    gfc_error ("Associate-name '%s' can not appear in a variable"
+	    gfc_error_1 ("Associate-name '%s' can not appear in a variable"
 		       " definition context (%s) at %L because its target"
 		       " at %L can not, either",
 		       name, context, &e->where,