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 (file)
index 0000000..040bb3e
--- /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 5430ed188509ffc2ed5574f78f475b53d13fd20b..0e5c4d2c003034f471fce294f4edd52827124132 100644 (file)
--- 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 2bb518b69c7fdfeb5f3724f6b544dfb80be2e545..7751b8df4db3228bce46fc442f3da463d16eeba2 100644 (file)
--- 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)