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.
@@ -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:
@@ -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
}
+/* 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 * ex
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 ();