Fortran : Fortran translation issues PR52279

Mark strings for translation by enclosing in G_() and _().

2020-06-24  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/fortran/

	PR fortran/52279
	* arith.c (reduce_binary_aa): Mark for translation the string
	parameter to gfc_check_conformance with G_().
	* check.c (gfc_invalid_boz): Mark hint for translation using
	_().  (gfc_check_achar): Mark for translation the message
	parameter to gfc_invalid_boz using G_().  (gfc_check_char):
	Mark for translation the message parameter to gfc_invalid_boz
	using G_().  (gfc_check_complex): Mark for translation the
	message parameter to gfc_invalid_boz using G_().
	(gfc_check_float): Mark for translation the message
	parameter to gfc_invalid_boz using G_().  (check_rest): Mark
	for translation the string parameter to gfc_check_conformance
	with _().  (gfc_check_minloc_maxloc): Mark for translation
	the string parameter to gfc_check_conformance with _().
	(gfc_check_findloc): Mark for translation the string parameter
	to gfc_check_conformance with _().  (check_reduction): Mark
	for translation the string parameter to gfc_check_conformance
	with _().  (gfc_check_pack): Mark for translation the string
	parameter to gfc_check_conformance with _().
	* decl.c (match_old_style_init): Mark for translation the
	message parameter to gfc_invalid_boz using G_().
	* expr.c (gfc_check_assign): Mark for translation the string
	parameter to gfc_check_conformance with _().
	* intrinsic.c (check_specific): Mark for translation the string
	parameter to gfc_check_conformance with _().
	(gfc_check_intrinsic_standard): Mark symstd_msg strings for
	translation using G_(). No need to mark symstd_msg for
	translation in call to gfc_warning or when setting symstd.
	* io.c (check_open_constraints):  Mark strings for translation
	using G_() in all calls to warn_or_error.  (match_io_element):
	Mark for translation the message parameter to gfc_invalid_boz
	using G_().
	* primary.c (match_boz_constant): Mark for translation the
	message parameter to gfc_invalid_boz using G_().
	* resolve.c (resolve_elemental_actual):  Mark for translation
	the string parameter to gfc_check_conformance with _().
	(resolve_operator):  Mark for translation the string parameter
	to gfc_check_conformance with _().  Mark translation strings
	assigned to msg using G_() for use in a call to cfg_warning.

diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.c
index f76e19640a3b1e6ad4cc0545b4485844c2b3f33f..c4c1041afdf1093c46ea082e7e96eda1537b2ecd 100644 (file)
--- a/gcc/fortran/arith.c
+++ b/gcc/fortran/arith.c
@@ -1387,7 +1387,7 @@ reduce_binary_aa (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **),
   gfc_expr *r;
   arith rc = ARITH_OK;
 
-  if (!gfc_check_conformance (op1, op2, "elemental binary operation"))
+  if (!gfc_check_conformance (op1, op2, _("elemental binary operation")))
     return ARITH_INCOMMENSURATE;
 
   head = gfc_constructor_copy (op1->value.constructor);

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index de9a45fe4f939ca676db9ddecdc969adde3333f5..d0ec3796f7bc4f51085ced45dcf0fc08f048bae5 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -67,7 +67,7 @@ gfc_invalid_boz (const char *msg, locus *loc)
       return false;
     }
 
-  const char hint[] = " [see %<-fno-allow-invalid-boz%>]";
+  const char hint[] = _(" [see %<-fno-allow-invalid-boz%>]");
   size_t len = strlen (msg) + strlen (hint) + 1;
   char *msg2 = (char *) alloca (len);
   strcpy (msg2, msg);
@@ -1313,8 +1313,8 @@ gfc_check_achar (gfc_expr *a, gfc_expr *kind)
 {
   if (a->ts.type == BT_BOZ)
     {
-      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
-                          "ACHAR intrinsic subprogram", &a->where))
+      if (gfc_invalid_boz (G_("BOZ literal constant at %L cannot appear in "
+                          "ACHAR intrinsic subprogram"), &a->where))
        return false;
 
       if (!gfc_boz2int (a, gfc_default_integer_kind))
