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

	PR fortran/15586

	* arith.c (gfc_arith_error): Add translation support
	for error messages.
	* array.c (gfc_match_array_ref): Likewise.
	(gfc_match_array_spec): Likewise.
	* check.c (must_be): Add msgid convention to third argument.
	(same_type_check): Add translation support for error message.
	(rank_check): Likewise.
	(kind_value_check): Likewise.
	(gfc_check_associated): Correct typo.
	(gfc_check_reshape): Add translation support for error message.
	(gfc_check_spread): Likewise.
	* error.c (error_printf): Add nocmsgid convention to argument.
	(gfc_warning, gfc_notify_std, gfc_warning_now, gfc_warning_check)
	(gfc_error, gfc_error_now): Likewise.
	(gfc_status): Add cmsgid convention to argument.
	* expr.c (gfc_extract_int): Add translation support
        for error messages.
	(gfc_check_conformance): Add msgid convention to argument.
	(gfc_check_pointer_assign): Correct tabbing.
	* gfortran.h: Include intl.h header. Remove prototype
	for gfc_article.
	* gfortranspec.c: Include intl.h header.
	(lang_specific_driver): Add translation support for --version.
	* io.c (check_format): Add translation support for
	error message.
	(format_item_1): Likewise.
	(data_desc): Likewise.
	* matchexp.c: Likewise.
	* misc.c (gfc_article): Remove function.
	* module.c (bad_module): Use msgid convention. Add
	translation support for error messages.
	(require_atom): Add translation support for error messages.
	* parse.c (gfc_ascii_statement): Likewise.
	(gfc_state_name): Likewise.
	* primary.c (match_boz_constant): Reorganise error
	messages for translations.
	* resolve.c (resolve_entries): Likewise.
	(resolve_operator): Add translation support for error messages.
	(gfc_resolve_expr): Use msgid convention. Reorganise error
        messages for translations.
	(resolve_symbol): Add translation support for error messages.
	* symbol.c (gfc_add_procedure): Remove use of gfc_article function.
	* trans-const.c (gfc_build_string_const): Use msgid convention.

	* exgettext: Add a new nocmsgid convention for arguments
	that should be marked as no-c-format.
	* gcc.pot: Regenerate.

From-SVN: r104372

gcc/fortran/ChangeLog

+2005-09-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* arith.c (gfc_arith_error): Add translation support for error
+	messages.
+	* array.c (gfc_match_array_ref): Likewise.
+	(gfc_match_array_spec): Likewise.
+	* check.c (must_be): Add msgid convention to third argument.
+	(same_type_check): Add translation support for error message.
+	(rank_check): Likewise.
+	(kind_value_check): Likewise.
+	(gfc_check_associated): Correct typo.
+	(gfc_check_reshape): Add translation support for error message.
+	(gfc_check_spread): Likewise.
+	* error.c (error_printf): Add nocmsgid convention to argument.
+	(gfc_warning, gfc_notify_std, gfc_warning_now, gfc_warning_check)
+	(gfc_error, gfc_error_now): Likewise.
+	(gfc_status): Add cmsgid convention to argument.
+	* expr.c (gfc_extract_int): Add translation support for error
+	messages.
+	(gfc_check_conformance): Add msgid convention to argument.
+	(gfc_check_pointer_assign): Correct tabbing.
+	* gfortran.h: Include intl.h header. Remove prototype for gfc_article.
+	* gfortranspec.c: Include intl.h header.
+	(lang_specific_driver): Add translation support for --version.
+	* io.c (check_format): Add translation support for error message.
+	(format_item_1): Likewise.
+	(data_desc): Likewise.
+	* matchexp.c: Likewise.
+	* misc.c (gfc_article): Remove function.
+	* module.c (bad_module): Use msgid convention. Add translation support
+	for error messages.
+	(require_atom): Add translation support for error messages.
+	* parse.c (gfc_ascii_statement): Likewise.
+	(gfc_state_name): Likewise.
+	* primary.c (match_boz_constant): Reorganise error messages for
+	translations.
+	* resolve.c (resolve_entries): Likewise.
+	(resolve_operator): Add translation support for error messages.
+	(gfc_resolve_expr): Use msgid convention. Reorganise error messages
+	for translations.
+	(resolve_symbol): Add translation support for error messages.
+	* symbol.c (gfc_add_procedure): Remove use of gfc_article function.
+	* trans-const.c (gfc_build_string_const): Use msgid convention.
+
 2005-09-16  Paul Brook  <paul@codesourcery.com>
 
 	PR fortran/23906

gcc/fortran/arith.c

@@ -138,25 +138,25 @@ gfc_arith_error (arith code)
   switch (code)
     {
     case ARITH_OK:
-      p = "Arithmetic OK";
+      p = _("Arithmetic OK");
       break;
     case ARITH_OVERFLOW:
-      p = "Arithmetic overflow";
+      p = _("Arithmetic overflow");
       break;
     case ARITH_UNDERFLOW:
-      p = "Arithmetic underflow";
+      p = _("Arithmetic underflow");
       break;
     case ARITH_NAN:
-      p = "Arithmetic NaN";
+      p = _("Arithmetic NaN");
       break;
     case ARITH_DIV0:
-      p = "Division by zero";
+      p = _("Division by zero");
       break;
     case ARITH_INCOMMENSURATE:
-      p = "Array operands are incommensurate";
+      p = _("Array operands are incommensurate");
       break;
     case ARITH_ASYMMETRIC:
-      p = "Integer outside symmetric range implied by Standard Fortran";
+      p = _("Integer outside symmetric range implied by Standard Fortran");
       break;
     default:
       gfc_internal_error ("gfc_arith_error(): Bad error code");

gcc/fortran/array.c

@@ -169,8 +169,8 @@ gfc_match_array_ref (gfc_array_ref * ar, gfc_array_spec * as, int init)
 	}
     }
 
