From: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Wed, 5 Oct 2016 04:39:33 +0000 (+0000)
Subject: 2016-10-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
X-Git-Tag: basepoints/gcc-8~4193
X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=ddd12b5fb06e5b7a11ef65bd50509d30305afb8b;p=thirdparty%2Fgcc.git

2016-10-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	io/inquire.c (inquire_via_unit): Add check for internal unit
	passed into child IO procedure.

From-SVN: r240768
---

diff --git a/gcc/testsuite/gfortran.dg/dtio_15.f90 b/gcc/testsuite/gfortran.dg/dtio_15.f90
new file mode 100644
index 000000000000..040bb3ebe1c2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_15.f90
@@ -0,0 +1,33 @@
+! {dg-do run }
+! Test that inquire of string internal unit in child process errors.
+module string_m
+  implicit none
+  type person
+    character(10) :: aname
+    integer :: ijklmno
+  contains
+    procedure :: write_s
+    generic :: write(formatted) => write_s
+  end type person
+contains
+  subroutine write_s (this, lun, iotype, vlist, istat, imsg)
+    class(person), intent(in)       :: this
+    integer, intent(in)             :: lun
+    character(len=*), intent(in)    :: iotype
+    integer, intent(in)             :: vlist(:)
+    integer, intent(out)            :: istat
+    character(len=*), intent(inout) :: imsg
+    integer :: filesize
+    inquire( unit=lun, size=filesize, iostat=istat, iomsg=imsg)
+    if (istat /= 0) return
+  end subroutine write_s
+end module string_m
+program p
+   use string_m
+   type(person) :: s
+   character(len=12) :: msg
+   integer :: istat
+   character(len=256) :: imsg = ""
+   write( msg, "(DT)", iostat=istat) s
+   if (istat /= 5018) call abort
+end program p
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 5430ed188509..0e5c4d2c0030 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	io/inquire.c (inquire_via_unit): Add check for internal unit
+	passed into child IO procedure.
+
 2016-10-01  Andre Vehreschild  <vehre@gcc.gnu.org>
 
 	PR fortran/77663
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 2bb518b69c7f..7751b8df4db3 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -41,7 +41,9 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
   const char *p;
   GFC_INTEGER_4 cf = iqp->common.flags;
 
-  if (iqp->common.unit == GFC_INTERNAL_UNIT || iqp->common.unit == GFC_INTERNAL_UNIT4)
+  if (iqp->common.unit == GFC_INTERNAL_UNIT ||
+	iqp->common.unit == GFC_INTERNAL_UNIT4 ||
+	u->internal_unit_kind != 0)
     generate_error (&iqp->common, LIBERROR_INQUIRE_INTERNAL_UNIT, NULL);
 
   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)