re PR fortran/66709 (ICE on formatted io with parameter array specifier fmt)

2018-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66709
	* io.c: Include constructor.h.
	(resolve_tag_format): For a constant character array, concatenate
	into a single character expression.

2018-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/66709
	* gfortran.dg/parameter_array_format.f90: New test.

From-SVN: r258850

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4d93c55fe50c2f03a1361934c56f508b7ef9cec5..0f07e0a30d921e146268f5aecf3be53f502ef75f 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2018-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/66709
+       * io.c: Include constructor.h.
+       (resolve_tag_format): For a constant character array, concatenate
+       into a single character expression.
+
 2018-03-25  Seth Johnson <johnsonsr@ornl.gov>
        Dominique d'Humieres  <dominiq@gcc.gnu.org>
 

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index d9f0fb1d4ac9e35ba5d1ad8bcadc7b74be82925d..10b7e827dab05967522c9e14a37ee5d6d3ae2e79 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -25,6 +25,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "gfortran.h"
 #include "match.h"
 #include "parse.h"
+#include "constructor.h"
 
 gfc_st_label
 format_asterisk = {0, NULL, NULL, -1, ST_LABEL_FORMAT, ST_LABEL_FORMAT, NULL,
@@ -1606,7 +1607,7 @@ match_dec_ftag (const io_tag *tag, gfc_open *o)
 /* Resolution of the FORMAT tag, to be called from resolve_tag.  */
 
 static bool
-resolve_tag_format (const gfc_expr *e)
+resolve_tag_format (gfc_expr *e)
 {
   if (e->expr_type == EXPR_CONSTANT
       && (e->ts.type != BT_CHARACTER
@@ -1617,6 +1618,47 @@ resolve_tag_format (const gfc_expr *e)
       return false;
     }
 
+  /* Concatenate a constant character array into a single character
+     expression.  */
+
+  if ((e->expr_type == EXPR_ARRAY || e->rank > 0)
+      && e->ts.type == BT_CHARACTER
+      && gfc_is_constant_expr (e))
+    {
+      if (e->expr_type == EXPR_VARIABLE
+         && e->symtree->n.sym->attr.flavor == FL_PARAMETER)
+       gfc_simplify_expr (e, 1);
+
+      if (e->expr_type == EXPR_ARRAY)
+       {
+         gfc_constructor *c;
+         gfc_charlen_t n, len;
+         gfc_expr *r;
+         gfc_char_t *dest, *src;
+
+         n = 0;
+         c = gfc_constructor_first (e->value.constructor);
+         len = c->expr->value.character.length;
+         
+         for ( ; c; c = gfc_constructor_next (c))
+           n += len;
+
+         r = gfc_get_character_expr (e->ts.kind, &e->where, NULL, n);
+         dest = r->value.character.string;
+
+         for (c = gfc_constructor_first (e->value.constructor);
+            c; c = gfc_constructor_next (c))
+           {
+             src = c->expr->value.character.string;
+             for (gfc_charlen_t i = 0 ; i < len; i++)
+               *dest++ = *src++;
+           }
+
+         gfc_replace_expr (e, r);
+         return true;
+       }
+    }
+
   /* If e's rank is zero and e is not an element of an array, it should be
      of integer or character type.  The integer variable should be
      ASSIGNED.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index cbd5efcb16e1b96e210a64e95853e63efdb48c34..4b7fc36ba2c7d9e555a2586e60e62fcb118915c5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-03-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/66709
+       * gfortran.dg/parameter_array_format.f90: New test.
+
 2018-03-25  Thomas Koenig  <tkoenig@gcc.gnu.org>
        Neil Carlson <neil.n.carlson@gmail.com>
 

diff --git a/gcc/testsuite/gfortran.dg/parameter_array_format.f90 b/gcc/testsuite/gfortran.dg/parameter_array_format.f90
new file mode 100644 (file)
index 0000000..d4ae9da
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parameter_array_format.f90
@@ -0,0 +1,14 @@
+! { dg-do  run }
+! PR fortran/66709
+! Check that parameter formats are handled correctly.
+! Original test case by Gerhard Steinmetz.
+program main
+  character(len=2), dimension(9), parameter :: f = ['("','He','ll','lo',', ','wo','rl','d!','")']
+  character(len=2), dimension(9) :: g = ['("','He','ll','lo',', ','wo','rl','d!','")']
+  character (len=20) :: line
+  write (unit=line,fmt=f)
+  if (line /= "Helllo, world!") STOP 1
+  line = " "
+  write (unit=line,fmt=g)
+  if (line /= "Helllo, world!") STOP 2
+end program main