[libgfortran] PR78854 [F03] DTIO namelist output not working on internal unit

diff --git a/gcc/testsuite/gfortran.dg/dtio_25.f90 b/gcc/testsuite/gfortran.dg/dtio_25.f90
new file mode 100644
index 00000000..fc049cd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dtio_25.f90
@@ -0,0 +1,41 @@ 
+! { dg-do run }
+! PR78854 namelist write to internal unit.
+module m
+  implicit none
+  type :: t
+    character :: c
+    integer :: k
+  contains
+    procedure :: write_formatted
+    generic :: write(formatted) => write_formatted
+  end type
+contains
+  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    if (iotype.eq."NAMELIST") then
+      write (unit, '(a,a,a,a,i5)') 'x%c="',dtv%c,'",','x%k=', dtv%k
+    else
+      write (unit,*) dtv%c, dtv%k
+    end if
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  character(len=50) :: buffer
+  type(t) :: x
+  namelist /nml/ x
+  x = t('a', 5)
+  write (buffer, nml)
+  if (buffer.ne.'&NML x%c="a",x%k=    5  /') call abort
+  x = t('x', 0)
+  read (buffer, nml)
+  if (x%c.ne.'a'.or. x%k.ne.5) call abort
+end
+
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index dd4ab72e..7f57ff1a 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -3301,6 +3301,11 @@  get_name:
 	  child_iomsg_len = IOMSG_LEN;
 	}
 
+      /* If reading from an internal unit, stash it to allow
+	 the child procedure to access it.  */
+      if (is_internal_unit (dtp))
+	stash_internal_unit (dtp);
+
       /* Call the user defined formatted READ procedure.  */
       dtp->u.p.current_unit->child_dtio++;
       dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist,
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 36786c03..fc22d802 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2822,6 +2822,7 @@  data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	  return;
 	}
     }
+
   /* Process the ADVANCE option.  */
 
   dtp->u.p.advance_status
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index ed3bc323..b733b939 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -461,6 +461,7 @@  set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
 {
   gfc_offset start_record = 0;
 
+  iunit->unit_number = dtp->common.unit;
   iunit->recl = dtp->internal_unit_len;
   iunit->internal_unit = dtp->internal_unit;
   iunit->internal_unit_len = dtp->internal_unit_len;
@@ -598,15 +599,28 @@  get_unit (st_parameter_dt *dtp, int do_create)
 	  return unit;
 	}
     }
+
+  /* If an internal unit number is passed from the parent to the child
+     it should have been stashed on the newunit_stack ready to be used.
+     Check for it now and return the internal unit if found.  */
+  if (newunit_tos && (dtp->common.unit <= NEWUNIT_START)
+      && (dtp->common.unit == newunit_stack[newunit_tos].unit_number))
+    {
+      unit = newunit_stack[newunit_tos--].unit;
+      return unit;
+    }
+
   /* Has to be an external unit.  */
   dtp->u.p.unit_is_internal = 0;
   dtp->internal_unit = NULL;
   dtp->internal_unit_desc = NULL;
+
   /* For an external unit with unit number < 0 creating it on the fly
      is not allowed, such units must be created with
      OPEN(NEWUNIT=...).  */
   if (dtp->common.unit < 0)
     return get_gfc_unit (dtp->common.unit, 0);
+
   return get_gfc_unit (dtp->common.unit, do_create);
 }
 
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 47970d42..f03929e4 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -2253,6 +2253,12 @@  nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 		      child_iomsg_len = IOMSG_LEN;
 		    }
 		  namelist_write_newline (dtp);
+
+		  /* If writing to an internal unit, stash it to allow
+		     the child procedure to access it.  */
+		  if (is_internal_unit (dtp))
+		    stash_internal_unit (dtp);
+		      
 		  /* Call the user defined formatted WRITE procedure.  */
 		  dtp->u.p.current_unit->child_dtio++;
 		  dtio_ptr ((void *)&list_obj, &unit, iotype, &vlist,