From 9f981df194cd8dba1d9fe491596cd26232ea13a5 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
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
new file mode 100644
@@ -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
@@ -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