https://gcc.gnu.org/g:efd571dbbe7689ea7b2b6d294ef05dd5ea21f4b3
commit r16-8904-gefd571dbbe7689ea7b2b6d294ef05dd5ea21f4b3 Author: Harald Anlauf <[email protected]> Date: Tue May 5 22:00:43 2026 +0200 Fortran: fix namelist read for input with comments [PR125095] Namelist input may contain comments (initiated with a "!") after a separator or in the first nonblank position of a namelist input record. Skip comments until end of line, and eat leading whitespace in a subsequent input record. PR libfortran/125095 libgfortran/ChangeLog: * io/list_read.c (read_logical): Eat comments in namelist read mode. (read_integer): Likewise. (read_character): Likewise. (read_complex): Likewise. (read_real): Likewise. gcc/testsuite/ChangeLog: * gfortran.dg/namelist_102.f90: New test. (cherry picked from commit 202ca69360af7f8b39a77ec3ec6c6be2b37d320e) Diff: --- gcc/testsuite/gfortran.dg/namelist_102.f90 | 248 +++++++++++++++++++++++++++++ libgfortran/io/list_read.c | 26 +++ 2 files changed, 274 insertions(+) diff --git a/gcc/testsuite/gfortran.dg/namelist_102.f90 b/gcc/testsuite/gfortran.dg/namelist_102.f90 new file mode 100644 index 000000000000..66c3809439ef --- /dev/null +++ b/gcc/testsuite/gfortran.dg/namelist_102.f90 @@ -0,0 +1,248 @@ +! { dg-do run } +! { dg-additional-options "-O2" } +! +! PR fortran/125095 - test namelist read with comments +! +! Based on testcases by Andy Nelson and Steven G. Kargl + +program nmlbug + implicit none + call test_int + call test_real + call test_complex + call test_logical + call test_char + +contains + + subroutine test_int + + integer :: array(4), barray(4), carray(4), darray(4) + + namelist/nml1/ array + namelist/nml2/ barray + namelist/nml3/ carray + namelist/nml4/ darray + + open(10,status='scratch') + write(10,'(A)') '&nml1' + write(10,'(A)') ' array = 1, 2, 3, 4,' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml2' + write(10,'(A)') ' barray = 5, ! comment' + write(10,'(A)') ' 6,' + write(10,'(A)') ' 7 ! another comment' + write(10,'(A)') ' 8,' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml3' + write(10,'(A)') ' carray = 9 ! New comment' + write(10,'(A)') ' 10' + write(10,'(A)') ' 11 ! another new comment' + write(10,'(A)') ' 12' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml4' + write(10,'(A)') ' darray = 13, 14, 15, 16,' + write(10,'(A)') '/' + flush(10) + rewind(10) + + read(10,nml1) + if (any( array /= [ 1, 2, 3, 4])) stop 1 + read(10,nml2) + if (any(barray /= [ 5, 6, 7, 8])) stop 2 + read(10,nml3) + if (any(carray /= [ 9, 10, 11, 12])) stop 3 + read(10,nml4) + if (any(darray /= [13, 14, 15, 16])) stop 4 + close(10) + + end subroutine test_int + + subroutine test_real + + real :: array(4), barray(4), carray(4), darray(4) + + namelist/nml1/ array + namelist/nml2/ barray + namelist/nml3/ carray + namelist/nml4/ darray + + open(10,status='scratch') + write(10,'(A)') '&nml1' + write(10,'(A)') ' array = 1, 2, 3, 4,' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml2' + write(10,'(A)') ' barray = 5, ! comment' + write(10,'(A)') ' 6,' + write(10,'(A)') ' 7 ! another comment' + write(10,'(A)') ' 8,' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml3' + write(10,'(A)') ' carray = 9 ! New comment' + write(10,'(A)') ' 10' + write(10,'(A)') ' 11 ! another new comment' + write(10,'(A)') ' 12' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml4' + write(10,'(A)') ' darray = 13, 14, 15, 16,' + write(10,'(A)') '/' + flush(10) + rewind(10) + + read(10,nml1) + if (any( array /= [ 1, 2, 3, 4])) stop 1 + read(10,nml2) + if (any(barray /= [ 5, 6, 7, 8])) stop 2 + read(10,nml3) + if (any(carray /= [ 9, 10, 11, 12])) stop 3 + read(10,nml4) + if (any(darray /= [13, 14, 15, 16])) stop 4 + close(10) + + end subroutine test_real + + subroutine test_complex + + complex :: array(4), barray(4), carray(4), darray(4) + + namelist/nml1/ array + namelist/nml2/ barray + namelist/nml3/ carray + namelist/nml4/ darray + + open(10,status='scratch') + write(10,'(A)') '&nml1' + write(10,'(A)') ' array = (1,0), (2,0), (3,0), (4,0),' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml2' + write(10,'(A)') ' barray = (5,0), ! comment' + write(10,'(A)') ' (6,0),' + write(10,'(A)') ' (7,0) ! another comment' + write(10,'(A)') ' (8,0),' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml3' + write(10,'(A)') ' carray = (9,0) ! New comment' + write(10,'(A)') ' (10,0)' + write(10,'(A)') ' (11,0) ! another new comment' + write(10,'(A)') ' (12,0)' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml4' + write(10,'(A)') ' darray = (13,0), (14,0), (15,0), (16,0),' + write(10,'(A)') '/' + flush(10) + rewind(10) + + read(10,nml1) + if (any( array /= [ 1, 2, 3, 4])) stop 1 + read(10,nml2) + if (any(barray /= [ 5, 6, 7, 8])) stop 2 + read(10,nml3) + if (any(carray /= [ 9, 10, 11, 12])) stop 3 + read(10,nml4) + if (any(darray /= [13, 14, 15, 16])) stop 4 + close(10) + + end subroutine test_complex + + subroutine test_logical + + logical :: array(4), barray(4), carray(4), darray(4) + + namelist/nml1/ array + namelist/nml2/ barray + namelist/nml3/ carray + namelist/nml4/ darray + + open(10,status='scratch') + write(10,'(A)') '&nml1' + write(10,'(A)') ' array = T,F,F,T' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml2' + write(10,'(A)') ' barray = T, ! comment' + write(10,'(A)') ' F,' + write(10,'(A)') ' F ! another comment' + write(10,'(A)') ' T,' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml3' + write(10,'(A)') ' carray = T ! New comment' + write(10,'(A)') ' F' + write(10,'(A)') ' F ! another new comment' + write(10,'(A)') ' T' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml4' + write(10,'(A)') ' darray = T,F,F,T' + write(10,'(A)') '/' + flush(10) + rewind(10) + + read(10,nml1) + if (any( array .neqv. [ .true.,.false.,.false.,.true. ])) stop 1 + read(10,nml2) + if (any(barray .neqv. [ .true.,.false.,.false.,.true. ])) stop 2 + read(10,nml3) + if (any(carray .neqv. [ .true.,.false.,.false.,.true. ])) stop 3 + read(10,nml4) + if (any(darray .neqv. [ .true.,.false.,.false.,.true. ])) stop 4 + close(10) + + end subroutine test_logical + + subroutine test_char + + character(8) :: array(4), barray(4), carray(4), darray(4) + + namelist/nml1/ array + namelist/nml2/ barray + namelist/nml3/ carray + namelist/nml4/ darray + + open(10,status='scratch') + write(10,'(A)') '&nml1' + write(10,'(A)') ' array = "a", "b", "c", "d",' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml2' + write(10,'(A)') ' barray = "a", ! comment' + write(10,'(A)') ' "b",' + write(10,'(A)') ' "c" ! another comment' + write(10,'(A)') ' "d",' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml3' + write(10,'(A)') ' carray = "a" ! New comment' + write(10,'(A)') ' "b"' + write(10,'(A)') ' "c" ! another new comment' + write(10,'(A)') ' "d"' + write(10,'(A)') '/' + write(10,*) + write(10,'(A)') '&nml4' + write(10,'(A)') ' darray = "a", "b", "c", "d",' + write(10,'(A)') '/' + flush(10) + rewind(10) + + read(10,nml1) + if (any( array /= [ "a", "b", "c", "d" ])) stop 1 + read(10,nml2) + if (any(barray /= [ "a", "b", "c", "d" ])) stop 2 + read(10,nml3) + if (any(carray /= [ "a", "b", "c", "d" ])) stop 3 + read(10,nml4) + if (any(darray /= [ "a", "b", "c", "d" ])) stop 4 + close(10) + + end subroutine test_char + +end program nmlbug diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 0d16640a9000..7b71cf38719d 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -917,6 +917,7 @@ read_logical (st_parameter_dt *dtp, int length) if (parse_repeat (dtp)) return; +next: c = safe_tolower (next_char (dtp)); l_push_char (dtp, c); switch (c) @@ -961,6 +962,9 @@ read_logical (st_parameter_dt *dtp, int length) case '!': if (!dtp->u.p.namelist_mode) goto bad_logical; + eat_line (dtp); + eat_spaces (dtp); + goto next; CASE_SEPARATORS: case EOF: @@ -1076,6 +1080,7 @@ read_integer (st_parameter_dt *dtp, int length, bt type) int c, negative; negative = 0; +next: c = next_char (dtp); switch (c) { @@ -1091,6 +1096,9 @@ read_integer (st_parameter_dt *dtp, int length, bt type) case '!': if (!dtp->u.p.namelist_mode) goto bad_integer; + eat_line (dtp); + eat_spaces (dtp); + goto next; CASE_SEPARATORS: /* Single null. */ unget_char (dtp, c); @@ -1260,6 +1268,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) quote = ' '; /* Space means no quote character. */ +next: if ((c = next_char (dtp)) == EOF) goto eof; if (c == ';') @@ -1284,6 +1293,15 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused))) quote = c; goto get_string; + case '!': + if (dtp->u.p.namelist_mode) + { + eat_line (dtp); + eat_spaces (dtp); + goto next; + } + /* Fall through... */ + default: if (dtp->u.p.namelist_mode) { @@ -1703,6 +1721,7 @@ read_complex (st_parameter_dt *dtp, void *dest, int kind, size_t size) if (parse_repeat (dtp)) return; +next: c = next_char (dtp); switch (c) { @@ -1712,6 +1731,9 @@ read_complex (st_parameter_dt *dtp, void *dest, int kind, size_t size) case '!': if (!dtp->u.p.namelist_mode) goto bad_complex; + eat_line (dtp); + eat_spaces (dtp); + goto next; CASE_SEPARATORS: case EOF: @@ -1813,6 +1835,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length) seen_dp = 0; +next: c = next_char (dtp); if (dtp->u.p.current_unit->decimal_status == DECIMAL_COMMA) { @@ -1844,6 +1867,9 @@ read_real (st_parameter_dt *dtp, void *dest, int length) case '!': if (!dtp->u.p.namelist_mode) goto bad_real; + eat_line (dtp); + eat_spaces (dtp); + goto next; CASE_SEPARATORS: unget_char (dtp, c); /* Single null. */
