Message ID | 701a3111-c3b5-422c-bee7-50ba00e3847a@gmail.com |
---|---|
State | New |
Headers | show |
Series | [libgfortran] PR105456 Child I/O does not propage iostat | expand |
Hi Jerry, On 2/22/24 20:11, Jerry D wrote: > Hi all, > > The attached fix adds a check for an error condition from a UDDTIO > procedure in the case where there is no actual underlying error, but the > user defines an error by setting the iostat variable manually before > returning to the parent READ. the libgfortran fix LGTM. Regarding the testcase code, the following looks like you left some debugging code in it: + rewind (10) + read (10,*) x + print *, myerror, mymessage + write (*,'(10(A))') "Read: '",x%ch,"'" myerror and mymessage are never set and never tested. I suggest to either remove them or to enhance the testcase e.g. like rewind (10) read (10,*,iostat=myerror,iomsg=mymessage) x if (myerror /= 42 .or. mymessage /= "The users message") stop 1 rewind (10) read (10,*) x write (*,'(10(A))') "Read: '",x%ch,"'" I'll leave that up to you. > I did not address the case of a formatted WRITE or unformatted > READ/WRITE until I get some feedback on the approach. If this approach > is OK I would like to commit and then do a separate patch for the cases > I just mentioned. I haven't thought about this long enough, but I do not anything wrong with your patch. > Feedback appreciated. Regression tested on x86_64. OK for trunk? This is OK. Thanks, Harald > Jerry > > Author: Jerry DeLisle <jvdelisle@gcc.gnu.org> > Date: Thu Feb 22 10:48:39 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. > > gcc/testsuite/ChangeLog: > > * gfortran.dg/pr105456.f90: New test.
On 2/25/24 12:34 PM, Harald Anlauf wrote: > Hi Jerry, > > On 2/22/24 20:11, Jerry D wrote: >> Hi all, >> >> The attached fix adds a check for an error condition from a UDDTIO >> procedure in the case where there is no actual underlying error, but the >> user defines an error by setting the iostat variable manually before >> returning to the parent READ. > > the libgfortran fix LGTM. > > Regarding the testcase code, the following looks like you left some > debugging code in it: > > + rewind (10) > + read (10,*) x > + print *, myerror, mymessage > + write (*,'(10(A))') "Read: '",x%ch,"'" > --- snip --- I cleaned up the test case. Thanks for review. The master branch has been updated by Jerry DeLisle <jvdelisle@gcc.gnu.org>: https://gcc.gnu.org/g:3f58f96a4e8255e222953f9856bcd6c25f7b33cd Regards, Jerry
diff --git a/gcc/testsuite/gfortran.dg/pr105456.f90 b/gcc/testsuite/gfortran.dg/pr105456.f90 new file mode 100644 index 00000000000..411873f4aed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr105456.f90 @@ -0,0 +1,41 @@ +! { 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 + integer :: myerror = 0 + character(64) :: mymessage = "" + type (char) :: x + open (10,status="scratch") + write (10,'(A)') '', 'a' + rewind (10) + read (10,*) x + print *, myerror, mymessage + 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 3d29cb64813..ee3ab713519 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: