[PING] [PATCH] Create internally nul terminated string literals in fortan FE

[Bernd Edlinger <bernd dot edlinger at hotmail dot de>]

Hi,

I'd like to ping this patch: https://gcc.gnu.org/ml/fortran/2018-08/msg00000.html

I attach a new version, which contains only a minor white-space change from
the previous version, in the function header of gfc_build_hollerith_string_const
to contain "static tree" on one line instead of two.

Thanks
Bernd.

On 08/01/18 13:32, Bernd Edlinger wrote:
> Hi,
> 
> this patch changes the Fortan FE to create NUL terminated STRING_CST
> objects.  This is a cleanup in preparation of a more thorough check
> on the STRING_CST objects in the middle-end.
> 
> 
> Bootstrapped and reg-tested on x86_64-pc-linux-gnu.
> Is it OK for trunk?
> 
> 
> Thanks
> Bernd.

2018-08-01  Bernd Edlinger  <bernd.edlinger@hotmail.de>

	* trans-array.c (gfc_conv_array_initializer): Remove excess precision
	from overlength string initializers.
	* trans-const.c (gfc_build_wide_string_const): Make the internal
	representation of STRING_CST properly NUL terminated.
	(gfc_build_hollerith_string_const): New helper function.
	(gfc_conv_constant_to_tree): Use it.
	

diff -pur gcc/fortran/trans-array.c gcc/fortran/trans-array.c
--- gcc/fortran/trans-array.c	2018-07-02 09:24:43.000000000 +0200
+++ gcc/fortran/trans-array.c	2018-08-01 06:45:20.529923246 +0200
@@ -5964,6 +5964,32 @@ gfc_conv_array_initializer (tree type, g
 	    {
 	    case EXPR_CONSTANT:
 	      gfc_conv_constant (&se, c->expr);
+
+	      /* See gfortran.dg/charlen_15.f90 for instance.  */
+	      if (TREE_CODE (se.expr) == STRING_CST
+		  && TREE_CODE (type) == ARRAY_TYPE)
+		{
+		  tree atype = type;
+		  while (TREE_CODE (TREE_TYPE (atype)) == ARRAY_TYPE)
+		    atype = TREE_TYPE (atype);
+		  if (TREE_CODE (TREE_TYPE (atype)) == INTEGER_TYPE
+		      && tree_to_uhwi (TYPE_SIZE_UNIT (TREE_TYPE (se.expr)))
+			 > tree_to_uhwi (TYPE_SIZE_UNIT (atype)))
+		    {
+		      unsigned HOST_WIDE_INT size
+			= tree_to_uhwi (TYPE_SIZE_UNIT (atype));
+		      unsigned unit
+			= TYPE_PRECISION (TREE_TYPE (atype)) / BITS_PER_UNIT;
+		      const char *p = TREE_STRING_POINTER (se.expr);
+		      char *q = (char *)xmalloc (size + unit);
+
+		      memcpy (q, p, size);
+		      memset (q + size, 0, unit);
+		      se.expr = build_string (size + unit, q);
+		      TREE_TYPE (se.expr) = atype;
+		      free (q);
+		    }
+		}
 	      break;
 
 	    case EXPR_STRUCTURE:
diff -pur gcc/fortran/trans-const.c gcc/fortran/trans-const.c
--- gcc/fortran/trans-const.c	2018-06-10 14:50:03.000000000 +0200
+++ gcc/fortran/trans-const.c	2018-07-31 20:15:21.721153877 +0200
@@ -93,13 +93,16 @@ gfc_build_wide_string_const (int kind, s
   int i;
   tree str, len;
   size_t size;
+  size_t elem;
   char *s;
 
   i = gfc_validate_kind (BT_CHARACTER, kind, false);
-  size = length * gfc_character_kinds[i].bit_size / 8;
+  elem = gfc_character_kinds[i].bit_size / 8;
+  size = (length + 1) * elem;
 
   s = XCNEWVAR (char, size);
   gfc_encode_character (kind, length, string, (unsigned char *) s, size);
+  memset (s + size - elem, 0, elem);
 
   str = build_string (size, s);
   free (s);
@@ -131,6 +134,30 @@ gfc_build_localized_cstring_const (const char *msg
 }
 
 
+/* Build a hollerith string constant.  */
+
+static tree
+gfc_build_hollerith_string_const (size_t length, const char *s)
+{
+  tree str;
+  tree len;
+  char *p;
+
+  p = XCNEWVAR (char, length + 1);
+  memcpy (p, s, length);
+  p[length] = '\0';
+  str = build_string (length + 1, p);
+  free (p);
+  len = size_int (length);
+  TREE_TYPE (str) =
+    build_array_type (gfc_character1_type_node,
+		      build_range_type (gfc_charlen_type_node,
+					size_one_node, len));
+  TYPE_STRING_FLAG (TREE_TYPE (str)) = 1;
+  return str;
+}
+
+
 /* Return a string constant with the given length.  Used for static
    initializers.  The constant will be padded or truncated to match
    length.  */
@@ -363,8 +390,8 @@ gfc_conv_constant_to_tree (gfc_expr * expr)
       return res;
 
     case BT_HOLLERITH:
-      return gfc_build_string_const (expr->representation.length,
-				     expr->representation.string);
+      return gfc_build_hollerith_string_const (expr->representation.length,
+					       expr->representation.string);
 
     default:
       gcc_unreachable ();