Dear all, namelist input of arrays got confused when there were comments after value separators. The obvious fix is to cleanly skip the comments and eat subsequent whitespace. The attached conservative patch fixes this for all basic types.
Tested on x86_64-pc-linux-gnu for gfortran.dg/namelist*. OK for mainline / backports? Thanks, Harald
From 9f981df194cd8dba1d9fe491596cd26232ea13a5 Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Tue, 5 May 2026 22:00:43 +0200 Subject: [PATCH] Fortran: fix namelist read 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. --- gcc/testsuite/gfortran.dg/namelist_102.f90 | 248 +++++++++++++++++++++ libgfortran/io/list_read.c | 26 +++ 2 files changed, 274 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/namelist_102.f90 diff --git a/gcc/testsuite/gfortran.dg/namelist_102.f90 b/gcc/testsuite/gfortran.dg/namelist_102.f90 new file mode 100644 index 00000000000..66c3809439e --- /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 0d16640a900..7b71cf38719 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. */ -- 2.51.0