@@ -1973,8 +1973,8 @@ gfc_check_char (gfc_expr *i, gfc_expr *kind)
 {
   if (i->ts.type == BT_BOZ)
     {
-      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
-                          "CHAR intrinsic subprogram", &i->where))
+      if (gfc_invalid_boz (G_("BOZ literal constant at %L cannot appear in "
+                          "CHAR intrinsic subprogram"), &i->where))
        return false;
 
       if (!gfc_boz2int (i, gfc_default_integer_kind))
@@ -2424,8 +2424,8 @@ gfc_check_complex (gfc_expr *x, gfc_expr *y)
 
   if (x->ts.type == BT_BOZ)
     {
-      if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
-                          "intrinsic subprogram", &x->where))
+      if (gfc_invalid_boz (G_("BOZ constant at %L cannot appear in the COMPLEX"
+                          " intrinsic subprogram"), &x->where))
        {
          reset_boz (x);
          return false;
@@ -2438,8 +2438,8 @@ gfc_check_complex (gfc_expr *x, gfc_expr *y)
 
   if (y->ts.type == BT_BOZ)
     {
-      if (gfc_invalid_boz ("BOZ constant at %L cannot appear in the COMPLEX "
-                          "intrinsic subprogram", &y->where))
+      if (gfc_invalid_boz (G_("BOZ constant at %L cannot appear in the COMPLEX"
+                          " intrinsic subprogram"), &y->where))
        {
          reset_boz (y);
          return false;
@@ -2903,8 +2903,8 @@ gfc_check_float (gfc_expr *a)
 {
   if (a->ts.type == BT_BOZ)
     {
-      if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in the "
-                          "FLOAT intrinsic subprogram", &a->where))
+      if (gfc_invalid_boz (G_("BOZ literal constant at %L cannot appear in the"
+                          " FLOAT intrinsic subprogram"), &a->where))
        {
          reset_boz (a);
          return false;
@@ -3706,8 +3706,8 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist)
 
       for (tmp = arglist, m=1; tmp != arg; tmp = tmp->next, m++)
        if (!gfc_check_conformance (tmp->expr, x,
-                                   "arguments 'a%d' and 'a%d' for "
-                                   "intrinsic '%s'", m, n,
+                                   _("arguments 'a%d' and 'a%d' for "
+                                   "intrinsic '%s'"), m, n,
                                    gfc_current_intrinsic))
            return false;
     }
@@ -3914,7 +3914,7 @@ gfc_check_minloc_maxloc (gfc_actual_arglist *ap)
 
   if (m != NULL
       && !gfc_check_conformance (a, m,
-                                "arguments '%s' and '%s' for intrinsic %s",
+                                _("arguments '%s' and '%s' for intrinsic %s"),
                                 gfc_current_intrinsic_arg[0]->name,
                                 gfc_current_intrinsic_arg[2]->name,
                                 gfc_current_intrinsic))
@@ -3995,7 +3995,7 @@ gfc_check_findloc (gfc_actual_arglist *ap)
 
   if (m != NULL
       && !gfc_check_conformance (a, m,
-                                "arguments '%s' and '%s' for intrinsic %s",
+                                _("arguments '%s' and '%s' for intrinsic %s"),
                                 gfc_current_intrinsic_arg[0]->name,
                                 gfc_current_intrinsic_arg[3]->name,
                                 gfc_current_intrinsic))
@@ -4060,7 +4060,7 @@ check_reduction (gfc_actual_arglist *ap)
 
   if (m != NULL
       && !gfc_check_conformance (a, m,
-                                "arguments '%s' and '%s' for intrinsic %s",
+                                _("arguments '%s' and '%s' for intrinsic %s"),
                                 gfc_current_intrinsic_arg[0]->name,
                                 gfc_current_intrinsic_arg[2]->name,
                                 gfc_current_intrinsic))
@@ -4398,7 +4398,7 @@ gfc_check_pack (gfc_expr *array, gfc_expr *mask, gfc_expr *vector)
     return false;
 
   if (!gfc_check_conformance (array, mask,
-                             "arguments '%s' and '%s' for intrinsic '%s'",
+                             _("arguments '%s' and '%s' for intrinsic '%s'"),
                              gfc_current_intrinsic_arg[0]->name,
                              gfc_current_intrinsic_arg[1]->name,
                              gfc_current_intrinsic))

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index e16b96f6a49896613a59bdcd6b1423fa0eb524c1..52c2a624b6e31608671a9ce9cafbda67f186d181 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -576,16 +576,16 @@ match_old_style_init (const char *name)
   for (nd = newdata; nd; nd = nd->next)
     {
       if (nd->value->expr->ts.type == BT_BOZ
-         && gfc_invalid_boz ("BOZ at %L cannot appear in an old-style "
-                             "initialization", &nd->value->expr->where))
+         && gfc_invalid_boz (G_("BOZ at %L cannot appear in an old-style "
+                             "initialization"), &nd->value->expr->where))
        return MATCH_ERROR;
 
       if (nd->var->expr->ts.type != BT_INTEGER
          && nd->var->expr->ts.type != BT_REAL
          && nd->value->expr->ts.type == BT_BOZ)
        {
-         gfc_error ("BOZ literal constant near %L cannot be assigned to "
-                    "a %qs variable in an old-style initialization",
+         gfc_error (G_("BOZ literal constant near %L cannot be assigned to "
+                    "a %qs variable in an old-style initialization"),
                     &nd->value->expr->where,
                     gfc_typename (&nd->value->expr->ts));
          return MATCH_ERROR;

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 8daa7bb8d0662f5fc3e388ad4a5dcb135cdf44db..5bef65df86279f9a7042968a58b1033e733bcd4c 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3693,7 +3693,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
 
   /* Check size of array assignments.  */
   if (lvalue->rank != 0 && rvalue->rank != 0
-      && !gfc_check_conformance (lvalue, rvalue, "array assignment"))
+      && !gfc_check_conformance (lvalue, rvalue, _("array assignment")))
     return false;
 
   /* Handle the case of a BOZ literal on the RHS.  */

diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index 30f9f14572b0387b04f8bb9c47dbfe88845a83a6..3518a4e2c87cc52e201b8d1bc1556930534e8f71 100644 (file)
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -4775,8 +4775,8 @@ check_specific (gfc_intrinsic_sym *specific, gfc_expr *expr, int error_flag)
 
       for ( ; arg && arg->expr; arg = arg->next, n++)
        if (!gfc_check_conformance (first_expr, arg->expr,
-                                   "arguments '%s' and '%s' for "
-                                   "intrinsic '%s'",
+                                   _("arguments '%s' and '%s' for "
+                                   "intrinsic '%s'"),
                                    gfc_current_intrinsic_arg[0]->name,
                                    gfc_current_intrinsic_arg[n]->name,
                                    gfc_current_intrinsic))
@@ -4812,39 +4812,39 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
   switch (isym->standard)
     {
     case GFC_STD_F77:
-      symstd_msg = "available since Fortran 77";
+      symstd_msg = _("available since Fortran 77");
       break;
 
     case GFC_STD_F95_OBS:
-      symstd_msg = "obsolescent in Fortran 95";
+      symstd_msg = _("obsolescent in Fortran 95");
       break;
 
     case GFC_STD_F95_DEL:
-      symstd_msg = "deleted in Fortran 95";
+      symstd_msg = _("deleted in Fortran 95");
       break;
 
     case GFC_STD_F95:
-      symstd_msg = "new in Fortran 95";
+      symstd_msg = _("new in Fortran 95");
       break;
 
     case GFC_STD_F2003:
-      symstd_msg = "new in Fortran 2003";
+      symstd_msg = _("new in Fortran 2003");
       break;
 
     case GFC_STD_F2008:
-      symstd_msg = "new in Fortran 2008";
+      symstd_msg = _("new in Fortran 2008");
       break;
 
     case GFC_STD_F2018:
-      symstd_msg = "new in Fortran 2018";
+      symstd_msg = _("new in Fortran 2018");
       break;
 
     case GFC_STD_GNU:
-      symstd_msg = "a GNU Fortran extension";
+      symstd_msg = _("a GNU Fortran extension");
       break;
 
     case GFC_STD_LEGACY:
-      symstd_msg = "for backward compatibility";
+      symstd_msg = _("for backward compatibility");
       break;
 
     default:
@@ -4857,8 +4857,8 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
     {
       /* Do only print a warning if not a GNU extension.  */
       if (!silent && isym->standard != GFC_STD_GNU)
-       gfc_warning (0, "Intrinsic %qs (is %s) is used at %L",
-                    isym->name, _(symstd_msg), &where);
+       gfc_warning (0, "Intrinsic %qs (%s) used at %L",
+                    isym->name, symstd_msg, &where);
 
       return true;
     }
@@ -4869,7 +4869,7 @@ gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
 
   /* Otherwise, fail.  */
   if (symstd)
-    *symstd = _(symstd_msg);
+    *symstd = symstd_msg;
   return false;
 }
 

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 981cf9e88ddeb7433436f25b47e47bdbef6261d3..b350cd9389ccd53cfb9fe38d582dbe0876d6b6da 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2406,7 +2406,7 @@ check_open_constraints (gfc_open *open, locus *where)
       && open->recl->ts.type == BT_INTEGER
       && mpz_sgn (open->recl->value.integer) != 1)
     {
-      warn_or_error ("RECL in OPEN statement at %L must be positive",
+      warn_or_error (G_("RECL in OPEN statement at %L must be positive"),
                     &open->recl->where);
     }
 
@@ -2431,8 +2431,8 @@ check_open_constraints (gfc_open *open, locus *where)
        {
          char *s = gfc_widechar_to_char (open->status->value.character.string,
                                          -1);
-         warn_or_error ("The STATUS specified in OPEN statement at %L is "
-                        "%qs and no FILE specifier is present",
+         warn_or_error (G_("The STATUS specified in OPEN statement at %L is "
+                        "%qs and no FILE specifier is present"),
                         &open->status->where, s);
          free (s);
        }
@@ -2442,9 +2442,9 @@ check_open_constraints (gfc_open *open, locus *where)
       if (gfc_wide_strncasecmp (open->status->value.character.string,
                                "scratch", 7) == 0 && open->file)
        {
-         warn_or_error ("The STATUS specified in OPEN statement at %L "
+         warn_or_error (G_("The STATUS specified in OPEN statement at %L "
                         "cannot have the value SCRATCH if a FILE specifier "
-                        "is present", &open->status->where);
+                        "is present"), &open->status->where);
        }
     }
 
@@ -2506,16 +2506,16 @@ check_open_constraints (gfc_open *open, locus *where)
          spec = "";
        }
 
-      warn_or_error ("%s specifier at %L not allowed in OPEN statement for "
-                    "unformatted I/O", spec, loc);
+      warn_or_error (G_("%s specifier at %L not allowed in OPEN statement for "
+                    "unformatted I/O"), spec, loc);
     }
 
   if (open->recl && open->access && open->access->expr_type == EXPR_CONSTANT
       && gfc_wide_strncasecmp (open->access->value.character.string,
                               "stream", 6) == 0)
     {
-      warn_or_error ("RECL specifier not allowed in OPEN statement at %L for "
-                    "stream I/O", &open->recl->where);
+      warn_or_error (G_("RECL specifier not allowed in OPEN statement at %L for "
+                    "stream I/O"), &open->recl->where);
     }
 
   if (open->position
@@ -2527,8 +2527,8 @@ check_open_constraints (gfc_open *open, locus *where)
           || gfc_wide_strncasecmp (open->access->value.character.string,
                                    "append", 6) == 0))
     {
-      warn_or_error ("POSITION specifier in OPEN statement at %L only allowed "
-                    "for stream or sequential ACCESS", &open->position->where);
+      warn_or_error (G_("POSITION specifier in OPEN statement at %L only allowed "
+                    "for stream or sequential ACCESS"), &open->position->where);
     }
 
   return true;
