[gcc r14-9168] libgfortran: Propagate user defined iostat and iomsg.

[gcc r14-9168] libgfortran: Propagate user defined iostat and iomsg.

[Jerry DeLisle]

https://gcc.gnu.org/g:3f58f96a4e8255e222953f9856bcd6c25f7b33cd

commit r14-9168-g3f58f96a4e8255e222953f9856bcd6c25f7b33cd
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
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)