diff mbox series

[libgfortran] PR105456 Child I/O does not propage iostat

Message ID 701a3111-c3b5-422c-bee7-50ba00e3847a@gmail.com
State New
Headers show
Series [libgfortran] PR105456 Child I/O does not propage iostat | expand

Commit Message

Jerry D Feb. 22, 2024, 7:11 p.m. UTC
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.

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.

Feedback appreciated.  Regression tested on x86_64. OK for trunk?

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.

Comments

Harald Anlauf Feb. 25, 2024, 8:34 p.m. UTC | #1
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.
Jerry D Feb. 25, 2024, 10:58 p.m. UTC | #2
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 mbox series

Patch

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: