From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Sun, 3 Dec 2017 03:26:09 +0000 (+0000)
Subject: re PR fortran/83225 (runtime error in transfer.c)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=7b39e3c24f912f274ea2127ca7fc3133bf97a911;p=gcc.git

re PR fortran/83225 (runtime error in transfer.c)

2017-12-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/83225
	* io/io.h (is_internal_unit): Use the unit_is_internal bit.
	* io/transfer.c (data_transfer_init): Set the bit to true for
	internal umits. Use that bit for checks for internal unit
	initializations.
	* io/unit.c (insert_unit): As a precaution, set the
	internal_unit_kind to zero when a unit structure is first created.

From-SVN: r255362
---

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a1cf6b891ce..37b5281bde6 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,13 @@
+2017-12-02  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/83225
+	* io/io.h (is_internal_unit): Use the unit_is_internal bit.
+	* io/transfer.c (data_transfer_init): Set the bit to true for
+	internal umits. Use that bit for checks for internal unit
+	initializations.
+	* io/unit.c (insert_unit): As a precaution, set the
+	internal_unit_kind to zero when a unit structure is first created.
+
 2017-11-28  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR fortran/53796
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index fd48bf19e9b..c5e73d80ead 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -69,7 +69,7 @@ internal_proto(old_locale_lock);
 
 #define is_array_io(dtp) ((dtp)->internal_unit_desc)
 
-#define is_internal_unit(dtp) ((dtp)->u.p.current_unit->internal_unit_kind)
+#define is_internal_unit(dtp) ((dtp)->u.p.unit_is_internal)
 
 #define is_stream_io(dtp) ((dtp)->u.p.current_unit->flags.access == ACCESS_STREAM)
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 1ac4c5164e9..5429a855541 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2764,6 +2764,8 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       else
 	dtp->u.p.current_unit->has_size = false;
     }
+  else if (dtp->u.p.current_unit->internal_unit_kind > 0)
+    dtp->u.p.unit_is_internal = 1;
 
   /* Check the action.  */
 
@@ -4085,7 +4087,7 @@ st_read_done (st_parameter_dt *dtp)
   if (dtp->u.p.current_unit != NULL
       && dtp->u.p.current_unit->child_dtio == 0)
     {
-      if (is_internal_unit (dtp))
+      if (dtp->u.p.unit_is_internal)
 	{
 	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
 	    {
@@ -4099,7 +4101,7 @@ st_read_done (st_parameter_dt *dtp)
 	    }
 	  newunit_free (dtp->common.unit);
 	}
-      if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
+      if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
 	{
 	  free_format_data (dtp->u.p.fmt);
 	  free_format (dtp);
@@ -4156,7 +4158,7 @@ st_write_done (st_parameter_dt *dtp)
 
       /* If this is a parent WRITE statement we do not need to retain the
 	 internal unit structure for child use.  */
-      if (is_internal_unit (dtp))
+      if (dtp->u.p.unit_is_internal)
 	{
 	  if ((dtp->common.flags & IOPARM_DT_HAS_UDTIO) == 0)
 	    {
@@ -4170,7 +4172,7 @@ st_write_done (st_parameter_dt *dtp)
 	    }
 	  newunit_free (dtp->common.unit);
 	}
-      if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
+      if (dtp->u.p.unit_is_internal || dtp->u.p.format_not_saved)
 	{
 	  free_format_data (dtp->u.p.fmt);
 	  free_format (dtp);
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index fbb33046dee..66cd12dcdcd 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -231,6 +231,7 @@ insert_unit (int n)
 {
   gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
   u->unit_number = n;
+  u->internal_unit_kind = 0;
 #ifdef __GTHREAD_MUTEX_INIT
   {
     __gthread_mutex_t tmp = __GTHREAD_MUTEX_INIT;