The attached patch is fairly self explanatory.
I added and check on the message length to not exceed 128 bytes to avoid
potential problems with excessively long namelist input lines.
Two existing test cases are updated to match the dg-output expected for those
tests. I do not think a new test case is needd. Even so, with the original test
case given in the PR we would give:
$ $FC pr118793.f90
$ ./a.out
<ERROR>FILE: namelist read: misplaced = sign
<ERROR>INTERNAL: namelist read: misplaced = sign
<ERROR>SCRATCH: namelist read: misplaced = sign
STOP 1
With the change we now give:
$ $FC pr118793.f90
$ ./a.out
<ERROR>FILE: namelist read: misplaced = sign at line 3, column 12 in file
_config.nml
param2 === 0.5 ! problematic line
^
<ERROR>INTERNAL: namelist read: misplaced = sign at line 3, column 12
param2 === 0.5 ! problematic line
^
<ERROR>SCRATCH: namelist read: misplaced = sign at line 3, column 12 in file
/tmp/gfortrantmpU5c3Ib
param2 === 0.5 ! problematic line
^
STOP 1
commit e93f54a23f07e9e9fb5f6d2f8dc6b5cfeb4d152d
Author: Jerry DeLisle <[email protected]>
Date: Tue Jun 23 18:17:27 2026 -0700
fortran: [PR118793] Provide expanded diagnostics for namelist read
The change implements additional diagnostic information for namelist
read. In particular, error messages provide line number, column
position, the specific file name, and a portion of the input line
where the error ocurred.
PR libfortran/118793
libgfortran/ChangeLog:
* io/file_pos.c (st_rewind): Reset line and column numbers.
* io/io.h: Add line and column number to the gfc_unit
structure.
* io/list_read.c (next_char_default): Increment the column
position and line number as needed.
(next_char_internal): Likewise.
(next_char_utf8): Likewise.
(nml_err_ret): Build the expanded diagnostic message.
* io/unit.c (insert_unit): Initialize the line_number.
gcc/testsuite/ChangeLog:
* gfortran.dg/namelist_40.f90: Update expected dg-output.
* gfortran.dg/namelist_47.f90: Likewise
diff --git a/gcc/testsuite/gfortran.dg/namelist_40.f90 b/gcc/testsuite/gfortran.dg/namelist_40.f90
index ba28d29e5b4..96d360f5223 100644
--- a/gcc/testsuite/gfortran.dg/namelist_40.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_40.f90
@@ -31,7 +31,7 @@ contains
subroutine writenml (astring)
character(40), intent(in) :: astring
- character(300) :: errmessage
+ character(500) :: errmessage
integer :: ierror
open (10, status="scratch", delim='apostrophe')
@@ -47,7 +47,11 @@ subroutine writenml (astring)
end subroutine writenml
end program namelist_40
-! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%ch(\r*\n+)" }
-! { dg-output "Missing colon in substring qualifier for namelist variable x%m%ch(\r*\n+)" }
-! { dg-output "Substring out of range for namelist variable x%m%ch(\r*\n+)" }
-! { dg-output "Bad character in substring qualifier for namelist variable x%m%ch(\r*\n+)" }
+! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%ch at line 2, column 20 in file .*(\r*\n+)" }
+! { dg-output " x\\(2\\)%m%ch\\(:\\)\\(2:2\\) = 'z','z',.*(\r*\n+) \\^(\r*\n+)(\r*\n+)" }
+! { dg-output "Missing colon in substring qualifier for namelist variable x%m%ch at line 2, column 19 in file .*(\r*\n+)" }
+! { dg-output " x\\(2\\)%m\\(2\\)%ch\\(:\\)\\(2\\) = 'z','z',.*(\r*\n+) \\^(\r*\n+)(\r*\n+)" }
+! { dg-output "Substring out of range for namelist variable x%m%ch at line 2, column 20 in file .*(\r*\n+)" }
+! { dg-output " x\\(2\\)%m\\(2\\)%ch\\(:\\)\\(:3\\) = 'z','z',.*(\r*\n+) \\^(\r*\n+)(\r*\n+)" }
+! { dg-output "Bad character in substring qualifier for namelist variable x%m%ch at line 2, column 20 in file .*(\r*\n+)" }
+! { dg-output " x\\(2\\)%m\\(2\\)%ch\\(1:2\\)\\(k:\\) = 'z','z',.*(\r*\n+) \\^" }
diff --git a/gcc/testsuite/gfortran.dg/namelist_47.f90 b/gcc/testsuite/gfortran.dg/namelist_47.f90
index 1000aba0575..0c53dde4075 100644
--- a/gcc/testsuite/gfortran.dg/namelist_47.f90
+++ b/gcc/testsuite/gfortran.dg/namelist_47.f90
@@ -29,7 +29,7 @@ contains
subroutine writenml (astring)
character(140), intent(in) :: astring
- character(300) :: errmessage
+ character(500) :: errmessage
integer :: ierror
open (10, status="scratch", delim='apostrophe')
@@ -45,7 +45,7 @@ subroutine writenml (astring)
end subroutine writenml
end program namelist_47
-! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%c012345678901234567890123456789012345678901234567890123456789h(\r*\n+)" }
-! { dg-output "Missing colon in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\r*\n+)" }
-! { dg-output "Substring out of range for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\r*\n+)" }
-! { dg-output "Bad character in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h(\r*\n+)" }
+! { dg-output "Multiple sub-objects with non-zero rank in namelist object x%m%c012345678901234567890123456789012345678901234567890123456789h at line 2, column 80 in file .*(\r*\n+)" }
+! { dg-output "Missing colon in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h at line 2, column 79 in file .*(\r*\n+)" }
+! { dg-output "Substring out of range for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h at line 2, column 80 in file .*(\r*\n+)" }
+! { dg-output "Bad character in substring qualifier for namelist variable x%m%c012345678901234567890123456789012345678901234567890123456789h at line 2, column 80 in file .*" }
diff --git a/libgfortran/io/file_pos.c b/libgfortran/io/file_pos.c
index dd04ba45455..ecf18ba1fcf 100644
--- a/libgfortran/io/file_pos.c
+++ b/libgfortran/io/file_pos.c
@@ -480,6 +480,8 @@ st_rewind (st_parameter_filepos *fpp)
u->current_record = 0;
u->strm_pos = 1;
+ u->line_number = 1;
+ u->column_number = 0;
u->read_bad = 0;
u->last_char = EOF - 1;
}
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index d131d9544c4..ade0bef32d5 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -656,6 +656,9 @@ typedef struct gfc_unit
int read_bad, current_record, saved_pos, previous_nonadvancing_write;
+ /* Position information for better diagnostics. */
+ int line_number, column_number;
+
enum
{ NO_ENDFILE, AT_ENDFILE, AFTER_ENDFILE }
endfile;
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 757f2faac23..2b577baa7d3 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -211,6 +211,14 @@ next_char_default (st_parameter_dt *dtp)
if (c != EOF && is_stream_io (dtp))
dtp->u.p.current_unit->strm_pos++;
+ if (c == '\n')
+ {
+ dtp->u.p.current_unit->line_number++;
+ dtp->u.p.current_unit->column_number = 0;
+ }
+ else if (c != EOF)
+ dtp->u.p.current_unit->column_number++;
+
dtp->u.p.at_eol = (c == '\n' || c == EOF);
return c;
}
@@ -241,6 +249,8 @@ next_char_internal (st_parameter_dt *dtp)
int finished;
c = '\n';
+ dtp->u.p.current_unit->line_number++;
+ dtp->u.p.current_unit->column_number = 0;
record = next_array_record (dtp, dtp->u.p.current_unit->ls,
&finished);
@@ -302,6 +312,14 @@ next_char_internal (st_parameter_dt *dtp)
}
dtp->u.p.current_unit->bytes_left--;
+ if (c == '\n')
+ {
+ dtp->u.p.current_unit->line_number++;
+ dtp->u.p.current_unit->column_number = 0;
+ }
+ else if (c != EOF)
+ dtp->u.p.current_unit->column_number++;
+
done:
dtp->u.p.at_eol = (c == '\n' || c == EOF);
return c;
@@ -355,6 +373,14 @@ next_char_utf8 (st_parameter_dt *dtp)
goto invalid;
utf_done:
+ if (c == '\n')
+ {
+ dtp->u.p.current_unit->line_number++;
+ dtp->u.p.current_unit->column_number = 0;
+ }
+ else if (c != (gfc_char4_t) EOF)
+ dtp->u.p.current_unit->column_number++;
+
dtp->u.p.at_eol = (c == '\n' || c == (gfc_char4_t) EOF);
return (int) c;
@@ -3920,6 +3946,77 @@ nml_err_ret:
/* All namelist error calls return from here */
free_saved (dtp);
free_line (dtp);
- generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
+
+ if (dtp->u.p.current_unit)
+ {
+ int line = dtp->u.p.current_unit->line_number;
+ int col = dtp->u.p.current_unit->column_number;
+ char *filename = dtp->u.p.current_unit->filename;
+ char *detailed_msg;
+
+ char *line_text = NULL;
+ int line_len = 0;
+
+ if (is_internal_unit (dtp) && dtp->internal_unit)
+ {
+ GFC_IO_INT recl = dtp->u.p.current_unit->recl;
+ line_text = dtp->internal_unit + (line - 1) * recl;
+ line_len = recl;
+ }
+ else if (dtp->u.p.current_unit->fbuf)
+ {
+ struct fbuf *fb = dtp->u.p.current_unit->fbuf;
+ ptrdiff_t pos = fb->pos;
+ if (pos > 0)
+ {
+ ptrdiff_t start = pos - 1;
+ while (start > 0 && fb->buf[start-1] != '\n')
+ start--;
+ ptrdiff_t end = pos - 1;
+
+ /* Scan the buffer to get a fixed length of the text, but
+ don't exceed thr length of the line. */
+ while (end < (ptrdiff_t)fb->act
+ && (fb->buf[end] != '\n')
+ && (end - start < 128))
+ end++;
+ line_text = fb->buf + start;
+ line_len = end - start;
+ }
+ }
+
+ size_t msg_len = strlen (nml_err_msg) + 200;
+ if (line_text) msg_len += line_len + col + 10;
+ if (filename) msg_len += strlen (filename);
+
+ detailed_msg = xmalloc (msg_len);
+ int offset;
+ if (filename)
+ offset = sprintf (detailed_msg, "%s at line %lld, column %lld in file %s",
+ nml_err_msg, (long long) line, (long long) col, filename);
+ else
+ offset = sprintf (detailed_msg, "%s at line %lld, column %lld",
+ nml_err_msg, (long long) line, (long long) col);
+
+ if (line_text && line_len > 0)
+ {
+ detailed_msg[offset++] = '\n';
+ memcpy (detailed_msg + offset, line_text, line_len);
+ offset += line_len;
+ detailed_msg[offset++] = '\n';
+
+ for (int i = 0; i < col - 1; i++)
+ detailed_msg[offset++] = ' ';
+ detailed_msg[offset++] = '^';
+ detailed_msg[offset++] = '\n';
+ detailed_msg[offset] = '\0';
+ }
+
+ generate_error (&dtp->common, LIBERROR_READ_VALUE, detailed_msg);
+ free (detailed_msg);
+ }
+ else
+ generate_error (&dtp->common, LIBERROR_READ_VALUE, nml_err_msg);
+
return;
}
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index fac24db014d..84acfbdff98 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -238,6 +238,7 @@ insert_unit (int n)
{
gfc_unit *u = xcalloc (1, sizeof (gfc_unit));
u->unit_number = n;
+ u->line_number = 1;
u->internal_unit_kind = 0;
#ifdef __GTHREAD_MUTEX_INIT
{
