trans-array.c (gfc_conv_array_initializer): Remove excess precision from overlength...

	* trans-array.c (gfc_conv_array_initializer): Remove excess precision
	from overlength string initializers.

From-SVN: r264285

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6249996ccbc3344c6373ffa8faf54b501e5cfa8a..becc184828c4c9ea5e284b95ef5df902602e86ca 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2018-09-13  Bernd Edlinger  <bernd.edlinger@hotmail.de>
+
+       * trans-array.c (gfc_conv_array_initializer): Remove excess precision
+       from overlength string initializers.
+
 2018-09-12  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/87284

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index adb2c0575a861b65d49c0c17bd969e4873f104e3..473bfc5419b68ed3ff81cfc0bccacd81949c1059 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5956,6 +5956,26 @@ gfc_conv_array_initializer (tree type, gfc_expr * expr)
            {
            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));
+                     const char *p = TREE_STRING_POINTER (se.expr);
+
+                     se.expr = build_string (size, p);
+                     TREE_TYPE (se.expr) = atype;
+                   }
+               }
              break;
 
            case EXPR_STRUCTURE: