https://gcc.gnu.org/g:523be91d54c05016ee09c2f7ffc74d35f56e48e5
commit r17-1907-g523be91d54c05016ee09c2f7ffc74d35f56e48e5 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: --- gcc/testsuite/gfortran.dg/namelist_40.f90 | 14 +++-- gcc/testsuite/gfortran.dg/namelist_47.f90 | 10 ++-- libgfortran/io/file_pos.c | 2 + libgfortran/io/io.h | 3 + libgfortran/io/list_read.c | 99 ++++++++++++++++++++++++++++++- libgfortran/io/unit.c | 1 + 6 files changed, 118 insertions(+), 11 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/namelist_40.f90 b/gcc/testsuite/gfortran.dg/namelist_40.f90 index ba28d29e5b4d..96d360f52238 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 1000aba0575b..0c53dde40757 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 dd04ba454553..ecf18ba1fcf1 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 d131d9544c4f..ade0bef32d52 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 757f2faac238..2b577baa7d3c 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 fac24db014dc..84acfbdff98a 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 {
