[patch, RFC] Fix PR 30389 - ASCII functions

[Thomas Koenig <Thomas dot Koenig at online dot de>]

:ADDPATCH fortran:

Hello world,

this is a proposal for dealing with PR 30389, or rather with the
inconsitensies with the ASCII handling.

Before, we handled the ASCII comparison functions (LGE and friends),
achar() and iachar() ascii_table (a lookup for the valid ASCII
characters) and its inverse, xascii_table, during constant folding.

Runtime string comparisons using LGE and friends, plus runtime
conversions using ACHAR and IACHAR, on the other hand, were always
done using the native character set.

My proposal, as done in the patch below, is to remove the
special-casing of ASCII charachters altogether.  AFAIK, this is
safe for current patforms, because we don't support non-ASCII
platforms anyway.  There is precedent; for example, ifort
always uses the native character set for the ASCII functions.

The alternative would be to always use the ASCII table.  This is
far more complicated, and I don't know a lot of the things that
I would need to implement it.

Please feel free to comment.

OK for trunk?  OK for 4.2?

	Thomas

2007-01-22  Thomas Koenig  <Thomas.Koenig@online.de>

	* gfortran.h:  Remove gfc_simplify_init_1.
	* arith.h:  Remove third argument from gfc_compare_string.
	* arith.c(gfc_compare_expression):  Remove third argument
	from call to gfc_compare_string.
	(gfc_compare_string):  Remove third argument xcoll_table.
	Remove use of xcoll_table.
	* misc.c(gfc_init_1):  Remove call to gfc_simplify_init_1.
	* simplify.c(ascii_table):  Remove.
	(xascii_table): Likewise.
	(gfc_simplify_achar):  Remove use of ascii_table.  Remove
	error for values > 127; error for values of >UCHAR_MAX instead.
	(gfc_simplify_iachar):  Likewise.
	(gfc_simplify_lge):  Likewise.
	(gfc_simplify_lgt):  Likewise.
	(gfc_simplify_lle):  Likewise.
	(gfc_simplify_llt):  Likewise.
	(invert_table):  Remove.
	(gfc_simplify_init_1):  Remove.

2007-01-22  Thomas Koenig  <Thomas.Koenig@online.de>

	* gfortran.dg/achar_2.f90:  New test.

Attachment: achar_2.f90
Description: Text document

