OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Francois-Xavier Coudert 2005-09-17 20:58:01 +02:00 committed by François-Xavier Coudert
parent 652b0932d7
commit 31043f6cfc
20 changed files with 9541 additions and 5545 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
gcc/fortran/ChangeLog
View File

@ -1,3 +1,48 @@
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

14
gcc/fortran/arith.c
View File

@ -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");

8
gcc/fortran/array.c
View File

@ -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;
}

23
gcc/fortran/check.c
View File

@ -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;
}

50
gcc/fortran/error.c
View File

@ -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);
}

21
gcc/fortran/expr.c
View File

@ -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);
}

2
gcc/fortran/gfortran.h
View File

@ -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 *);

15
gcc/fortran/gfortranspec.c
View File

@ -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");

22
gcc/fortran/io.c
View File

@ -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;
}
}

2
gcc/fortran/matchexp.c
View File

@ -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

30
gcc/fortran/misc.c
View File

@ -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 *

28
gcc/fortran/module.c
View File

@ -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");

44
gcc/fortran/parse.c
View File

@ -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:

28
gcc/fortran/primary.c
View File

@ -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;
}

99
gcc/fortran/resolve.c
View File

@ -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;
}
}

3
gcc/fortran/symbol.c
View File

@ -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;

9
gcc/fortran/trans-const.c
View File

@ -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

7
gcc/po/ChangeLog
View File

@ -1,3 +1,10 @@
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.

2
gcc/po/exgettext
View File

@ -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"

14634
gcc/po/gcc.pot
View File

File diff suppressed because it is too large Load Diff