re PR fortran/15586 (gfortran should support i18n in its compiler messages)

	PR fortran/15586
	* arith.c (gfc_arith_error): Change message to include locus.
	(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
	gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
	the new gfc_arith_error.
	(arith_error): Rewrite full error messages instead of building
	them from pieces.
	* check.c (must_be): Removed.
	(type_check, numeric_check, int_or_real_check, real_or_complex_check,
	kind_check, double_check, logical_array_check, array_check,
	scalar_check, same_type_check, rank_check, kind_value_check,
	variable_check, gfc_check_allocated, gfc_check_associated,
	gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
	gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
	gfc_check_pack, gfc_check_precision, gfc_check_present,
	gfc_check_spread): Rewrite full error messages instead of
	building them from pieces.
	* decl.c (gfc_match_entry): Rewrite full error messages instead
	of building them from pieces.
	* parse.c (gfc_state_name): Remove.
	* parse.h: Remove prototype for gfc_state_name.

From-SVN: r105844

gcc/fortran/ChangeLog

+2005-10-24  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* arith.c (gfc_arith_error): Change message to include locus.
+	(check_result, eval_intrinsic, gfc_int2int, gfc_real2real,
+	gfc_real2complex, gfc_complex2real, gfc_complex2complex): Use
+	the new gfc_arith_error.
+	(arith_error): Rewrite full error messages instead of building
+	them from pieces.
+	* check.c (must_be): Removed.
+	(type_check, numeric_check, int_or_real_check, real_or_complex_check,
+	kind_check, double_check, logical_array_check, array_check,
+	scalar_check, same_type_check, rank_check, kind_value_check,
+	variable_check, gfc_check_allocated, gfc_check_associated,
+	gfc_check_cmplx, gfc_check_dcmplx, gfc_check_dot_product,
+	gfc_check_index, gfc_check_kind, gfc_check_matmul, gfc_check_null,
+	gfc_check_pack, gfc_check_precision, gfc_check_present,
+	gfc_check_spread): Rewrite full error messages instead of
+	building them from pieces.
+	* decl.c (gfc_match_entry): Rewrite full error messages instead
+	of building them from pieces.
+	* parse.c (gfc_state_name): Remove.
+	* parse.h: Remove prototype for gfc_state_name.
+
 2005-10-23  Andrew Pinski  <pinskia@physics.uc.edu>
 
 	PR fortran/23635

gcc/fortran/arith.c

@@ -138,25 +138,26 @@ gfc_arith_error (arith code)
   switch (code)
     {
     case ARITH_OK:
-      p = _("Arithmetic OK");
+      p = _("Arithmetic OK at %L");
       break;
     case ARITH_OVERFLOW:
-      p = _("Arithmetic overflow");
+      p = _("Arithmetic overflow at %L");
       break;
     case ARITH_UNDERFLOW:
-      p = _("Arithmetic underflow");
+      p = _("Arithmetic underflow at %L");
       break;
     case ARITH_NAN:
-      p = _("Arithmetic NaN");
+      p = _("Arithmetic NaN at %L");
       break;
     case ARITH_DIV0:
-      p = _("Division by zero");
+      p = _("Division by zero at %L");
       break;
     case ARITH_INCOMMENSURATE:
-      p = _("Array operands are incommensurate");
+      p = _("Array operands are incommensurate at %L");
       break;
     case ARITH_ASYMMETRIC:
-      p = _("Integer outside symmetric range implied by Standard Fortran");
+      p =
+	_("Integer outside symmetric range implied by Standard Fortran at %L");
       break;
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");
@@ -598,13 +599,13 @@ check_result (arith rc, gfc_expr * x, gfc_expr * r, gfc_expr ** rp)
   if (val == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-	gfc_warning ("%s at %L", gfc_arith_error (val), &x->where);
+	gfc_warning (gfc_arith_error (val), &x->where);
       val = ARITH_OK;
     }
 
   if (val == ARITH_ASYMMETRIC)
     {
-      gfc_warning ("%s at %L", gfc_arith_error (val), &x->where);
+      gfc_warning (gfc_arith_error (val), &x->where);
       val = ARITH_OK;
     }
 
@@ -1604,7 +1605,7 @@ eval_intrinsic (gfc_intrinsic_op operator,
 
   if (rc != ARITH_OK)
     {				/* Something went wrong */
-      gfc_error ("%s at %L", gfc_arith_error (rc), &op1->where);
+      gfc_error (gfc_arith_error (rc), &op1->where);
       return NULL;
     }
 
@@ -1907,8 +1908,40 @@ gfc_convert_complex (gfc_expr * real, gfc_expr * imag, int kind)
 static void
 arith_error (arith rc, gfc_typespec * from, gfc_typespec * to, locus * where)
 {
-  gfc_error ("%s converting %s to %s at %L", gfc_arith_error (rc),
-	     gfc_typename (from), gfc_typename (to), where);
+  switch (rc)
+    {
+    case ARITH_OK:
+      gfc_error ("Arithmetic OK converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_OVERFLOW:
+      gfc_error ("Arithmetic overflow converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_UNDERFLOW:
+      gfc_error ("Arithmetic underflow converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_NAN:
+      gfc_error ("Arithmetic NaN converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_DIV0:
+      gfc_error ("Division by zero converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_INCOMMENSURATE:
+      gfc_error ("Array operands are incommensurate converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    case ARITH_ASYMMETRIC:
+      gfc_error ("Integer outside symmetric range implied by Standard Fortran"
+	 	 " converting %s to %s at %L",
+		 gfc_typename (from), gfc_typename (to), where);
+      break;
+    default:
+      gfc_internal_error ("gfc_arith_error(): Bad error code");
+    }
 
   /* TODO: Do something about the error, ie, throw exception, return
      NaN, etc.  */
@@ -1931,7 +1964,7 @@ gfc_int2int (gfc_expr * src, int kind)
     {
       if (rc == ARITH_ASYMMETRIC)
         {
-          gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+          gfc_warning (gfc_arith_error (rc), &src->where);
         }
       else
         {
@@ -2033,7 +2066,7 @@ gfc_real2real (gfc_expr * src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-        gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        gfc_warning (gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2065,7 +2098,7 @@ gfc_real2complex (gfc_expr * src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-        gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        gfc_warning (gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2120,7 +2153,7 @@ gfc_complex2real (gfc_expr * src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-        gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        gfc_warning (gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.real, 0, GFC_RND_MODE);
     }
   if (rc != ARITH_OK)
@@ -2152,7 +2185,7 @@ gfc_complex2complex (gfc_expr * src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-        gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        gfc_warning (gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.complex.r, 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)
@@ -2167,7 +2200,7 @@ gfc_complex2complex (gfc_expr * src, int kind)
   if (rc == ARITH_UNDERFLOW)
     {
       if (gfc_option.warn_underflow)
-        gfc_warning ("%s at %L", gfc_arith_error (rc), &src->where);
+        gfc_warning (gfc_arith_error (rc), &src->where);
       mpfr_set_ui (result->value.complex.i, 0, GFC_RND_MODE);
     }
   else if (rc != ARITH_OK)

gcc/fortran/decl.c

@@ -2419,11 +2419,57 @@ gfc_match_entry (void)
     return m;
 
   state = gfc_current_state ();
-  if (state != COMP_SUBROUTINE
-      && state != COMP_FUNCTION)
+  if (state != COMP_SUBROUTINE && state != COMP_FUNCTION)
     {
-      gfc_error ("ENTRY statement at %C cannot appear within %s",
-		 gfc_state_name (gfc_current_state ()));
+      switch (state)
+	{
+	  case COMP_PROGRAM:
+	    gfc_error ("ENTRY statement at %C cannot appear within a PROGRAM");
+	    break;
+	  case COMP_MODULE:
+	    gfc_error ("ENTRY statement at %C cannot appear within a MODULE");
+	    break;
+	  case COMP_BLOCK_DATA:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within a BLOCK DATA");
+	    break;
+	  case COMP_INTERFACE:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within an INTERFACE");
+	    break;
+	  case COMP_DERIVED:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear "
+	       "within a DERIVED TYPE block");
+	    break;
+	  case COMP_IF:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within an IF-THEN block");
+	    break;
+	  case COMP_DO:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within a DO block");
+	    break;
+	  case COMP_SELECT:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within a SELECT block");
+	    break;
+	  case COMP_FORALL:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within a FORALL block");
+	    break;
+	  case COMP_WHERE:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear within a WHERE block");
+	    break;
+	  case COMP_CONTAINS:
+	    gfc_error
+	      ("ENTRY statement at %C cannot appear "
+	       "within a contained subprogram");
+	    break;
+	  default:
+	    gfc_internal_error ("gfc_match_entry(): Bad state");
+	}
       return MATCH_ERROR;
     }
 

gcc/fortran/parse.c

@@ -959,63 +959,6 @@ gfc_ascii_statement (gfc_statement st)
 }
 
 
-/* Return the name of a compile state.  */
-
-const char *
-gfc_state_name (gfc_compile_state state)
-{
-  const char *p;
-
-  switch (state)
-    {
-    case COMP_PROGRAM:
-      p = _("a PROGRAM");
-      break;
-    case COMP_MODULE:
-      p = _("a MODULE");
-      break;
-    case COMP_SUBROUTINE:
-      p = _("a SUBROUTINE");
-      break;
-    case COMP_FUNCTION:
-      p = _("a FUNCTION");
-      break;
-    case COMP_BLOCK_DATA:
-      p = _("a BLOCK DATA");
-      break;
-    case COMP_INTERFACE:
-      p = _("an INTERFACE");
-      break;
-    case COMP_DERIVED:
-      p = _("a DERIVED TYPE block");
-      break;
-    case COMP_IF:
-      p = _("an IF-THEN block");
-      break;
-    case COMP_DO:
-      p = _("a DO block");
-      break;
-    case COMP_SELECT:
-      p = _("a SELECT block");
-      break;
-    case COMP_FORALL:
-      p = _("a FORALL block");
-      break;
-    case COMP_WHERE:
-      p = _("a WHERE block");
-      break;
-    case COMP_CONTAINS:
-      p = _("a contained subprogram");
-      break;
-
-    default:
-      gfc_internal_error ("gfc_state_name(): Bad state");
-    }
-
-  return p;
-}
-
-
 /* Do whatever is necessary to accept the last statement.  */
 
 static void

gcc/fortran/parse.h

@@ -63,6 +63,5 @@ int gfc_check_do_variable (gfc_symtree *);
 try gfc_find_state (gfc_compile_state);
 gfc_state_data *gfc_enclosing_unit (gfc_compile_state *);
 const char *gfc_ascii_statement (gfc_statement);
-const char *gfc_state_name (gfc_compile_state);
 
 #endif  /* GFC_PARSE_H  */