re PR fortran/82007 (DTIO write format stored in a string leads to severe errors)

2018-01-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

        PR fortran/82007
        * resolve.c (resolve_transfer): Delete code looking for 'DT'
        format specifiers in format strings. Set formatted to true if a
        format string or format label is present.
        * trans-io.c (get_dtio_proc): Likewise. (transfer_expr): Fix
        whitespace.

From-SVN: r256649

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d7ec5806f82c39fb42d2392642c085bbec104d38..75331718092559daf01bfd3faa8f862dd17426c5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2018-01-13  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/82007
+       * resolve.c (resolve_transfer): Delete code looking for 'DT'
+       format specifiers in format strings. Set formatted to true if a
+       format string or format label is present.
+       * trans-io.c (get_dtio_proc): Likewise. (transfer_expr): Fix
+       whitespace.
+       
 2018-01-13  Thomas Koenig <tkoenig@gcc.gnu.org>
 
        PR fortran/83744

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e9f91d883ef3c43353e5788bf6bab37e72353f45..67568710b05a330eb5ef9fa818dc9a4cec6d8ab4 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9198,19 +9198,9 @@ resolve_transfer (gfc_code *code)
       else
        derived = ts->u.derived->components->ts.u.derived;
 
-      if (dt->format_expr)
-       {
-         char *fmt;
-         fmt = gfc_widechar_to_char (dt->format_expr->value.character.string,
-                                     -1);
-         if (strtok (fmt, "DT") != NULL)
-           formatted = true;
-       }
-      else if (dt->format_label == &format_asterisk)
-       {
-         /* List directed io must call the formatted DTIO procedure.  */
-         formatted = true;
-       }
+      /* Determine when to use the formatted DTIO procedure.  */
+      if (dt && (dt->format_expr || dt->format_label))
+       formatted = true;
 
       write = dt->dt_io_kind->value.iokind == M_WRITE
              || dt->dt_io_kind->value.iokind == M_PRINT;

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 9eb77e5986dfd780bd6d3ef2f00b5826b05a94ce..082b9f7a52f8e3015bccb751dee41d81b78e4fe3 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -2227,25 +2227,9 @@ get_dtio_proc (gfc_typespec * ts, gfc_code * code, gfc_symbol **dtio_sub)
   bool formatted = false;
   gfc_dt *dt = code->ext.dt;
 
-  if (dt)
-    {
-      char *fmt = NULL;
-
-      if (dt->format_label == &format_asterisk)
-       {
-         /* List directed io must call the formatted DTIO procedure.  */
-         formatted = true;
-       }
-      else if (dt->format_expr)
-       fmt = gfc_widechar_to_char (dt->format_expr->value.character.string,
-                                     -1);
-      else if (dt->format_label)
-       fmt = gfc_widechar_to_char (dt->format_label->format->value.character.string,
-                                     -1);
-      if (fmt && strtok (fmt, "DT") != NULL)
-       formatted = true;
-
-    }
+  /* Determine when to use the formatted DTIO procedure.  */
+  if (dt && (dt->format_expr || dt->format_label))
+    formatted = true;
 
   if (ts->type == BT_CLASS)
     derived = ts->u.derived->components->ts.u.derived;
@@ -2455,8 +2439,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
            {
              /* Recurse into the elements of the derived type.  */
              expr = gfc_evaluate_now (addr_expr, &se->pre);
-             expr = build_fold_indirect_ref_loc (input_location,
-                                     expr);
+             expr = build_fold_indirect_ref_loc (input_location, expr);
 
              /* Make sure that the derived type has been built.  An external
                 function, if only referenced in an io statement, requires this