[llvm] [flang-rt][test] Add regression coverage for child I/O namelist mode (PR #222505)
Eugene Epshteyn via llvm-commits
llvm-commits at lists.llvm.org
Fri Sep 11 03:37:24 PDT 2026
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/222505
>From b3d785898f31a4aaa83ffad335a86dbf107b238f Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Wed, 9 Sep 2026 21:30:18 -0700
Subject: [PATCH] [flang-rt][test] Add regression coverage for child I/O
namelist mode
PR #218314 fixed the iotype passed to a defined-I/O procedure invoked from a
child data transfer statement by clearing MutableModes::inNamelist in the
ChildIoStatementState constructor. That flag has several consumers, and the
tests added with the fix cover one direction, one nesting depth and one
consumer.
Add three execution tests that pin the rest of the behavior the flag governs:
iotype at three levels of nesting and in both directions; a defined-I/O
procedure whose own child data transfer is itself a namelist statement; and
both arms of the child-input record-advancement rule documented in
flang/docs/Extensions.md.
The tests print the observed values and match them with FileCheck, so a
failure reports what was actually received.
---
flang-rt/test/Driver/iotype-nested.f90 | 137 ++++++++++++++++++
.../test/Driver/namelist-child-advance.f90 | 111 ++++++++++++++
flang-rt/test/Driver/namelist-child-io.f90 | 117 +++++++++++++++
3 files changed, 365 insertions(+)
create mode 100644 flang-rt/test/Driver/iotype-nested.f90
create mode 100644 flang-rt/test/Driver/namelist-child-advance.f90
create mode 100644 flang-rt/test/Driver/namelist-child-io.f90
diff --git a/flang-rt/test/Driver/iotype-nested.f90 b/flang-rt/test/Driver/iotype-nested.f90
new file mode 100644
index 0000000000000..b6da67cc83d49
--- /dev/null
+++ b/flang-rt/test/Driver/iotype-nested.f90
@@ -0,0 +1,137 @@
+! Verify the iotype passed to a defined I/O procedure that is invoked, directly
+! or indirectly, from a NAMELIST parent statement. Only the procedure whose
+! immediate parent is the namelist statement may see 'NAMELIST'; a procedure
+! invoked from a list-directed child statement must see 'LISTDIRECTED'
+! (F2023 12.6.4.8.3), at any nesting depth and in both directions.
+
+! RUN: %flang %isysroot -L"%libdir" %s -o %t
+! RUN: env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t | FileCheck %s
+
+module iotype_nested_mod
+ type :: leaf
+ integer :: x
+ contains
+ procedure :: leaf_write
+ procedure :: leaf_read
+ generic :: write(formatted) => leaf_write
+ generic :: read(formatted) => leaf_read
+ end type
+
+ type :: middle
+ type(leaf) :: l
+ contains
+ procedure :: middle_write
+ generic :: write(formatted) => middle_write
+ end type
+
+ type :: outer
+ type(middle) :: m
+ contains
+ procedure :: outer_write
+ generic :: write(formatted) => outer_write
+ end type
+
+ type :: reader
+ type(leaf) :: l
+ contains
+ procedure :: reader_read
+ generic :: read(formatted) => reader_read
+ end type
+
+ character(20) :: seen(3) = 'unset'
+
+contains
+
+ subroutine outer_write(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(outer), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(1) = iotype
+ write (unit, *, iostat=iostat, iomsg=iomsg) dtv%m
+ end subroutine
+
+ subroutine middle_write(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(middle), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(2) = iotype
+ write (unit, *, iostat=iostat, iomsg=iomsg) dtv%l
+ end subroutine
+
+ subroutine leaf_write(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(leaf), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(3) = iotype
+ write (unit, *, iostat=iostat, iomsg=iomsg) dtv%x
+ end subroutine
+
+ subroutine reader_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(reader), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(1) = iotype
+ read (unit, *, iostat=iostat, iomsg=iomsg) dtv%l
+ end subroutine
+
+ subroutine leaf_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(leaf), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(2) = iotype
+ read (unit, *, iostat=iostat, iomsg=iomsg) dtv%x
+ end subroutine
+
+end module
+
+program iotype_nested
+ use iotype_nested_mod
+ implicit none
+ type(outer) :: o
+ type(reader) :: r
+ namelist /wgrp/ o
+ namelist /rgrp/ r
+
+ ! Three levels of defined output under a namelist WRITE.
+ o%m%l%x = 9
+ seen = 'unset'
+ open (10, status='scratch')
+ write (10, nml=wgrp)
+ close (10)
+ print *, 'write depth 1: ', trim(seen(1))
+ print *, 'write depth 2: ', trim(seen(2))
+ print *, 'write depth 3: ', trim(seen(3))
+ ! CHECK: write depth 1: NAMELIST
+ ! CHECK-NEXT: write depth 2: LISTDIRECTED
+ ! CHECK-NEXT: write depth 3: LISTDIRECTED
+
+ ! Two levels of defined input under a namelist READ.
+ r%l%x = -1
+ seen = 'unset'
+ open (11, status='scratch')
+ write (11, '(A)') '&RGRP R= 9/'
+ rewind (11)
+ read (11, nml=rgrp)
+ close (11)
+ print *, 'read depth 1: ', trim(seen(1))
+ print *, 'read depth 2: ', trim(seen(2))
+ print *, 'read value: ', r%l%x
+ ! CHECK-NEXT: read depth 1: NAMELIST
+ ! CHECK-NEXT: read depth 2: LISTDIRECTED
+ ! CHECK-NEXT: read value: 9
+end program
diff --git a/flang-rt/test/Driver/namelist-child-advance.f90 b/flang-rt/test/Driver/namelist-child-advance.f90
new file mode 100644
index 0000000000000..962187f4d6bd4
--- /dev/null
+++ b/flang-rt/test/Driver/namelist-child-advance.f90
@@ -0,0 +1,111 @@
+! Both arms of the record-advancement rule for child list-directed input
+! documented in flang/docs/Extensions.md: a non-NAMELIST list-directed child
+! input statement may not advance to a further record when it has an ancestor
+! formatted input statement that is not list-directed and there is no
+! intervening NAMELIST, and may advance when such a NAMELIST intervenes.
+
+! RUN: %flang %isysroot -L"%libdir" %s -o %t
+! RUN: env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t | FileCheck %s
+
+module child_advance_mod
+ type :: pair
+ integer :: p, q
+ contains
+ procedure :: pair_read
+ generic :: read(formatted) => pair_read
+ end type
+
+ ! NAMELIST outside the formatted ancestor: no intervening NAMELIST.
+ type :: blocked_outer
+ type(pair) :: v
+ contains
+ procedure :: blocked_read
+ generic :: read(formatted) => blocked_read
+ end type
+
+ ! NAMELIST below the formatted ancestor: the NAMELIST intervenes.
+ type :: allowed_outer
+ integer :: dummy
+ contains
+ procedure :: allowed_read
+ generic :: read(formatted) => allowed_read
+ end type
+
+ type(pair) :: inner_pair
+ namelist /inner/ inner_pair
+
+contains
+
+ subroutine blocked_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(blocked_outer), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ ! A formatted, non-list-directed child statement.
+ read (unit, '(DT)', iostat=iostat, iomsg=iomsg) dtv%v
+ end subroutine
+
+ subroutine allowed_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(allowed_outer), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ ! A child NAMELIST statement below the formatted ancestor.
+ read (unit, nml=inner, iostat=iostat, iomsg=iomsg)
+ dtv%dummy = 1
+ end subroutine
+
+ subroutine pair_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(pair), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ ! The values sit on two different records, so this statement can only
+ ! succeed if it is allowed to advance.
+ read (unit, *, iostat=iostat, iomsg=iomsg) dtv%p, dtv%q
+ end subroutine
+
+end module
+
+program namelist_child_advance
+ use child_advance_mod
+ implicit none
+ type(blocked_outer) :: b
+ type(allowed_outer) :: a
+ integer :: ios
+ namelist /grp/ b
+
+ ! No intervening NAMELIST: the list-directed grandchild must not advance.
+ b%v%p = -1
+ b%v%q = -1
+ open (10, status='scratch')
+ write (10, '(A)') '&GRP B= 3'
+ write (10, '(A)') ' 4 /'
+ rewind (10)
+ ios = 0
+ read (10, nml=grp, iostat=ios)
+ close (10)
+ print *, 'no intervening namelist, advanced: ', ios == 0
+ ! CHECK: no intervening namelist, advanced: F
+
+ ! Intervening NAMELIST: the same grandchild must advance.
+ inner_pair%p = -1
+ inner_pair%q = -1
+ open (11, status='scratch')
+ write (11, '(A)') '&INNER INNER_PAIR= 3'
+ write (11, '(A)') ' 4 /'
+ rewind (11)
+ ios = 0
+ read (11, '(DT)', iostat=ios) a
+ close (11)
+ print *, 'intervening namelist, advanced: ', ios == 0
+ print *, 'values: ', inner_pair%p, inner_pair%q
+ ! CHECK-NEXT: intervening namelist, advanced: T
+ ! CHECK-NEXT: values: 3 4
+end program
diff --git a/flang-rt/test/Driver/namelist-child-io.f90 b/flang-rt/test/Driver/namelist-child-io.f90
new file mode 100644
index 0000000000000..fc467b6376782
--- /dev/null
+++ b/flang-rt/test/Driver/namelist-child-io.f90
@@ -0,0 +1,117 @@
+! A defined I/O procedure may itself perform a child NAMELIST data transfer.
+! Such a child statement is a namelist statement in its own right: a procedure
+! it invokes must see iotype 'NAMELIST', and a child namelist READ must still
+! be allowed to advance to further input records. These properties must hold
+! when the outer statement is a namelist statement too.
+
+! RUN: %flang %isysroot -L"%libdir" %s -o %t
+! RUN: env LD_LIBRARY_PATH="$LD_LIBRARY_PATH:%libdir" %t | FileCheck %s
+
+module namelist_child_mod
+ type :: leaf
+ integer :: x
+ contains
+ procedure :: leaf_write
+ generic :: write(formatted) => leaf_write
+ end type
+
+ type :: holder
+ type(leaf) :: l
+ contains
+ procedure :: holder_write
+ generic :: write(formatted) => holder_write
+ end type
+
+ type :: spanner
+ integer :: total
+ contains
+ procedure :: spanner_read
+ generic :: read(formatted) => spanner_read
+ end type
+
+ character(20) :: seen(2) = 'unset'
+ type(leaf) :: inner_leaf
+ namelist /inner_w/ inner_leaf
+ integer :: a = -1, b = -1
+ namelist /inner_r/ a, b
+
+contains
+
+ subroutine holder_write(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(holder), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(1) = iotype
+ inner_leaf = dtv%l
+ ! The child data transfer is itself a namelist statement.
+ write (unit, nml=inner_w, iostat=iostat, iomsg=iomsg)
+ end subroutine
+
+ subroutine leaf_write(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(leaf), intent(in) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(2) = iotype
+ write (unit, *, iostat=iostat, iomsg=iomsg) dtv%x
+ end subroutine
+
+ subroutine spanner_read(dtv, unit, iotype, vlist, iostat, iomsg)
+ class(spanner), intent(inout) :: dtv
+ integer, intent(in) :: unit
+ character(*), intent(in) :: iotype
+ integer, intent(in) :: vlist(:)
+ integer, intent(out) :: iostat
+ character(*), intent(inout) :: iomsg
+ seen(1) = iotype
+ ! The child namelist group spans three records.
+ read (unit, nml=inner_r, iostat=iostat, iomsg=iomsg)
+ dtv%total = a + b
+ end subroutine
+
+end module
+
+program namelist_child_io
+ use namelist_child_mod
+ implicit none
+ type(holder) :: h
+ type(spanner) :: s
+ integer :: ios
+ namelist /wgrp/ h
+ namelist /rgrp/ s
+
+ ! A child NAMELIST write nested in a namelist write.
+ h%l%x = 9
+ seen = 'unset'
+ open (10, status='scratch')
+ write (10, nml=wgrp)
+ close (10)
+ print *, 'outer iotype: ', trim(seen(1))
+ print *, 'child-namelist iotype: ', trim(seen(2))
+ ! CHECK: outer iotype: NAMELIST
+ ! CHECK-NEXT: child-namelist iotype: NAMELIST
+
+ ! A child NAMELIST read nested in a namelist read, spanning records.
+ s%total = -1
+ seen = 'unset'
+ open (11, status='scratch')
+ write (11, '(A)') '&RGRP S= &INNER_R'
+ write (11, '(A)') ' A = 3'
+ write (11, '(A)') ' B = 4 /'
+ write (11, '(A)') ' /'
+ rewind (11)
+ ios = 0
+ read (11, nml=rgrp, iostat=ios)
+ close (11)
+ print *, 'read iostat is zero: ', ios == 0
+ print *, 'outer iotype: ', trim(seen(1))
+ print *, 'child-namelist total: ', s%total
+ ! CHECK-NEXT: read iostat is zero: T
+ ! CHECK-NEXT: outer iotype: NAMELIST
+ ! CHECK-NEXT: child-namelist total: 7
+end program
More information about the llvm-commits
mailing list