From 21423a1dfa079d4cd218f69d2fab9fe65a69fedb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Fran=C3=A7ois-Xavier=20Coudert?= <fxcoudert@gcc.gnu.org>
Date: Thu, 16 Dec 2021 18:38:30 +0100
Subject: [PATCH] Fortran: Cast arguments of <ctype.h> functions to unsigned
 char
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Functions from <ctype.h> should only be called on values that can be
represented by unsigned char. On targets where char is a signed type,
some of libgfortran calls have undefined behaviour.

The solution is to cast the argument to unsigned char type. I’ve defined
macros in libgfortran.h to do so, to retain legibility of the library
code.

PR libfortran/95177

libgfortran/ChangeLog

	* libgfortran.h: include ctype.h, provide safe macros.
	* io/format.c: use safe macros.
	* io/list_read.c: use safe macros.
	* io/read.c: use safe macros.
	* io/write.c: use safe macros.
	* runtime/environ.c: use safe macros.
---
 libgfortran/io/format.c       |  9 ++++-----
 libgfortran/io/list_read.c    | 19 +++++++++----------
 libgfortran/io/read.c         |  9 ++++-----
 libgfortran/io/write.c        |  7 +++----
 libgfortran/libgfortran.h     | 15 +++++++++++++++
 libgfortran/runtime/environ.c |  5 ++---
 6 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 56f8dbd858a7..927e3785a34b 100644
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -29,7 +29,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include "io.h"
 #include "format.h"
-#include <ctype.h>
 #include <string.h>
 
 
@@ -193,7 +192,7 @@ next_char (format_data *fmt, int literal)
 	return -1;
 
       fmt->format_string_len--;
-      c = toupper (*fmt->format_string++);
+      c = safe_toupper (*fmt->format_string++);
       fmt->error_element = c;
     }
   while ((c == ' ' || c == '\t') && !literal);
@@ -328,7 +327,7 @@ format_lex (format_data *fmt)
 
     case '+':
       c = next_char (fmt, 0);
