From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1442) id E9AAA3858D1E; Sun, 25 Feb 2024 22:55:37 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org E9AAA3858D1E DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1708901737; bh=+LhGVEBAwkc1o0yksPiTGhcfF0oHm9lP2PXiXVOZGsE=; h=From:To:Subject:Date:From; b=OrM3flWSGvbvsbaP77dn34CVUZN87NPriWN3004lYWSjVQa+VxWXDi0x5TGQcpzzz kmxjPGZer3FETVYpWvY+bE+sXZp2MP9wmHbbWIgvcNCZQFFtRCiZ++fBjSTwqoyqMl AVBrpoTsIr/diS5smR0pxvPfzhzdbl0SYj4A5DOo= MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Type: text/plain; charset="utf-8" From: Jerry DeLisle To: gcc-cvs@gcc.gnu.org Subject: [gcc r14-9168] libgfortran: Propagate user defined iostat and iomsg. X-Act-Checkin: gcc X-Git-Author: Jerry DeLisle X-Git-Refname: refs/heads/master X-Git-Oldrev: d1b241b9506cdc0ebd3f43d12cf77d7c33271342 X-Git-Newrev: 3f58f96a4e8255e222953f9856bcd6c25f7b33cd Message-Id: <20240225225537.E9AAA3858D1E@sourceware.org> Date: Sun, 25 Feb 2024 22:55:37 +0000 (GMT) List-Id: https://gcc.gnu.org/g:3f58f96a4e8255e222953f9856bcd6c25f7b33cd commit r14-9168-g3f58f96a4e8255e222953f9856bcd6c25f7b33cd Author: Jerry DeLisle Date: Sun Feb 25 14:50:07 2024 -0800 libgfortran: Propagate user defined iostat and iomsg. PR libfortran/105456 libgfortran/ChangeLog: * io/list_read.c (list_formatted_read_scalar): Add checks for the case where a user defines their own error codes and error messages and generate the runtime error. * io/transfer.c (st_read_done): Whitespace. gcc/testsuite/ChangeLog: * gfortran.dg/pr105456.f90: New test. Diff: --- gcc/testsuite/gfortran.dg/pr105456.f90 | 38 ++++++++++++++++++++++++++++++++++ libgfortran/io/list_read.c | 22 +++++++++++++++++++- libgfortran/io/transfer.c | 2 +- 3 files changed, 60 insertions(+), 2 deletions(-) diff --git a/gcc/testsuite/gfortran.dg/pr105456.f90 b/gcc/testsuite/gfortran.dg/pr105456.f90 new file mode 100644 index 000000000000..188323847a7a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr105456.f90 @@ -0,0 +1,38 @@ +! { dg-do run } +! { dg-shouldfail "The users message" } +module sk1 + implicit none + type char + character :: ch + end type char + interface read (formatted) + module procedure read_formatted + end interface read (formatted) +contains + subroutine read_formatted (dtv, unit, iotype, vlist, piostat, piomsg) + class (char), intent(inout) :: dtv + integer, intent(in) :: unit + character (len=*), intent(in) :: iotype + integer, intent(in) :: vlist(:) + integer, intent(out) :: piostat + character (len=*), intent(inout) :: piomsg + character :: ch + read (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) ch + piostat = 42 + piomsg="The users message" + dtv%ch = ch + end subroutine read_formatted +end module sk1 + +program skip1 + use sk1 + implicit none + type (char) :: x + open (10,status="scratch") + write (10,'(A)') '', 'a' + rewind (10) + read (10,*) x + write (*,'(10(A))') "Read: '",x%ch,"'" +end program skip1 +! { dg-output ".*(unit = 10, file = .*)" } +! { dg-output "Fortran runtime error: The users message" } diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c index 3d29cb64813c..ee3ab7135196 100644 --- a/libgfortran/io/list_read.c +++ b/libgfortran/io/list_read.c @@ -2138,6 +2138,7 @@ static int list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, int kind, size_t size) { + char message[MSGLEN]; gfc_char4_t *q, *r; size_t m; int c; @@ -2247,7 +2248,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, child_iostat = ((dtp->common.flags & IOPARM_HAS_IOSTAT) ? dtp->common.iostat : &noiostat); - /* Set iomsge, intent(inout). */ + /* Set iomsg, intent(inout). */ if (dtp->common.flags & IOPARM_HAS_IOMSG) { child_iomsg = dtp->common.iomsg; @@ -2266,6 +2267,25 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p, iotype_len, child_iomsg_len); dtp->u.p.child_saved_iostat = *child_iostat; dtp->u.p.current_unit->child_dtio--; + + + if ((dtp->u.p.child_saved_iostat != 0) && + !(dtp->common.flags & IOPARM_HAS_IOMSG) && + !(dtp->common.flags & IOPARM_HAS_IOSTAT)) + { + /* Trim trailing spaces from the message. */ + for(int i = IOMSG_LEN - 1; i > 0; i--) + if (!isspace(child_iomsg[i])) + { + /* Add two to get back to the end of child_iomsg. */ + child_iomsg_len = i+2; + break; + } + free_line (dtp); + snprintf (message, child_iomsg_len, child_iomsg); + generate_error (&dtp->common, dtp->u.p.child_saved_iostat, + message); + } } break; default: diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index 99ef96a9e7c8..01db4122d16d 100644 --- a/libgfortran/io/transfer.c +++ b/libgfortran/io/transfer.c @@ -4556,7 +4556,7 @@ st_read_done (st_parameter_dt *dtp) if (dtp->u.p.current_unit->au) { if (dtp->common.flags & IOPARM_DT_HAS_ID) - *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au, AIO_READ_DONE); + *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au, AIO_READ_DONE); else { if (dtp->u.p.async)