-  gfc_error ("Array reference at %C cannot have more than "
-	     stringize (GFC_MAX_DIMENSIONS) " dimensions");
+  gfc_error ("Array reference at %C cannot have more than %d dimensions",
+	     GFC_MAX_DIMENSIONS);
 
 error:
   return MATCH_ERROR;
@@ -419,8 +419,8 @@ gfc_match_array_spec (gfc_array_spec ** asp)
 
       if (as->rank >= GFC_MAX_DIMENSIONS)
 	{
-	  gfc_error ("Array specification at %C has more than "
-		     stringize (GFC_MAX_DIMENSIONS) " dimensions");
+	  gfc_error ("Array specification at %C has more than %d dimensions",
+		     GFC_MAX_DIMENSIONS);
 	  goto cleanup;
 	}
 

gcc/fortran/check.c

@@ -37,11 +37,11 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
    function can be called in all kinds of ways.  */
 
 static void
-must_be (gfc_expr * e, int n, const char *thing)
+must_be (gfc_expr * e, int n, const char *thing_msgid)
 {
   gfc_error ("'%s' argument of '%s' intrinsic at %L must be %s",
 	     gfc_current_intrinsic_arg[n], gfc_current_intrinsic, &e->where,
-	     thing);
+	     thing_msgid);
 }
 
 
@@ -206,7 +206,7 @@ same_type_check (gfc_expr * e, int n, gfc_expr * f, int m)
   if (gfc_compare_types (&e->ts, &f->ts))
     return SUCCESS;
 
-  sprintf (message, "the same type and kind as '%s'",
+  sprintf (message, _("the same type and kind as '%s'"),
 	   gfc_current_intrinsic_arg[n]);
 
   must_be (f, m, message);
@@ -225,7 +225,7 @@ rank_check (gfc_expr * e, int n, int rank)
   if (e->rank == rank)
     return SUCCESS;
 
-  sprintf (message, "of rank %d", rank);
+  sprintf (message, _("of rank %d"), rank);
 
   must_be (e, n, message);
 
@@ -262,7 +262,7 @@ kind_value_check (gfc_expr * e, int n, int k)
   if (e->ts.kind == k)
     return SUCCESS;
 
-  sprintf (message, "of kind %d", k);
+  sprintf (message, _("of kind %d"), k);
 
   must_be (e, n, message);
   return FAILURE;
@@ -507,7 +507,7 @@ gfc_check_associated (gfc_expr * pointer, gfc_expr * target)
         if (target->ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
           {
             gfc_error ("Array section with a vector subscript at %L shall not "
-		       "be the target of an pointer",
+		       "be the target of a pointer",
                        &target->where);
             t = FAILURE;
             break;
@@ -1727,9 +1727,8 @@ gfc_check_reshape (gfc_expr * source, gfc_expr * shape,
 
   if (m > 0)
     {
-      gfc_error
-	("'shape' argument of 'reshape' intrinsic at %L has more than "
-	 stringize (GFC_MAX_DIMENSIONS) " elements", &shape->where);
+      gfc_error ("'shape' argument of 'reshape' intrinsic at %L has more "
+		 "than %d elements", &shape->where, GFC_MAX_DIMENSIONS);
       return FAILURE;
     }
 
@@ -1902,7 +1901,11 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
 {
   if (source->rank >= GFC_MAX_DIMENSIONS)
     {
-      must_be (source, 0, "less than rank " stringize (GFC_MAX_DIMENSIONS));
+      char message[100];
+
+      sprintf (message, _("less than rank %d"), GFC_MAX_DIMENSIONS);
+      must_be (source, 0, message);
+
       return FAILURE;
     }
 

gcc/fortran/error.c

@@ -449,12 +449,12 @@ error_print (const char *type, const char *format0, va_list argp)
 /* Wrapper for error_print().  */
 
 static void
-error_printf (const char *format, ...)
+error_printf (const char *nocmsgid, ...)
 {
   va_list argp;
 
-  va_start (argp, format);
-  error_print ("", format, argp);
+  va_start (argp, nocmsgid);
+  error_print ("", _(nocmsgid), argp);
   va_end (argp);
 }
 
@@ -462,7 +462,7 @@ error_printf (const char *format, ...)
 /* Issue a warning.  */
 
 void
-gfc_warning (const char *format, ...)
+gfc_warning (const char *nocmsgid, ...)
 {
   va_list argp;
 
@@ -473,10 +473,10 @@ gfc_warning (const char *format, ...)
   warning_buffer.index = 0;
   cur_error_buffer = &warning_buffer;
 
-  va_start (argp, format);
+  va_start (argp, nocmsgid);
   if (buffer_flag == 0)
     warnings++;
-  error_print ("Warning:", format, argp);
+  error_print (_("Warning:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -489,7 +489,7 @@ gfc_warning (const char *format, ...)
    an error is generated.  */
 
 try
-gfc_notify_std (int std, const char *format, ...)
+gfc_notify_std (int std, const char *nocmsgid, ...)
 {
   va_list argp;
   bool warning;
@@ -514,11 +514,11 @@ gfc_notify_std (int std, const char *format, ...)
       else
 	errors++;
     }
-  va_start (argp, format);
+  va_start (argp, nocmsgid);
   if (warning)
-    error_print ("Warning:", format, argp);
+    error_print (_("Warning:"), _(nocmsgid), argp);
   else
-    error_print ("Error:", format, argp);
+    error_print (_("Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -529,7 +529,7 @@ gfc_notify_std (int std, const char *format, ...)
 /* Immediate warning (i.e. do not buffer the warning).  */
 
 void
-gfc_warning_now (const char *format, ...)
+gfc_warning_now (const char *nocmsgid, ...)
 {
   va_list argp;
   int i;
@@ -541,8 +541,8 @@ gfc_warning_now (const char *format, ...)
   buffer_flag = 0;
   warnings++;
 
-  va_start (argp, format);
-  error_print ("Warning:", format, argp);
+  va_start (argp, nocmsgid);
+  error_print (_("Warning:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -578,7 +578,7 @@ gfc_warning_check (void)
 /* Issue an error.  */
 
 void
-gfc_error (const char *format, ...)
+gfc_error (const char *nocmsgid, ...)
 {
   va_list argp;
 
@@ -589,10 +589,10 @@ gfc_error (const char *format, ...)
   error_buffer.index = 0;
   cur_error_buffer = &error_buffer;
 
-  va_start (argp, format);
+  va_start (argp, nocmsgid);
   if (buffer_flag == 0)
     errors++;
-  error_print ("Error:", format, argp);
+  error_print (_("Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -602,7 +602,7 @@ gfc_error (const char *format, ...)
 /* Immediate error.  */
 
 void
-gfc_error_now (const char *format, ...)
+gfc_error_now (const char *nocmsgid, ...)
 {
   va_list argp;
   int i;
@@ -615,8 +615,8 @@ gfc_error_now (const char *format, ...)
   buffer_flag = 0;
   errors++;
 
-  va_start (argp, format);
-  error_print ("Error:", format, argp);
+  va_start (argp, nocmsgid);
+  error_print (_("Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -627,14 +627,14 @@ gfc_error_now (const char *format, ...)
 /* Fatal error, never returns.  */
 
 void
-gfc_fatal_error (const char *format, ...)
+gfc_fatal_error (const char *nocmsgid, ...)
 {
   va_list argp;
 
   buffer_flag = 0;
 
-  va_start (argp, format);
-  error_print ("Fatal Error:", format, argp);
+  va_start (argp, nocmsgid);
+  error_print (_("Fatal Error:"), _(nocmsgid), argp);
   va_end (argp);
 
   exit (3);
@@ -735,13 +735,13 @@ gfc_free_error (gfc_error_buf * err)
 /* Debug wrapper for printf.  */
 
 void
-gfc_status (const char *format, ...)
+gfc_status (const char *cmsgid, ...)
 {
   va_list argp;
 
-  va_start (argp, format);
+  va_start (argp, cmsgid);
 
-  vprintf (format, argp);
+  vprintf (_(cmsgid), argp);
 
   va_end (argp);
 }

gcc/fortran/expr.c

@@ -255,15 +255,15 @@ gfc_extract_int (gfc_expr * expr, int *result)
 {
 
   if (expr->expr_type != EXPR_CONSTANT)
-    return "Constant expression required at %C";
+    return _("Constant expression required at %C");
 
   if (expr->ts.type != BT_INTEGER)
-    return "Integer expression required at %C";
+    return _("Integer expression required at %C");
 
   if ((mpz_cmp_si (expr->value.integer, INT_MAX) > 0)
       || (mpz_cmp_si (expr->value.integer, INT_MIN) < 0))
     {
-      return "Integer value too large in expression at %C";
+      return _("Integer value too large in expression at %C");
     }
 
   *result = (int) mpz_get_si (expr->value.integer);
@@ -1753,7 +1753,8 @@ gfc_specification_expr (gfc_expr * e)
 /* Given two expressions, make sure that the arrays are conformable.  */
 
 try
-gfc_check_conformance (const char *optype, gfc_expr * op1, gfc_expr * op2)
+gfc_check_conformance (const char *optype_msgid,
+		       gfc_expr * op1, gfc_expr * op2)
 {
   int op1_flag, op2_flag, d;
   mpz_t op1_size, op2_size;
@@ -1764,7 +1765,8 @@ gfc_check_conformance (const char *optype, gfc_expr * op1, gfc_expr * op2)
 
   if (op1->rank != op2->rank)
     {
-      gfc_error ("Incompatible ranks in %s at %L", optype, &op1->where);
+      gfc_error ("Incompatible ranks in %s at %L", _(optype_msgid),
+		 &op1->where);
       return FAILURE;
     }
 
@@ -1778,7 +1780,8 @@ gfc_check_conformance (const char *optype, gfc_expr * op1, gfc_expr * op2)
       if (op1_flag && op2_flag && mpz_cmp (op1_size, op2_size) != 0)
 	{
 	  gfc_error ("%s at %L has different shape on dimension %d (%d/%d)",
-		     optype, &op1->where, d + 1, (int) mpz_get_si (op1_size),
+		     _(optype_msgid), &op1->where, d + 1,
+		     (int) mpz_get_si (op1_size),
 		     (int) mpz_get_si (op2_size));
 
 	  t = FAILURE;
@@ -1920,7 +1923,7 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
 
   if (lvalue->ts.kind != rvalue->ts.kind)
     {
-      gfc_error	("Different kind type parameters in pointer "
+      gfc_error ("Different kind type parameters in pointer "
 		 "assignment at %L", &lvalue->where);
       return FAILURE;
     }
@@ -1928,14 +1931,14 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
   attr = gfc_expr_attr (rvalue);
   if (!attr.target && !attr.pointer)
     {
-      gfc_error	("Pointer assignment target is neither TARGET "
+      gfc_error ("Pointer assignment target is neither TARGET "
 		 "nor POINTER at %L", &rvalue->where);
       return FAILURE;
     }
 
   if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
     {
-      gfc_error	("Bad target in pointer assignment in PURE "
+      gfc_error ("Bad target in pointer assignment in PURE "
 		 "procedure at %L", &rvalue->where);
     }
 

gcc/fortran/gfortran.h

@@ -30,6 +30,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
    time I looked, so by comparison this is perfectly reasonable.  */
 
 #include "system.h"
+#include "intl.h"
 #include "coretypes.h"
 #include "input.h"
 
@@ -1532,7 +1533,6 @@ void gfc_free (void *);
 int gfc_terminal_width(void);
 void gfc_clear_ts (gfc_typespec *);
 FILE *gfc_open_file (const char *);
-const char *gfc_article (const char *);
 const char *gfc_basic_typename (bt);
 const char *gfc_typename (gfc_typespec *);
 

gcc/fortran/gfortranspec.c

@@ -51,6 +51,7 @@ Boston, MA 02110-1301, USA.  */
 
 #include "coretypes.h"
 #include "tm.h"
+#include "intl.h"
 
 #ifndef MATH_LIBRARY
 #define MATH_LIBRARY "-lm"
@@ -345,15 +346,13 @@ lang_specific_driver (int *in_argc, const char *const **in_argv,
 	  break;
 
 	case OPTION_version:
-	  printf ("\
-GNU Fortran 95 (GCC %s)\n\
-Copyright (C) 2005 Free Software Foundation, Inc.\n\
-\n\
-GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
+	  printf ("GNU Fortran 95 (GCC) %s\n", version_string);
+	  printf ("Copyright %s 2005 Free Software Foundation, Inc.\n\n",
+	          _("(C)"));
+	  printf (_("GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
 You may redistribute copies of GNU Fortran\n\
 under the terms of the GNU General Public License.\n\
-For more information about these matters, see the file named COPYING\n\
-", version_string);
+For more information about these matters, see the file named COPYING\n\n"));
 	  exit (0);
 	  break;
 
@@ -528,7 +527,7 @@ For more information about these matters, see the file named COPYING\n\
 
   if (verbose && g77_newargv != g77_xargv)
     {
-      fprintf (stderr, "Driving:");
+      fprintf (stderr, _("Driving:"));
       for (i = 0; i < g77_newargc; i++)
 	fprintf (stderr, " %s", g77_newargv[i]);
       fprintf (stderr, "\n");

gcc/fortran/io.c

@@ -401,11 +401,11 @@ format_lex (void)
 static try
 check_format (void)
 {
-  const char *posint_required	  = "Positive width required";
-  const char *period_required	  = "Period required";
-  const char *nonneg_required	  = "Nonnegative width required";
-  const char *unexpected_element  = "Unexpected element";
-  const char *unexpected_end	  = "Unexpected end of format string";
+  const char *posint_required	  = _("Positive width required");
+  const char *period_required	  = _("Period required");
+  const char *nonneg_required	  = _("Nonnegative width required");
+  const char *unexpected_element  = _("Unexpected element");
+  const char *unexpected_end	  = _("Unexpected end of format string");
 
   const char *error;
   format_token t, u;
@@ -422,7 +422,7 @@ check_format (void)
   t = format_lex ();
   if (t != FMT_LPAREN)
     {
-      error = "Missing leading left parenthesis";
+      error = _("Missing leading left parenthesis");
       goto syntax;
     }
 
@@ -460,7 +460,7 @@ format_item_1:
       t = format_lex ();
       if (t != FMT_P)
 	{
-	  error = "Expected P edit descriptor";
+	  error = _("Expected P edit descriptor");
 	  goto syntax;
 	}
 
@@ -468,7 +468,7 @@ format_item_1:
 
     case FMT_P:
       /* P requires a prior number.  */
-      error = "P descriptor requires leading scale factor";
+      error = _("P descriptor requires leading scale factor");
       goto syntax;
 
     case FMT_X:
@@ -498,7 +498,7 @@ format_item_1:
         return FAILURE;
       if (t != FMT_RPAREN || level > 0)
 	{
-	  error = "$ must be the last specifier";
+	  error = _("$ must be the last specifier");
 	  goto syntax;
 	}
 
@@ -543,7 +543,7 @@ data_desc:
 	  t = format_lex ();
 	  if (t == FMT_POSINT)
 	    {
-	      error = "Repeat count cannot follow P descriptor";
+	      error = _("Repeat count cannot follow P descriptor");
 	      goto syntax;
 	    }
 
@@ -606,7 +606,7 @@ data_desc:
 	  u = format_lex ();
 	  if (u != FMT_POSINT)
 	    {
-	      error = "Positive exponent width required";
+	      error = _("Positive exponent width required");
 	      goto syntax;
 	    }
 	}

gcc/fortran/matchexp.c

@@ -26,7 +26,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 #include "arith.h"
 #include "match.h"
 
-static char expression_syntax[] = "Syntax error in expression at %C";
+static char expression_syntax[] = N_("Syntax error in expression at %C");
 
 
 /* Match a user-defined operator name.  This is a normal name with a

gcc/fortran/misc.c

@@ -105,36 +105,6 @@ gfc_open_file (const char *name)
 }
 
 
-/* Given a word, return the correct article.  */
-
-const char *
-gfc_article (const char *word)
-{
-  const char *p;
-
-  switch (*word)
-    {
-    case 'a':
-    case 'A':
-    case 'e':
-    case 'E':
-    case 'i':
-    case 'I':
-    case 'o':
-    case 'O':
-    case 'u':
-    case 'U':
-      p = "an";
-      break;
-
-    default:
-      p = "a";
-    }
-
-  return p;
-}
-
-
 /* Return a string for each type.  */
 
 const char *

gcc/fortran/module.c

@@ -827,27 +827,25 @@ static char *atom_string, atom_name[MAX_ATOM_SIZE];
 static void bad_module (const char *) ATTRIBUTE_NORETURN;
 
 static void
-bad_module (const char *message)
+bad_module (const char *msgid)
 {
-  const char *p;
+  fclose (module_fp);
 
   switch (iomode)
     {
     case IO_INPUT:
-      p = "Reading";
+      gfc_fatal_error ("Reading module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
       break;
     case IO_OUTPUT:
-      p = "Writing";
+      gfc_fatal_error ("Writing module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
       break;
     default:
-      p = "???";
+      gfc_fatal_error ("Module %s at line %d column %d: %s",
+	  	       module_name, module_line, module_column, msgid);
       break;
     }
-
-  fclose (module_fp);
-
-  gfc_fatal_error ("%s module %s at line %d column %d: %s", p,
-		   module_name, module_line, module_column, message);
 }
 
 
@@ -1154,19 +1152,19 @@ require_atom (atom_type type)
       switch (type)
 	{
 	case ATOM_NAME:
-	  p = "Expected name";
+	  p = _("Expected name");
 	  break;
 	case ATOM_LPAREN:
-	  p = "Expected left parenthesis";
+	  p = _("Expected left parenthesis");
 	  break;
 	case ATOM_RPAREN:
-	  p = "Expected right parenthesis";
+	  p = _("Expected right parenthesis");
 	  break;
 	case ATOM_INTEGER:
-	  p = "Expected integer";
+	  p = _("Expected integer");
 	  break;
 	case ATOM_STRING:
-	  p = "Expected string";
+	  p = _("Expected string");
 	  break;
 	default:
 	  gfc_internal_error ("require_atom(): bad atom type required");

gcc/fortran/parse.c

@@ -731,13 +731,13 @@ gfc_ascii_statement (gfc_statement st)
   switch (st)
     {
     case ST_ARITHMETIC_IF:
-      p = "arithmetic IF";
+      p = _("arithmetic IF");
       break;
     case ST_ALLOCATE:
       p = "ALLOCATE";
       break;
     case ST_ATTR_DECL:
-      p = "attribute declaration";
+      p = _("attribute declaration");
       break;
     case ST_BACKSPACE:
       p = "BACKSPACE";
@@ -767,7 +767,7 @@ gfc_ascii_statement (gfc_statement st)
       p = "CYCLE";
       break;
     case ST_DATA_DECL:
-      p = "data declaration";
+      p = _("data declaration");
       break;
     case ST_DATA:
       p = "DATA";
@@ -776,7 +776,7 @@ gfc_ascii_statement (gfc_statement st)
       p = "DEALLOCATE";
       break;
     case ST_DERIVED_DECL:
-      p = "Derived type declaration";
+      p = _("derived type declaration");
       break;
     case ST_DO:
       p = "DO";
@@ -855,7 +855,7 @@ gfc_ascii_statement (gfc_statement st)
       p = "GOTO";
       break;
     case ST_IF_BLOCK:
-      p = "block IF";
+      p = _("block IF");
       break;
     case ST_IMPLICIT:
       p = "IMPLICIT";
@@ -864,7 +864,7 @@ gfc_ascii_statement (gfc_statement st)
       p = "IMPLICIT NONE";
       break;
     case ST_IMPLIED_ENDDO:
-      p = "implied END DO";
+      p = _("implied END DO");
       break;
     case ST_INQUIRE:
       p = "INQUIRE";
@@ -931,10 +931,10 @@ gfc_ascii_statement (gfc_statement st)
       p = "WRITE";
       break;
     case ST_ASSIGNMENT:
-      p = "assignment";
+      p = _("assignment");
       break;
     case ST_POINTER_ASSIGNMENT:
-      p = "pointer assignment";
+      p = _("pointer assignment");
       break;
     case ST_SELECT_CASE:
       p = "SELECT CASE";
@@ -943,7 +943,7 @@ gfc_ascii_statement (gfc_statement st)
       p = "SEQUENCE";
       break;
     case ST_SIMPLE_IF:
-      p = "Simple IF";
+      p = _("simple IF");
       break;
     case ST_STATEMENT_FUNCTION:
       p = "STATEMENT FUNCTION";
@@ -969,43 +969,43 @@ gfc_state_name (gfc_compile_state state)
   switch (state)
     {
     case COMP_PROGRAM:
-      p = "a PROGRAM";
+      p = _("a PROGRAM");
       break;
     case COMP_MODULE:
-      p = "a MODULE";
+      p = _("a MODULE");
       break;
     case COMP_SUBROUTINE:
-      p = "a SUBROUTINE";
+      p = _("a SUBROUTINE");
       break;
     case COMP_FUNCTION:
-      p = "a FUNCTION";
+      p = _("a FUNCTION");
       break;
     case COMP_BLOCK_DATA:
-      p = "a BLOCK DATA";
+      p = _("a BLOCK DATA");
       break;
     case COMP_INTERFACE:
-      p = "an INTERFACE";
+      p = _("an INTERFACE");
       break;
     case COMP_DERIVED:
-      p = "a DERIVED TYPE block";
+      p = _("a DERIVED TYPE block");
       break;
     case COMP_IF:
-      p = "an IF-THEN block";
+      p = _("an IF-THEN block");
       break;
     case COMP_DO:
-      p = "a DO block";
+      p = _("a DO block");
       break;
     case COMP_SELECT:
-      p = "a SELECT block";
+      p = _("a SELECT block");
       break;
     case COMP_FORALL:
-      p = "a FORALL block";
+      p = _("a FORALL block");
       break;
     case COMP_WHERE:
-      p = "a WHERE block";
+      p = _("a WHERE block");
       break;
     case COMP_CONTAINS:
-      p = "a contained subprogram";
+      p = _("a contained subprogram");
       break;
 
     default:

gcc/fortran/primary.c

@@ -307,7 +307,6 @@ match_boz_constant (gfc_expr ** result)
   locus old_loc;
   char *buffer;
   gfc_expr *e;
-  const char *rname;
 
   old_loc = gfc_current_locus;
   gfc_gobble_whitespace ();
@@ -317,18 +316,15 @@ match_boz_constant (gfc_expr ** result)
     {
     case 'b':
       radix = 2;
-      rname = "binary";
       break;
     case 'o':
       radix = 8;
-      rname = "octal";
       break;
     case 'x':
       x_hex = 1;
       /* Fall through.  */
     case 'z':
       radix = 16;
-      rname = "hexadecimal";
       break;
     default:
       goto backup;
@@ -351,13 +347,33 @@ match_boz_constant (gfc_expr ** result)
   length = match_digits (0, radix, NULL);
   if (length == -1)
     {
-      gfc_error ("Empty set of digits in %s constants at %C", rname);
+      switch (radix)
+        {
+	case 2:
+          gfc_error ("Empty set of digits in binary constant at %C");
+	case 8:
+          gfc_error ("Empty set of digits in octal constant at %C");
+	case 16:
+          gfc_error ("Empty set of digits in hexadecimal constant at %C");
+        default:
+	  gcc_unreachable ();
+        }
       return MATCH_ERROR;
     }
 
   if (gfc_next_char () != delim)
     {
-      gfc_error ("Illegal character in %s constant at %C.", rname);
+      switch (radix)
+        {
+	case 2:
+	  gfc_error ("Illegal character in binary constant at %C");
+	case 8:
+	  gfc_error ("Illegal character in octal constant at %C");
+	case 16:
+	  gfc_error ("Illegal character in hexadecimal constant at %C");
+	default:
+	  gcc_unreachable ();
+	}
       return MATCH_ERROR;
     }
 

gcc/fortran/resolve.c

@@ -411,13 +411,27 @@ resolve_entries (gfc_namespace * ns)
 	    {
 	      sym = el->sym->result;
 	      if (sym->attr.dimension)
-		gfc_error ("%s result %s can't be an array in FUNCTION %s at %L",
-			   el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
-			   ns->entries->sym->name, &sym->declared_at);
+	      {
+		if (el == ns->entries)
+		  gfc_error
+		  ("FUNCTION result %s can't be an array in FUNCTION %s at %L",
+		   sym->name, ns->entries->sym->name, &sym->declared_at);
+	        else
+		  gfc_error
+		    ("ENTRY result %s can't be an array in FUNCTION %s at %L",
+		     sym->name, ns->entries->sym->name, &sym->declared_at);
+	      }
 	      else if (sym->attr.pointer)
-		gfc_error ("%s result %s can't be a POINTER in FUNCTION %s at %L",
-			   el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
-			   ns->entries->sym->name, &sym->declared_at);
+	      {
+		if (el == ns->entries)
+		  gfc_error
+		  ("FUNCTION result %s can't be a POINTER in FUNCTION %s at %L",
+		   sym->name, ns->entries->sym->name, &sym->declared_at);
+	        else
+		  gfc_error
+		    ("ENTRY result %s can't be a POINTER in FUNCTION %s at %L",
+		     sym->name, ns->entries->sym->name, &sym->declared_at);
+	      }
 	      else
 		{
 		  ts = &sym->ts;
@@ -450,10 +464,18 @@ resolve_entries (gfc_namespace * ns)
 		      break;
 		    }
 		  if (sym)
-		    gfc_error ("%s result %s can't be of type %s in FUNCTION %s at %L",
-			       el == ns->entries ? "FUNCTION" : "ENTRY", sym->name,
-			       gfc_typename (ts), ns->entries->sym->name,
-			       &sym->declared_at);
+		  {
+		    if (el == ns->entries)
+		      gfc_error
+			("FUNCTION result %s can't be of type %s in FUNCTION %s at %L",
+			 sym->name, gfc_typename (ts), ns->entries->sym->name,
+			 &sym->declared_at);
+		    else
+		      gfc_error
+			("ENTRY result %s can't be of type %s in FUNCTION %s at %L",
+			 sym->name, gfc_typename (ts), ns->entries->sym->name,
+			 &sym->declared_at);
+		  }
 		}
 	    }
 	}
@@ -1417,7 +1439,7 @@ resolve_operator (gfc_expr * e)
 	  break;
 	}
 
-      sprintf (msg, "Operand of unary numeric operator '%s' at %%L is %s",
+      sprintf (msg, _("Operand of unary numeric operator '%s' at %%L is %s"),
 	       gfc_op2string (e->value.op.operator), gfc_typename (&e->ts));
       goto bad_op;
 
@@ -1433,7 +1455,7 @@ resolve_operator (gfc_expr * e)
 	}
 
       sprintf (msg,
-	       "Operands of binary numeric operator '%s' at %%L are %s/%s",
+	       _("Operands of binary numeric operator '%s' at %%L are %s/%s"),
 	       gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
 	       gfc_typename (&op2->ts));
       goto bad_op;
@@ -1447,7 +1469,7 @@ resolve_operator (gfc_expr * e)
 	}
 
       sprintf (msg,
-	       "Operands of string concatenation operator at %%L are %s/%s",
+	       _("Operands of string concatenation operator at %%L are %s/%s"),
 	       gfc_typename (&op1->ts), gfc_typename (&op2->ts));
       goto bad_op;
 
@@ -1466,7 +1488,7 @@ resolve_operator (gfc_expr * e)
 	  break;
 	}
 
-      sprintf (msg, "Operands of logical operator '%s' at %%L are %s/%s",
+      sprintf (msg, _("Operands of logical operator '%s' at %%L are %s/%s"),
 	       gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
 	       gfc_typename (&op2->ts));
 
@@ -1480,7 +1502,7 @@ resolve_operator (gfc_expr * e)
 	  break;
 	}
 
-      sprintf (msg, "Operand of .NOT. operator at %%L is %s",
+      sprintf (msg, _("Operand of .NOT. operator at %%L is %s"),
 	       gfc_typename (&op1->ts));
       goto bad_op;
 
@@ -1490,7 +1512,7 @@ resolve_operator (gfc_expr * e)
     case INTRINSIC_LE:
       if (op1->ts.type == BT_COMPLEX || op2->ts.type == BT_COMPLEX)
 	{
-	  strcpy (msg, "COMPLEX quantities cannot be compared at %L");
+	  strcpy (msg, _("COMPLEX quantities cannot be compared at %L"));
 	  goto bad_op;
 	}
 
@@ -1515,11 +1537,13 @@ resolve_operator (gfc_expr * e)
 	}
 
       if (op1->ts.type == BT_LOGICAL && op2->ts.type == BT_LOGICAL)
-	sprintf (msg, "Logicals at %%L must be compared with %s instead of %s",
+	sprintf (msg,
+	         _("Logicals at %%L must be compared with %s instead of %s"),
 		 e->value.op.operator == INTRINSIC_EQ ? ".EQV." : ".NEQV.",
 		 gfc_op2string (e->value.op.operator));
       else
-	sprintf (msg, "Operands of comparison operator '%s' at %%L are %s/%s",
+	sprintf (msg,
+	         _("Operands of comparison operator '%s' at %%L are %s/%s"),
 		 gfc_op2string (e->value.op.operator), gfc_typename (&op1->ts),
 		 gfc_typename (&op2->ts));
 
@@ -1527,10 +1551,10 @@ resolve_operator (gfc_expr * e)
 
     case INTRINSIC_USER:
       if (op2 == NULL)
-	sprintf (msg, "Operand of user operator '%s' at %%L is %s",
+	sprintf (msg, _("Operand of user operator '%s' at %%L is %s"),
 		 e->value.op.uop->name, gfc_typename (&op1->ts));
       else
-	sprintf (msg, "Operands of user operator '%s' at %%L are %s/%s",
+	sprintf (msg, _("Operands of user operator '%s' at %%L are %s/%s"),
 		 e->value.op.uop->name, gfc_typename (&op1->ts),
 		 gfc_typename (&op2->ts));
 
@@ -2342,24 +2366,26 @@ gfc_resolve_expr (gfc_expr * e)
    INTEGER or (optionally) REAL type.  */
 
 static try
-gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok, const char * name)
+gfc_resolve_iterator_expr (gfc_expr * expr, bool real_ok,
+			   const char * name_msgid)
 {
   if (gfc_resolve_expr (expr) == FAILURE)
     return FAILURE;
 
   if (expr->rank != 0)
     {
-      gfc_error ("%s at %L must be a scalar", name, &expr->where);
+      gfc_error ("%s at %L must be a scalar", _(name_msgid), &expr->where);
       return FAILURE;
     }
 
   if (!(expr->ts.type == BT_INTEGER
 	|| (expr->ts.type == BT_REAL && real_ok)))
     {
-      gfc_error ("%s at %L must be INTEGER%s",
-		 name,
-		 &expr->where,
-		 real_ok ? " or REAL" : "");
+      if (real_ok)
+	gfc_error ("%s at %L must be INTEGER or REAL", _(name_msgid),
+		   &expr->where);
+      else
+	gfc_error ("%s at %L must be INTEGER", _(name_msgid), &expr->where);
       return FAILURE;
     }
   return SUCCESS;
@@ -4147,9 +4173,12 @@ resolve_symbol (gfc_symbol * sym)
 	  || sym->as->type == AS_ASSUMED_SHAPE)
       && sym->attr.dummy == 0)
     {
-      gfc_error ("Assumed %s array at %L must be a dummy argument",
-		 sym->as->type == AS_ASSUMED_SIZE ? "size" : "shape",
-                 &sym->declared_at);
+      if (sym->as->type == AS_ASSUMED_SIZE)
+	gfc_error ("Assumed size array at %L must be a dummy argument",
+		   &sym->declared_at);
+      else
+	gfc_error ("Assumed shape array at %L must be a dummy argument",
+		   &sym->declared_at);
       return;
     }
 
@@ -4265,15 +4294,15 @@ resolve_symbol (gfc_symbol * sym)
       /* Can the sybol have an initializer?  */
       whynot = NULL;
       if (sym->attr.allocatable)
-	whynot = "Allocatable";
+	whynot = _("Allocatable");
       else if (sym->attr.external)
-	whynot = "External";
+	whynot = _("External");
       else if (sym->attr.dummy)
-	whynot = "Dummy";
+	whynot = _("Dummy");
       else if (sym->attr.intrinsic)
-	whynot = "Intrinsic";
+	whynot = _("Intrinsic");
       else if (sym->attr.result)
-	whynot = "Function Result";
+	whynot = _("Function Result");
       else if (sym->attr.dimension && !sym->attr.pointer)
 	{
 	  /* Don't allow initialization of automatic arrays.  */
@@ -4284,7 +4313,7 @@ resolve_symbol (gfc_symbol * sym)
 		  || sym->as->upper[i] == NULL
 		  || sym->as->upper[i]->expr_type != EXPR_CONSTANT)
 		{
-		  whynot = "Automatic array";
+		  whynot = _("Automatic array");
 		  break;
 		}
 	    }

gcc/fortran/symbol.c

@@ -905,9 +905,8 @@ gfc_add_procedure (symbol_attribute * attr, procedure_type t,
 
   if (attr->proc != PROC_UNKNOWN)
     {
-      gfc_error ("%s procedure at %L is already %s %s procedure",
+      gfc_error ("%s procedure at %L is already declared as %s procedure",
 		 gfc_code2string (procedures, t), where,
-		 gfc_article (gfc_code2string (procedures, attr->proc)),
 		 gfc_code2string (procedures, attr->proc));
 
       return FAILURE;

gcc/fortran/trans-const.c

@@ -86,12 +86,13 @@ gfc_build_string_const (int length, const char *s)
   return str;
 }
 
-/* Build a Fortran character constant from a zero-terminated string.  */
-
+/* Build a Fortran character constant from a zero-terminated string.
+   Since this is mainly used for error messages, the string will get
+   translated.  */
 tree
-gfc_build_cstring_const (const char *s)
+gfc_build_cstring_const (const char *msgid)
 {
-  return gfc_build_string_const (strlen (s) + 1, s);
+  return gfc_build_string_const (strlen (msgid) + 1, _(msgid));
 }
 
 /* Return a string constant with the given length.  Used for static

gcc/po/ChangeLog

+2005-09-17  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	PR fortran/15586
+	* exgettext: Add a new nocmsgid convention for arguments
+	that should be marked as no-c-format.
+	* gcc.pot: Regenerate.
+
 2005-09-13  Joseph S. Myers  <joseph@codesourcery.com>
 
 	* zh_CN.po: Update.

gcc/po/exgettext

@@ -108,6 +108,8 @@ function keyword_option(line) {
     format=""
     if (args ~ /g$/)
     	format="gcc-internal-format"
+    else if (args ~ /noc$/)
+        format="no-c-format"
     else if (args ~ /c$/)
     	format="c-format"