[fortran] DTIO write format stored in a string leads to severe errors

Message ID 5943cbac-95c4-7ec8-6b50-571f98599c6c@charter.net
State New
Headers show
Series
  • [fortran] DTIO write format stored in a string leads to severe errors
Related show

Commit Message

Jerry Jan. 13, 2018, 8:02 p.m.
I plan to commit the attached patch which eliminates the offending behavior and
allows the test cases to run.

I opened a new PR to address the remaining issues.

See Bug 83829 - Implement runtime checks for DT format specifier and alignment
with effective item.

Regression tested on x86_64-pc-linux-gnu.

The patch is simple. I will roll in a test case soon.

Regards,

Jerry

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.

Patch

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e9f91d883ef..67568710b05 100644
--- 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 9eb77e5986d..082b9f7a52f 100644
--- 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