This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[gfortran,patch] Internationalisation of the Fortran front-end


Send this again to gcc-patches: original was refused since the attachement (gcc.pot) was too large, it's now compressed. But it passed to the fortran ml, i still wonder why...

-------------
Hi all,

Attached is a patch (i18n.diff) that adds internationalization to the
fortran front-end: it enables the compiler to issue localised error and
warning messages. This is done in two complementary ways:

   1. Messages issued by gfc_error, gfc_warning and other functions
called on constant strings are translated using the msgid convention.
That is, developpers will not have to worry about the localization of
such messages.

   2. Some of the messages are handled in a... rudimentary way. For
those, I added manual translation macros: _(). For example, see changes
in arith.c

Finally, I removed some nasty very english-specific constructions: exit
gfc_article()!

I think while this is not a vital feature (although some will argue that
localisation is an important composant of the GNU project), the earlier
it can go in, the less work for the translators (and the better the
translation).

Built and regtested on i686-linux.
OK for 4.1? (and do we want it for 4.0)


FX


PS: I don't know if a complete ChangeLog is needed, or if I can just
list the files and functions and say "Added localisation support". I
added the gcc.pot generated with maintainer mode, so that you can check
it if you want.

Index: gcc/fortran/arith.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/arith.c,v
retrieving revision 1.30
diff -u -3 -p -r1.30 arith.c
--- gcc/fortran/arith.c	7 Jul 2005 07:54:41 -0000	1.30
+++ gcc/fortran/arith.c	30 Aug 2005 19:15:05 -0000
@@ -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");
Index: gcc/fortran/array.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/array.c,v
retrieving revision 1.18
diff -u -3 -p -r1.18 array.c
--- gcc/fortran/array.c	14 Jul 2005 01:37:41 -0000	1.18
+++ gcc/fortran/array.c	30 Aug 2005 19:15:05 -0000
@@ -169,8 +169,8 @@ gfc_match_array_ref (gfc_array_ref * ar,
 	}
     }
 
-  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 ** 
 
       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;
 	}
 
Index: gcc/fortran/check.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/check.c,v
retrieving revision 1.33
diff -u -3 -p -r1.33 check.c
--- gcc/fortran/check.c	9 Aug 2005 17:33:10 -0000	1.33
+++ gcc/fortran/check.c	30 Aug 2005 19:15:05 -0000
@@ -37,11 +37,11 @@ Software Foundation, 51 Franklin Street,
    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, gf
   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 ran
   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, i
   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
         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, gf
 
   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
 {
   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;
     }
 