-      if (!isdigit (c))
+      if (!safe_isdigit (c))
 	{
 	  token = FMT_UNKNOWN;
 	  break;
@@ -339,7 +338,7 @@ format_lex (format_data *fmt)
       for (;;)
 	{
 	  c = next_char (fmt, 0);
-	  if (!isdigit (c))
+	  if (!safe_isdigit (c))
 	    break;
 
 	  fmt->value = 10 * fmt->value + c - '0';
@@ -367,7 +366,7 @@ format_lex (format_data *fmt)
       for (;;)
 	{
 	  c = next_char (fmt, 0);
-	  if (!isdigit (c))
+	  if (!safe_isdigit (c))
 	    break;
 
 	  fmt->value = 10 * fmt->value + c - '0';
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 8cc7ddbe8e23..f902ee4fe1de 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -29,7 +29,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "fbuf.h"
 #include "unix.h"
 #include <string.h>
-#include <ctype.h>
 
 typedef unsigned char uchar;
 
@@ -811,7 +810,7 @@ read_logical (st_parameter_dt *dtp, int length)
   if (parse_repeat (dtp))
     return;
 
-  c = tolower (next_char (dtp));
+  c = safe_tolower (next_char (dtp));
   l_push_char (dtp, c);
   switch (c)
     {
@@ -837,7 +836,7 @@ read_logical (st_parameter_dt *dtp, int length)
       break;
 
     case '.':
-      c = tolower (next_char (dtp));
+      c = safe_tolower (next_char (dtp));
       switch (c)
 	{
 	  case 't':
@@ -1052,7 +1051,7 @@ read_integer (st_parameter_dt *dtp, int length)
     }
 
  get_integer:
-  if (!isdigit (c))
+  if (!safe_isdigit (c))
     goto bad_integer;
   push_char (dtp, c);
 
@@ -1303,7 +1302,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
     c = '.';
 
-  if (!isdigit (c) && c != '.')
+  if (!safe_isdigit (c) && c != '.')
     {
       if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
 	goto inf_nan;
@@ -1377,7 +1376,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
     }
 
  exp2:
-  if (!isdigit (c))
+  if (!safe_isdigit (c))
     {
       /* Extension: allow default exponent of 0 when omitted.  */
       if (dtp->common.flags & IOPARM_DT_DEC_EXT)
@@ -1748,7 +1747,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
   if (c == ',' && dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA)
     c = '.';
 
-  if (!isdigit (c) && c != '.')
+  if (!safe_isdigit (c) && c != '.')
     {
       if (c == 'i' || c == 'I' || c == 'n' || c == 'N')
 	goto inf_nan;
@@ -1828,7 +1827,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
     }
 
  exp2:
-  if (!isdigit (c))
+  if (!safe_isdigit (c))
     {
       /* Extension: allow default exponent of 0 when omitted.  */
       if (dtp->common.flags & IOPARM_DT_DEC_EXT)
@@ -2757,7 +2756,7 @@ nml_match_name (st_parameter_dt *dtp, const char *name, index_type len)
   for (i = 0; i < len; i++)
     {
       c = next_char (dtp);
-      if (c == EOF || (tolower (c) != tolower (name[i])))
+      if (c == EOF || (safe_tolower (c) != safe_tolower (name[i])))
 	{
 	  dtp->u.p.nml_read_error = 1;
 	  break;
@@ -3286,7 +3285,7 @@ get_name:
   do
     {
       if (!is_separator (c))
-	push_char_default (dtp, tolower(c));
+	push_char_default (dtp, safe_tolower(c));
       if ((c = next_char (dtp)) == EOF)
 	goto nml_err_ret;
     }
diff --git a/libgfortran/io/read.c b/libgfortran/io/read.c
index 7515d912c514..7b3f137d687f 100644
--- a/libgfortran/io/read.c
+++ b/libgfortran/io/read.c
@@ -28,7 +28,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "format.h"
 #include "unix.h"
 #include <string.h>
-#include <ctype.h>
 #include <assert.h>
 #include "async.h"
 
@@ -959,7 +958,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 	 between "NaN" and the optional perenthesis is not permitted.  */
       while (w > 0)
 	{
-	  *out = tolower (*p);
+	  *out = safe_tolower (*p);
 	  switch (*p)
 	    {
 	    case ' ':
@@ -981,7 +980,7 @@ read_f (st_parameter_dt *dtp, const fnode *f, char *dest, int length)
 		goto bad_float;
 	      break;
 	    default:
-	      if (!isalnum (*out))
+	      if (!safe_isalnum (*out))
 		goto bad_float;
 	    }
 	  --w;
@@ -1109,7 +1108,7 @@ exponent:
 
   if (dtp->u.p.blank_status == BLANK_UNSPECIFIED)
     {
-      while (w > 0 && isdigit (*p))
+      while (w > 0 && safe_isdigit (*p))
 	{
 	  exponent *= 10;
 	  exponent += *p - '0';
@@ -1137,7 +1136,7 @@ exponent:
 	      else
 		assert (dtp->u.p.blank_status == BLANK_NULL);
 	    }
-	  else if (!isdigit (*p))
+	  else if (!safe_isdigit (*p))
 	    goto bad_float;
 	  else
 	    {
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 278cd47cabb3..b9e92845bcf7 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -30,7 +30,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 #include "unix.h"
 #include <assert.h>
 #include <string.h>
-#include <ctype.h>
 
 #define star_fill(p, n) memset(p, '*', n)
 
@@ -2101,14 +2100,14 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
 	  base_name_len = strlen (base_name);
 	  for (dim_i = 0; dim_i < base_name_len; dim_i++)
             {
-	      cup = toupper ((int) base_name[dim_i]);
+	      cup = safe_toupper (base_name[dim_i]);
 	      write_character (dtp, &cup, 1, 1, NODELIM);
             }
 	}
       clen = strlen (obj->var_name);
       for (dim_i = len; dim_i < clen; dim_i++)
 	{
-	  cup = toupper ((int) obj->var_name[dim_i]);
+	  cup = safe_toupper (obj->var_name[dim_i]);
 	  if (cup == '+')
 	    cup = '%';
 	  write_character (dtp, &cup, 1, 1, NODELIM);
@@ -2426,7 +2425,7 @@ namelist_write (st_parameter_dt *dtp)
   /* Write namelist name in upper case - f95 std.  */
   for (gfc_charlen_type i = 0; i < dtp->namelist_name_len; i++ )
     {
-      c = toupper ((int) dtp->namelist_name[i]);
+      c = safe_toupper (dtp->namelist_name[i]);
       write_character (dtp, &c, 1 ,1, NODELIM);
     }
 
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 285c36a00b54..93e3591b21fd 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -39,6 +39,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 /* config.h MUST be first because it can affect system headers.  */
 #include "config.h"
 
+#include <ctype.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <stddef.h>
@@ -103,6 +104,20 @@ typedef off_t gfc_offset;
 #endif
 
 
+/* These functions from <ctype.h> should only be used on values that can be
+   represented as unsigned char, otherwise the behavior is undefined.
+   Some targets have a char type that is signed, so we cast the argument
+   to unsigned char. See:
+     https://gcc.gnu.org/bugzilla/show_bug.cgi?id=95177
+     https://wiki.sei.cmu.edu/confluence/x/BNcxBQ
+ */
+
+#define safe_isalnum(x) isalnum((unsigned char) (x))
+#define safe_isdigit(x) isdigit((unsigned char) (x))
+#define safe_tolower(x) tolower((unsigned char) (x))
+#define safe_toupper(x) toupper((unsigned char) (x))
+
+
 /* The following macros can be used to annotate conditions which are likely or
    unlikely to be true.  Avoid using them when a condition is only slightly
    more likely/less unlikely than average to avoid the performance penalties of
diff --git a/libgfortran/runtime/environ.c b/libgfortran/runtime/environ.c
index fe16c080797e..ce408cf11af4 100644
--- a/libgfortran/runtime/environ.c
+++ b/libgfortran/runtime/environ.c
@@ -26,7 +26,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #include <string.h>
 #include <strings.h>
-#include <ctype.h>
 
 #ifdef HAVE_UNISTD_H
 #include <unistd.h>
@@ -91,7 +90,7 @@ init_integer (variable * v)
     return;
 
   for (q = p; *q; q++)
-    if (!isdigit (*q) && (p != q || *q != '-'))
+    if (!safe_isdigit (*q) && (p != q || *q != '-'))
       return;
 
   *v->var = atoi (p);
@@ -344,7 +343,7 @@ static int
 match_integer (void)
 {
   unit_num = 0;
-  while (isdigit (*p))
+  while (safe_isdigit (*p))
     unit_num = unit_num * 10 + (*p++ - '0');
   return INTEGER;
 }
-- 
GitLab