Index: gfortran.h
===================================================================
--- gfortran.h	(revision 121036)
+++ gfortran.h	(working copy)
@@ -1970,9 +1970,6 @@ gfc_intrinsic_sym *gfc_find_function (co
 match gfc_intrinsic_func_interface (gfc_expr *, int);
 match gfc_intrinsic_sub_interface (gfc_code *, int);
 
-/* simplify.c */
-void gfc_simplify_init_1 (void);
-
 /* match.c -- FIXME */
 void gfc_free_iterator (gfc_iterator *, int);
 void gfc_free_forall_iterator (gfc_forall_iterator *);
Index: arith.c
===================================================================
--- arith.c	(revision 121036)
+++ arith.c	(working copy)
@@ -1055,7 +1055,7 @@ gfc_compare_expr (gfc_expr *op1, gfc_exp
       break;
 
     case BT_CHARACTER:
-      rc = gfc_compare_string (op1, op2, NULL);
+      rc = gfc_compare_string (op1, op2);
       break;
 
     case BT_LOGICAL:
@@ -1083,11 +1083,11 @@ compare_complex (gfc_expr *op1, gfc_expr
 
 
 /* Given two constant strings and the inverse collating sequence, compare the
-   strings.  We return -1 for a < b, 0 for a == b and 1 for a > b.  If the
-   xcoll_table is NULL, we use the processor's default collating sequence.  */
+   strings.  We return -1 for a < b, 0 for a == b and 1 for a > b. 
+   We use the processor's default collating sequence.  */
 
 int
-gfc_compare_string (gfc_expr *a, gfc_expr *b, const int *xcoll_table)
+gfc_compare_string (gfc_expr *a, gfc_expr *b)
 {
   int len, alen, blen, i, ac, bc;
 
@@ -1103,12 +1103,6 @@ gfc_compare_string (gfc_expr *a, gfc_exp
       ac = (unsigned char) ((i < alen) ? a->value.character.string[i] : ' ');
       bc = (unsigned char) ((i < blen) ? b->value.character.string[i] : ' ');
 
-      if (xcoll_table != NULL)
-	{
-	  ac = xcoll_table[ac];
-	  bc = xcoll_table[bc];
-	}
-
       if (ac < bc)
 	return -1;
       if (ac > bc)
Index: arith.h
===================================================================
--- arith.h	(revision 121036)
+++ arith.h	(working copy)
@@ -40,7 +40,7 @@ gfc_expr *gfc_constant_result (bt, int, 
 arith gfc_range_check (gfc_expr *);
 
 int gfc_compare_expr (gfc_expr *, gfc_expr *);
-int gfc_compare_string (gfc_expr *, gfc_expr *, const int *);
+int gfc_compare_string (gfc_expr *, gfc_expr *);
 
 /* Constant folding for gfc_expr trees.  */
 gfc_expr *gfc_uplus (gfc_expr * op);
Index: misc.c
===================================================================
--- misc.c	(revision 121036)
+++ misc.c	(working copy)
@@ -249,7 +249,6 @@ gfc_init_1 (void)
   gfc_scanner_init_1 ();
   gfc_arith_init_1 ();
   gfc_intrinsic_init_1 ();
-  gfc_simplify_init_1 ();
 }
 
 
Index: simplify.c
===================================================================
--- simplify.c	(revision 121036)
+++ simplify.c	(working copy)
@@ -64,31 +64,6 @@ gfc_expr gfc_bad_expr;
    everything is reasonably straight-forward.  The Standard, chapter 13
    is the best comment you'll find for this file anyway.  */
 
-/* Static table for converting non-ascii character sets to ascii.
-   The xascii_table[] is the inverse table.  */
-
-static int ascii_table[256] = {
-  '\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
-  '\b', '\t', '\n', '\v', '\0', '\r', '\0', '\0',
-  '\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
-  '\0', '\0', '\0', '\0', '\0', '\0', '\0', '\0',
-  ' ', '!', '"', '#', '$', '%', '&', '\'',
-  '(', ')', '*', '+', ',', '-', '.', '/',
-  '0', '1', '2', '3', '4', '5', '6', '7',
-  '8', '9', ':', ';', '<', '=', '>', '?',
-  '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
-  'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
-  'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
-  'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
-  '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
-  'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
-  'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
-  'x', 'y', 'z', '{', '|', '}', '~', '\?'
-};
-
-static int xascii_table[256];
-
-
 /* Range checks an expression node.  If all goes well, returns the
    node, otherwise returns &gfc_bad_expr and frees the node.  */
 
@@ -271,17 +246,16 @@ gfc_expr *
 gfc_simplify_achar (gfc_expr *e)
 {
   gfc_expr *result;
-  int index;
+  int c;
 
   if (e->expr_type != EXPR_CONSTANT)
     return NULL;
 
   /* We cannot assume that the native character set is ASCII in this
      function.  */
-  if (gfc_extract_int (e, &index) != NULL || index < 0 || index > 127)
+  if (gfc_extract_int (e, &c) != NULL || c < 0 || c > UCHAR_MAX)
     {
-      gfc_error ("Extended ASCII not implemented: argument of ACHAR at %L "
-		 "must be between 0 and 127", &e->where);
+      gfc_error ("Bad character in ACHAR function at %L ", &e->where);
       return &gfc_bad_expr;
     }
 
@@ -291,7 +265,7 @@ gfc_simplify_achar (gfc_expr *e)
   result->value.character.string = gfc_getmem (2);
 
   result->value.character.length = 1;
-  result->value.character.string[0] = ascii_table[index];
+  result->value.character.string[0] = c;
   result->value.character.string[1] = '\0';	/* For debugger */
   return result;
 }
@@ -1228,7 +1202,7 @@ gfc_simplify_iachar (gfc_expr *e)
       return &gfc_bad_expr;
     }
 
-  index = xascii_table[(int) e->value.character.string[0] & 0xFF];
+  index = (unsigned char) e->value.character.string[0];
 
   result = gfc_int_expr (index);
   result->where = e->where;
@@ -2126,7 +2100,7 @@ gfc_simplify_lge (gfc_expr *a, gfc_expr 
   if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) >= 0,
+  return gfc_logical_expr (gfc_compare_string (a, b) >= 0,
 			   &a->where);
 }
 
@@ -2137,7 +2111,7 @@ gfc_simplify_lgt (gfc_expr *a, gfc_expr 
   if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) > 0,
+  return gfc_logical_expr (gfc_compare_string (a, b) > 0,
 			   &a->where);
 }
 
@@ -2148,7 +2122,7 @@ gfc_simplify_lle (gfc_expr *a, gfc_expr 
   if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) <= 0,
+  return gfc_logical_expr (gfc_compare_string (a, b) <= 0,
 			   &a->where);
 }
 
@@ -2159,7 +2133,7 @@ gfc_simplify_llt (gfc_expr *a, gfc_expr 
   if (a->expr_type != EXPR_CONSTANT || b->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  return gfc_logical_expr (gfc_compare_string (a, b, xascii_table) < 0,
+  return gfc_logical_expr (gfc_compare_string (a, b) < 0,
 			   &a->where);
 }
 
@@ -4083,27 +4057,3 @@ gfc_convert_constant (gfc_expr *e, bt ty
 
   return result;
 }
-
-
-/****************** Helper functions ***********************/
-
-/* Given a collating table, create the inverse table.  */
-
-static void
-invert_table (const int *table, int *xtable)
-{
-  int i;
-
-  for (i = 0; i < 256; i++)
-    xtable[i] = 0;
-
-  for (i = 0; i < 256; i++)
-    xtable[table[i]] = i;
-}
-
-
-void
-gfc_simplify_init_1 (void)
-{
-  invert_table (ascii_table, xascii_table);
-}