[patch, fortran] Fix character parameter arrays as formats

[Thomas Koenig <tkoenig at netcologne dot de>]

Hello world,

the attached pach fixes the PR by creating one single big string
from a parameter array.

OK for trunk?

Regards

	Thomas

2018-03-25  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  Thomas Koenig  <tkoenig@gcc.gnu.org>

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

Index: io.c
===================================================================
--- io.c	(Revision 258845)
+++ io.c	(Arbeitskopie)
@@ -25,6 +25,7 @@
 #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 @@
 /* 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 @@
       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.  */

! { 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