Index: gcc/fortran/error.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/error.c,v
retrieving revision 1.15
diff -u -3 -p -r1.15 error.c
--- gcc/fortran/error.c	14 Jul 2005 10:12:15 -0000	1.15
+++ gcc/fortran/error.c	30 Aug 2005 19:15:05 -0000
@@ -449,12 +449,12 @@ error_print (const char *type, const cha
 /* Wrapper for error_print().  */
 
 static void
-error_printf (const char *format, ...)
+error_printf (const char *gmsgid, ...)
 {
   va_list argp;
 
-  va_start (argp, format);
-  error_print ("", format, argp);
+  va_start (argp, gmsgid);
+  error_print ("", _(gmsgid), 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 *gmsgid, ...)
 {
   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, gmsgid);
   if (buffer_flag == 0)
     warnings++;
-  error_print ("Warning:", format, argp);
+  error_print (_("Warning:"), _(gmsgid), 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 *gmsgid, ...)
 {
   va_list argp;
   bool warning;
@@ -514,11 +514,11 @@ gfc_notify_std (int std, const char *for
       else
 	errors++;
     }
-  va_start (argp, format);
+  va_start (argp, gmsgid);
   if (warning)
-    error_print ("Warning:", format, argp);
+    error_print (_("Warning:"), _(gmsgid), argp);
   else
-    error_print ("Error:", format, argp);
+    error_print (_("Error:"), _(gmsgid), argp);
   va_end (argp);
 
   error_char ('\0');
@@ -529,7 +529,7 @@ gfc_notify_std (int std, const char *for
 /* Immediate warning (i.e. do not buffer the warning).  */
 
 void
-gfc_warning_now (const char *format, ...)
+gfc_warning_now (const char *gmsgid, ...)
 {
   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, gmsgid);
+  error_print (_("Warning:"), _(gmsgid), 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 *gmsgid, ...)
 {
   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, gmsgid);
   if (buffer_flag == 0)
     errors++;
-  error_print ("Error:", format, argp);
+  error_print (_("Error:"), _(gmsgid), 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 *gmsgid, ...)
 {
   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, gmsgid);
+  error_print (_("Error:"), _(gmsgid), 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 *gmsgid, ...)
 {
   va_list argp;
 
   buffer_flag = 0;
 
-  va_start (argp, format);
-  error_print ("Fatal Error:", format, argp);
+  va_start (argp, gmsgid);
+  error_print (_("Fatal Error:"), _(gmsgid), 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);
 }
Index: gcc/fortran/expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/expr.c,v
retrieving revision 1.28
diff -u -3 -p -r1.28 expr.c
--- gcc/fortran/expr.c	3 Aug 2005 01:55:37 -0000	1.28
+++ gcc/fortran/expr.c	30 Aug 2005 19:15:05 -0000
@@ -255,15 +255,15 @@ gfc_extract_int (gfc_expr * expr, int *r
 {
 
   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 *optyp
 
   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 *optyp
       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 * lva
 
   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 * lva
   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);
     }
 
Index: gcc/fortran/gfortran.h
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.81
diff -u -3 -p -r1.81 gfortran.h
--- gcc/fortran/gfortran.h	19 Aug 2005 09:05:03 -0000	1.81
+++ gcc/fortran/gfortran.h	30 Aug 2005 19:15:06 -0000
@@ -30,6 +30,7 @@ Software Foundation, 51 Franklin Street,
    time I looked, so by comparison this is perfectly reasonable.  */
 
 #include "system.h"
+#include "intl.h"
 #include "coretypes.h"
 #include "input.h"
 
@@ -1519,7 +1520,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 *);
 
Index: gcc/fortran/gfortranspec.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/gfortranspec.c,v
retrieving revision 1.9
diff -u -3 -p -r1.9 gfortranspec.c
--- gcc/fortran/gfortranspec.c	25 Jun 2005 00:40:34 -0000	1.9
+++ gcc/fortran/gfortranspec.c	30 Aug 2005 19:15:06 -0000
@@ -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,7 +346,7 @@ lang_specific_driver (int *in_argc, cons
 	  break;
 
 	case OPTION_version:
-	  printf ("\
+	  printf (_("\
 GNU Fortran 95 (GCC %s)\n\
 Copyright (C) 2005 Free Software Foundation, Inc.\n\
 \n\
@@ -353,7 +354,7 @@ GNU Fortran comes with NO WARRANTY, to t
 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);
+"), version_string);
 	  exit (0);
 	  break;
 
@@ -528,7 +529,7 @@ For more information about these matters
 
   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");
Index: gcc/fortran/io.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/io.c,v
retrieving revision 1.30
diff -u -3 -p -r1.30 io.c
--- gcc/fortran/io.c	14 Aug 2005 16:15:39 -0000	1.30
+++ gcc/fortran/io.c	30 Aug 2005 19:15:07 -0000
@@ -400,11 +400,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;
@@ -421,7 +421,7 @@ check_format (void)
   t = format_lex ();
   if (t != FMT_LPAREN)
     {
-      error = "Missing leading left parenthesis";
+      error = _("Missing leading left parenthesis");
       goto syntax;
     }
 
@@ -459,7 +459,7 @@ format_item_1:
       t = format_lex ();
       if (t != FMT_P)
 	{
-	  error = "Expected P edit descriptor";
+	  error = _("Expected P edit descriptor");
 	  goto syntax;
 	}
 
@@ -467,7 +467,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:
@@ -497,7 +497,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;
 	}
 
@@ -542,7 +542,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;
 	    }
 
@@ -605,7 +605,7 @@ data_desc:
 	  u = format_lex ();
 	  if (u != FMT_POSINT)
 	    {
-	      error = "Positive exponent width required";
+	      error = _("Positive exponent width required");
 	      goto syntax;
 	    }
 	}
Index: gcc/fortran/matchexp.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/matchexp.c,v
retrieving revision 1.10
diff -u -3 -p -r1.10 matchexp.c
--- gcc/fortran/matchexp.c	22 Jul 2005 07:31:17 -0000	1.10
+++ gcc/fortran/matchexp.c	30 Aug 2005 19:15:07 -0000
@@ -26,7 +26,7 @@ Software Foundation, 51 Franklin Street,
 #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
Index: gcc/fortran/misc.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/misc.c,v
retrieving revision 1.10
diff -u -3 -p -r1.10 misc.c
--- gcc/fortran/misc.c	7 Jul 2005 07:54:42 -0000	1.10
+++ gcc/fortran/misc.c	30 Aug 2005 19:15:07 -0000
@@ -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 *
Index: gcc/fortran/module.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/module.c,v
retrieving revision 1.35
diff -u -3 -p -r1.35 module.c
--- gcc/fortran/module.c	19 Aug 2005 09:05:03 -0000	1.35
+++ gcc/fortran/module.c	30 Aug 2005 19:15:07 -0000
@@ -788,27 +788,25 @@ static char *atom_string, atom_name[MAX_
 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);
 }
 
 
@@ -1115,19 +1113,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");
Index: gcc/fortran/parse.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/parse.c,v
retrieving revision 1.30
diff -u -3 -p -r1.30 parse.c
--- gcc/fortran/parse.c	14 Aug 2005 21:45:03 -0000	1.30
+++ gcc/fortran/parse.c	30 Aug 2005 19:15:07 -0000
@@ -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:
Index: gcc/fortran/primary.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/primary.c,v
retrieving revision 1.34
diff -u -3 -p -r1.34 primary.c
--- gcc/fortran/primary.c	6 Aug 2005 19:18:45 -0000	1.34
+++ gcc/fortran/primary.c	30 Aug 2005 19:15:07 -0000
@@ -317,18 +317,18 @@ match_boz_constant (gfc_expr ** result)
     {
     case 'b':
       radix = 2;
-      rname = "binary";
+      rname = _("binary");
       break;
     case 'o':
       radix = 8;
-      rname = "octal";
+      rname = _("octal");
       break;
     case 'x':
       x_hex = 1;
       /* Fall through.  */
     case 'z':
       radix = 16;
-      rname = "hexadecimal";
+      rname = _("hexadecimal");
       break;
     default:
       goto backup;
@@ -351,7 +351,7 @@ 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);
+      gfc_error ("Empty set of digits in %s constant at %C", rname);
       return MATCH_ERROR;
     }
 
Index: gcc/fortran/resolve.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.51
diff -u -3 -p -r1.51 resolve.c
--- gcc/fortran/resolve.c	10 Aug 2005 20:16:26 -0000	1.51
+++ gcc/fortran/resolve.c	30 Aug 2005 19:15:07 -0000
@@ -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;
 		}
 	    }
Index: gcc/fortran/symbol.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/symbol.c,v
retrieving revision 1.32
diff -u -3 -p -r1.32 symbol.c
--- gcc/fortran/symbol.c	3 Jul 2005 18:39:20 -0000	1.32
+++ gcc/fortran/symbol.c	30 Aug 2005 19:15:08 -0000
@@ -904,9 +904,8 @@ gfc_add_procedure (symbol_attribute * at
 
   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;
Index: gcc/fortran/trans-const.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-const.c,v
retrieving revision 1.29
diff -u -3 -p -r1.29 trans-const.c
--- gcc/fortran/trans-const.c	7 Jul 2005 07:54:43 -0000	1.29
+++ gcc/fortran/trans-const.c	30 Aug 2005 19:15:09 -0000
@@ -86,12 +86,13 @@ gfc_build_string_const (int length, cons
   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

Attachment: gcc.pot.gz
Description: GNU Zip compressed data


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]