@@ -3665,8 +3665,8 @@ match_io_element (io_kind k, gfc_code **cpp)
 
       if (m == MATCH_YES && expr->ts.type == BT_BOZ)
        {
-         if (gfc_invalid_boz ("BOZ literal constant at %L cannot appear in "
-                               "an output IO list", &gfc_current_locus))
+         if (gfc_invalid_boz (G_("BOZ literal constant at %L cannot appear in"
+                               " an output IO list"), &gfc_current_locus))
            return MATCH_ERROR;
          if (!gfc_boz2int (expr, gfc_max_integer_kind))
            return MATCH_ERROR;

diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.c
index 7c221c8d209727bcdfb832dfd0bbc11e90c6a448..76b1607ee3d2eecffa49e3cf7b23ae736306a54c 100644 (file)
--- a/gcc/fortran/primary.c
+++ b/gcc/fortran/primary.c
@@ -432,8 +432,8 @@ match_boz_constant (gfc_expr **result)
     goto backup;
 
   if (x_hex
-      && gfc_invalid_boz ("Hexadecimal constant at %L uses "
-                         "nonstandard X instead of Z", &gfc_current_locus))
+      && gfc_invalid_boz (G_("Hexadecimal constant at %L uses "
+                         "nonstandard X instead of Z"), &gfc_current_locus))
     return MATCH_ERROR;
 
   old_loc = gfc_current_locus;
@@ -470,8 +470,8 @@ match_boz_constant (gfc_expr **result)
          goto backup;
        }
 
-      if (gfc_invalid_boz ("BOZ constant at %C uses nonstandard postfix "
-                          "syntax", &gfc_current_locus))
+      if (gfc_invalid_boz (G_("BOZ constant at %C uses nonstandard postfix "
+                          "syntax"), &gfc_current_locus))
        return MATCH_ERROR;
     }
 

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2a164055ffcd8a56e8184fe0656a59257e7cf6cb..1952b53d8216816b625abe39a3c1a2c207df85cb 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2315,7 +2315,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
       /* Elemental procedure's array actual arguments must conform.  */
       if (e != NULL)
        {
-         if (!gfc_check_conformance (arg->expr, e, "elemental procedure"))
+         if (!gfc_check_conformance (arg->expr, e, _("elemental procedure")))
            return false;
        }
       else
@@ -4190,9 +4190,9 @@ resolve_operator (gfc_expr *e)
       /* If op1 is BOZ, then op2 is not!.  Try to convert to type of op2.  */
       if (op1->ts.type == BT_BOZ)
        {
-         if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
-                               "an operand of a relational operator",
-                               &op1->where))
+         if (gfc_invalid_boz (G_("BOZ literal constant near %L cannot appear "
+                              "as an operand of a relational operator"),
+                              &op1->where))
            return false;
 
          if (op2->ts.type == BT_INTEGER && !gfc_boz2int (op1, op2->ts.kind))
@@ -4205,8 +4205,8 @@ resolve_operator (gfc_expr *e)
       /* If op2 is BOZ, then op1 is not!.  Try to convert to type of op2. */
       if (op2->ts.type == BT_BOZ)
        {
-         if (gfc_invalid_boz ("BOZ literal constant near %L cannot appear as "
-                               "an operand of a relational operator",
+         if (gfc_invalid_boz (G_("BOZ literal constant near %L cannot appear"
+                              " as an operand of a relational operator"),
                                &op2->where))
            return false;
 
@@ -4244,9 +4244,9 @@ resolve_operator (gfc_expr *e)
                  const char *msg;
 
                  if (op == INTRINSIC_EQ || op == INTRINSIC_EQ_OS)
-                   msg = "Equality comparison for %s at %L";
+                   msg = G_("Equality comparison for %s at %L");
                  else
-                   msg = "Inequality comparison for %s at %L";
+                   msg = G_("Inequality comparison for %s at %L");
 
                  gfc_warning (OPT_Wcompare_reals, msg,
                               gfc_typename (op1), &op1->where);