From: Fritz Reese <fritzoreese@gmail.com>
Date: Mon, 16 Oct 2017 17:40:53 +0000 (+0000)
Subject: re PR fortran/82511 (ICE Bad IO basetype (12) on attempted read or write of entire... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=9b460e2e50613e70e0e669cd813536c7288d58ea;p=gcc.git

re PR fortran/82511 (ICE Bad IO basetype (12) on attempted read or write of entire DEC structure)

2017-10-16  Fritz Reese <fritzoreese@gmail.com>

    PR fortran/82511
    Treat UNION components as DT comp. in I/O lists.

    gcc/fortran/ChangeLog:

	PR fortran/82511
	* trans-io.c (transfer_expr): Treat BT_UNION as BT_DERIVED.

    gcc/testsuite/ChangeLog:

	PR fortran/82511
	* gfortran.dg/dec_structure_22.f90: New testcase.

From-SVN: r253791
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5b003d81a99..02763fe580b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2017-10-16  Fritz Reese <fritzoreese@gmail.com>
+
+	PR fortran/82511
+	* trans-io.c (transfer_expr): Treat BT_UNION as BT_DERIVED.
+
 2017-10-15  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
 	PR fortran/82372
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 026f9a993d2..f3e1f3e4d09 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -2404,7 +2404,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
     case BT_CLASS:
       if (ts->u.derived->components == NULL)
 	return;
-      if (ts->type == BT_DERIVED || ts->type == BT_CLASS)
+      if (gfc_bt_struct (ts->type) || ts->type == BT_CLASS)
 	{
 	  gfc_symbol *derived;
 	  gfc_symbol *dtio_sub = NULL;
@@ -2438,7 +2438,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr,
 	      function = iocall[IOCALL_X_DERIVED];
 	      break;
 	    }
-	  else if (ts->type == BT_DERIVED)
+	  else if (gfc_bt_struct (ts->type))
 	    {
 	      /* Recurse into the elements of the derived type.  */
 	      expr = gfc_evaluate_now (addr_expr, &se->pre);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c47464e1e94..fb2021a8efd 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-10-16  Fritz Reese <fritzoreese@gmail.com>
+
+	PR fortran/82511
+	* gfortran.dg/dec_structure_22.f90: New testcase.
+
 2017-10-16  Paolo Carlini  <paolo.carlini@oracle.com>
 
 	PR c++/64931
diff --git a/gcc/testsuite/gfortran.dg/dec_structure_22.f90 b/gcc/testsuite/gfortran.dg/dec_structure_22.f90
new file mode 100644
index 00000000000..ddbee02602a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_structure_22.f90
@@ -0,0 +1,38 @@
+      ! { dg-do run }
+      ! { dg-options "-fdec-structure" }
+      !
+      ! PR fortran/82511
+      !
+      ! Verify that structure variables with UNION components
+      ! are accepted in an I/O-list READ.
+      !
+      implicit none
+
+      structure /s/
+        union
+          map
+            character(16) :: c16_1
+          end map
+          map
+            character(16) :: c16_2
+          end map
+        end union
+      end structure
+
+      record /s/ r
+      character(32) :: instr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ!@#$%^"
+
+      r.c16_1 = '                '
+      r.c16_2 = '                '
+      ! The record r shall be treated as if its components are listed:
+      ! read(...) r.c16_1, r.c16_2
+      ! This shall correspond to the formatted read of A16,A16
+      read(instr, '(A16,A16)') r
+
+      ! r.c16_1 and r.c16_2 are in a union, thus share the same memory
+      ! and the first 16 bytes of instr are overwritten
+      if ( r.c16_1 .ne. instr(17:32) .or. r.c16_2 .ne. instr(17:32) ) then
+        call abort()
+      endif
+
+      end