[patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

[-- Attachment #1: Type: text/plain, Size: 2318 bytes --]

The attached patch adds the error checks similar to the first patch 
previously committed.

I noticed a redundancy in some defines MSGLEN and IOMSG_LEN so I 
consolidated this to one define in io.h. This is just cleanup stuff.

I have added test cases for each of the places where UDTIO is done in 
the library.

Regressions tested on x86_64.

OK for trunk?

Regards,

Jerry

commit 640991bd6b83df4197b2eaec63d1e0e695e48b75
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date:   Wed Feb 28 20:51:06 2024 -0800

     Fortran: Add user defined error messages for UDTIO.

     The defines IOMSG_LEN and MSGLEN were redundant so these are combined
     into IOMSG_LEN as defined in io.h.

     The remainder of the patch adds checks for when a user defined
     derived type IO procedure sets the IOSTAT or IOMSG variables
     independent of the librrary defined I/O messages.

             PR libfortran/105456

     libgfortran/ChangeLog:

             * io/io.h (IOMSG_LEN): Moved to here.
             * io/list_read.c (MSGLEN): Removed MSGLEN.
             (convert_integer): Changed MSGLEN to IOMSG_LEN.
             (parse_repeat): Likewise.
             (read_logical): Likewise.
             (read_integer): Likewise.
             (read_character): Likewise.
             (parse_real): Likewise.
             (read_complex): Likewise.
             (read_real): Likewise.
             (check_type): Likewise.
             (list_formatted_read_scalar): Adjust to IOMSG_LEN.
             (nml_read_obj): Add user defined error message.
             * io/transfer.c (unformatted_read): Add user defined error
             message.
             (unformatted_write): Add user defined error message.
             (formatted_transfer_scalar_read): Add user defined error 
message.
             (formatted_transfer_scalar_write): Add user defined error 
message.
             * io/write.c (list_formatted_write_scalar): Add user 
defined error message.
             (nml_write_obj): Add user defined error message.

     gcc/testsuite/ChangeLog:

             * gfortran.dg/pr105456-nmlr.f90: New test.
             * gfortran.dg/pr105456-nmlw.f90: New test.
             * gfortran.dg/pr105456-ruf.f90: New test.
             * gfortran.dg/pr105456-wf.f90: New test.
             * gfortran.dg/pr105456-wuf.f90: New test.

[-- Attachment #2: pr105456-3.diff --]
[-- Type: text/x-patch, Size: 23917 bytes --]

diff --git a/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90 b/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90
new file mode 100644
index 00000000000..5ce5d082133
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module m
+  implicit none
+  type :: t
+    character :: c
+    integer :: k
+  contains
+    procedure :: write_formatted
+    generic :: write(formatted) => write_formatted
+    procedure :: read_formatted
+    generic :: read(formatted) => read_formatted
+  end type
+contains
+  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    if (iotype.eq."NAMELIST") then
+      write (unit, '(a1,a1,i3)') dtv%c,',', dtv%k
+    else
+      write (unit,*) dtv%c, dtv%k
+    end if
+  end subroutine
+  subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    character :: comma
+    if (iotype.eq."NAMELIST") then
+      read (unit, '(a1,a1,i3)') dtv%c, comma, dtv%k
+    else
+      read (unit,*) dtv%c, comma, dtv%k
+    endif
+    iostat = 42
+    iomsg = "The users message"
+    if (comma /= ',') STOP 1
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  character(len=50) :: buffer
+  type(t) :: x
+  namelist /nml/ x
+  x = t('a', 5)
+  write (buffer, nml)
+  if (buffer.ne.' &NML  X=a,  5  /') STOP 1
+  x = t('x', 0)
+  read (buffer, nml)
+  if (x%c.ne.'a'.or. x%k.ne.5) STOP 2
+end
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90 b/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90
new file mode 100644
index 00000000000..2c496e611f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module m
+  implicit none
+  type :: t
+    character :: c
+    integer :: k
+  contains
+    procedure :: write_formatted
+    generic :: write(formatted) => write_formatted
+    procedure :: read_formatted
+    generic :: read(formatted) => read_formatted
+  end type
+contains
+  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    if (iotype.eq."NAMELIST") then
+      write (unit, '(a1,a1,i3)') dtv%c,',', dtv%k
+    else
+      write (unit,*) dtv%c, dtv%k
+    end if
+    iostat = 42
+    iomsg = "The users message"
+  end subroutine
+  subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    character :: comma
+    if (iotype.eq."NAMELIST") then
+      read (unit, '(a1,a1,i3)') dtv%c, comma, dtv%k
+    else
+      read (unit,*) dtv%c, comma, dtv%k
+    end if
+    if (comma /= ',') STOP 1
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  character(len=50) :: buffer
+  type(t) :: x
+  namelist /nml/ x
+  x = t('a', 5)
+  write (buffer, nml)
+  if (buffer.ne.' &NML  X=a,  5  /') STOP 1
+  x = t('x', 0)
+  read (buffer, nml)
+  if (x%c.ne.'a'.or. x%k.ne.5) STOP 2
+end
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-ruf.f90 b/gcc/testsuite/gfortran.dg/pr105456-ruf.f90
new file mode 100644
index 00000000000..c176c4aa18c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-ruf.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface read (unformatted)
+     module procedure read_unformatted
+  end interface read (unformatted)
+contains
+  subroutine read_unformatted (dtv, unit, 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
+    read (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine read_unformatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, form='unformatted', status='scratch')
+  write (10) 'X'
+  rewind (10)
+  read (10) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-wf.f90 b/gcc/testsuite/gfortran.dg/pr105456-wf.f90
new file mode 100644
index 00000000000..f1c5350cc00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-wf.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface write (formatted)
+     module procedure write_formatted
+  end interface write (formatted)
+contains
+  subroutine write_formatted (dtv, unit, iotype, vlist, piostat, piomsg)
+    class (char), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: iotype
+    integer, intent(in) :: vlist(:)
+    integer, intent(out) :: piostat
+    character (len=*), intent(inout) :: piomsg
+    write (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine write_formatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, status='scratch')
+  write (10,*) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-wuf.f90 b/gcc/testsuite/gfortran.dg/pr105456-wuf.f90
new file mode 100644
index 00000000000..2b637b704a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-wuf.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface write (unformatted)
+     module procedure write_unformatted
+  end interface write (unformatted)
+contains
+  subroutine write_unformatted (dtv, unit, piostat, piomsg)
+    class (char), intent(in) :: dtv
+    integer, intent(in) :: unit
+    !character (len=*), intent(in) :: iotype
+    !integer, intent(in) :: vlist(:)
+    integer, intent(out) :: piostat
+    character (len=*), intent(inout) :: piomsg
+    write (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine write_unformatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, form='unformatted', status='scratch')
+  write (10) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 59bc19ee815..1c23676cc4c 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -34,6 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #define gcc_unreachable() __builtin_unreachable ()
 
+/* Used for building error message strings.  */
+#define IOMSG_LEN 256
+
 /* POSIX 2008 specifies that the extended locale stuff is found in
    locale.h, but some systems have them in xlocale.h.  */
 
@@ -99,10 +102,6 @@ typedef struct array_loop_spec
 }
 array_loop_spec;
 
-/* User defined input/output iomsg length. */
-
-#define IOMSG_LEN 256
-
 /* Subroutine formatted_dtio (struct, unit, iotype, v_list, iostat,
 			      iomsg, (_iotype), (_iomsg))  */
 typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *,
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index ee3ab713519..db7d53b69d8 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -64,10 +64,6 @@ typedef unsigned char uchar;
 
 #define MAX_REPEAT 200000000
 
-
-#define MSGLEN 100
-
-
 /* Wrappers for calling the current worker functions.  */
 
 #define next_char(dtp) ((dtp)->u.p.current_unit->next_char_fn_ptr (dtp))
@@ -632,7 +628,7 @@ nml_bad_return (st_parameter_dt *dtp, char c)
 static int
 convert_integer (st_parameter_dt *dtp, int length, int negative)
 {
-  char c, *buffer, message[MSGLEN];
+  char c, *buffer, message[IOMSG_LEN];
   int m;
   GFC_UINTEGER_LARGEST v, max, max10;
   GFC_INTEGER_LARGEST value;
@@ -682,7 +678,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
       if (dtp->u.p.repeat_count == 0)
 	{
-	  snprintf (message, MSGLEN, "Zero repeat count in item %d of list input",
+	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list input",
 		   dtp->u.p.item_count);
 
 	  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -695,10 +691,10 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
  overflow:
   if (length == -1)
-    snprintf (message, MSGLEN, "Repeat count overflow in item %d of list input",
+    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list input",
 	     dtp->u.p.item_count);
   else
-    snprintf (message, MSGLEN, "Integer overflow while reading item %d",
+    snprintf (message, IOMSG_LEN, "Integer overflow while reading item %d",
 	     dtp->u.p.item_count);
 
   free_saved (dtp);
@@ -715,7 +711,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 static int
 parse_repeat (st_parameter_dt *dtp)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, repeat;
 
   if ((c = next_char (dtp)) == EOF)
@@ -746,7 +742,7 @@ parse_repeat (st_parameter_dt *dtp)
 
 	  if (repeat > MAX_REPEAT)
 	    {
-	      snprintf (message, MSGLEN,
+	      snprintf (message, IOMSG_LEN,
 		       "Repeat count overflow in item %d of list input",
 		       dtp->u.p.item_count);
 
@@ -759,7 +755,7 @@ parse_repeat (st_parameter_dt *dtp)
 	case '*':
 	  if (repeat == 0)
 	    {
-	      snprintf (message, MSGLEN,
+	      snprintf (message, IOMSG_LEN,
 		       "Zero repeat count in item %d of list input",
 		       dtp->u.p.item_count);
 
@@ -789,7 +785,7 @@ parse_repeat (st_parameter_dt *dtp)
     }
   else
     eat_line (dtp);
-  snprintf (message, MSGLEN, "Bad repeat count in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad repeat count in item %d of list input",
 	   dtp->u.p.item_count);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
   return 1;
@@ -816,7 +812,7 @@ l_push_char (st_parameter_dt *dtp, char c)
 static void
 read_logical (st_parameter_dt *dtp, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, i, v;
 
   if (parse_repeat (dtp))
@@ -953,7 +949,7 @@ read_logical (st_parameter_dt *dtp, int length)
     }
   else if (c != '\n')
     eat_line (dtp);
-  snprintf (message, MSGLEN, "Bad logical value while reading item %d",
+  snprintf (message, IOMSG_LEN, "Bad logical value while reading item %d",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -977,7 +973,7 @@ read_logical (st_parameter_dt *dtp, int length)
 static void
 read_integer (st_parameter_dt *dtp, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, negative;
 
   negative = 0;
@@ -1112,7 +1108,7 @@ read_integer (st_parameter_dt *dtp, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad integer for item %d in list input",
+  snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1140,7 +1136,7 @@ read_integer (st_parameter_dt *dtp, int length)
 static void
 read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
 {
-  char quote, message[MSGLEN];
+  char quote, message[IOMSG_LEN];
   int c;
 
   quote = ' ';			/* Space means no quote character.  */
@@ -1286,7 +1282,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
   else
     {
       free_saved (dtp);
-      snprintf (message, MSGLEN, "Invalid string input in item %d",
+      snprintf (message, IOMSG_LEN, "Invalid string input in item %d",
 		  dtp->u.p.item_count);
       generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
     }
@@ -1306,7 +1302,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
 static int
 parse_real (st_parameter_dt *dtp, void *buffer, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, m, seen_dp;
 
   if ((c = next_char (dtp)) == EOF)
@@ -1521,7 +1517,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad complex floating point "
+  snprintf (message, IOMSG_LEN, "Bad complex floating point "
 	    "number for item %d", dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1536,7 +1532,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
 static void
 read_complex (st_parameter_dt *dtp, void *dest, int kind, size_t size)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c;
 
   if (parse_repeat (dtp))
@@ -1633,7 +1629,7 @@ eol_4:
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad complex value in item %d of list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1645,7 +1641,7 @@ eol_4:
 static void
 read_real (st_parameter_dt *dtp, void *dest, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c;
   int seen_dp;
   int is_inf;
@@ -2059,7 +2055,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad real number in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad real number in item %d of list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -2072,11 +2068,11 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
 static int
 check_type (st_parameter_dt *dtp, bt type, int kind)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
 
   if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
     {
-      snprintf (message, MSGLEN, "Read type %s where %s was expected for item %d",
+      snprintf (message, IOMSG_LEN, "Read type %s where %s was expected for item %d",
 		  type_name (dtp->u.p.saved_type), type_name (type),
 		  dtp->u.p.item_count);
       free_line (dtp);
@@ -2090,7 +2086,7 @@ check_type (st_parameter_dt *dtp, bt type, int kind)
   if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind)
       || (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2))
     {
-      snprintf (message, MSGLEN,
+      snprintf (message, IOMSG_LEN,
 		  "Read kind %d %s where kind %d is required for item %d",
 		  type == BT_COMPLEX ? dtp->u.p.saved_length / 2
 				     : dtp->u.p.saved_length,
@@ -2138,7 +2134,6 @@ 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;
@@ -2267,12 +2262,12 @@ 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))
 	    {
+	      char message[IOMSG_LEN];
 	      /* Trim trailing spaces from the message.  */
 	      for(int i = IOMSG_LEN - 1; i > 0; i--)
 		if (!isspace(child_iomsg[i]))
@@ -3060,7 +3055,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 
 		GFC_DESCRIPTOR_DATA(&vlist) = NULL;
 		GFC_DIMENSION_SET(vlist.dim[0],1, 0, 0);
-		
+
 		list_obj.vptr = nl->vtable;
 		list_obj.len = 0;
 
@@ -3088,6 +3083,26 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 			  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))
+		  {
+		    char message[IOMSG_LEN];
+		    /* 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;
+			}
+		    snprintf (message, child_iomsg_len, child_iomsg);
+		    generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+				    message);
+		    goto nml_err_ret;
+		  }
+
 		goto incr_idx;
 	      }
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 01db4122d16..992aacc1df9 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1120,7 +1120,28 @@ unformatted_read (st_parameter_dt *dtp, bt type,
 	  dtp->u.p.current_unit->child_dtio++;
 	  dtp->u.p.ufdtio_ptr (dest, &unit, child_iostat, child_iomsg,
 			       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))
+	    {
+	      char message[IOMSG_LEN];
+
+	      /* 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;
+		  }
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  return;
     }
 
@@ -1250,7 +1271,27 @@ unformatted_write (st_parameter_dt *dtp, bt type,
 	  dtp->u.p.current_unit->child_dtio++;
 	  dtp->u.p.ufdtio_ptr (source, &unit, child_iostat, child_iomsg,
 			       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))
+	    {
+	      char message[IOMSG_LEN];
+
+	      /* 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;
+		  }
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
 	  return;
     }
 
@@ -1730,8 +1771,28 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+
+	      /* 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;
+		  }
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  if (f->u.udf.string_len != 0)
 	    free (iotype);
 	  /* Note: vlist is freed in free_format_data.  */
@@ -2214,8 +2275,28 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+
+	      /* 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;
+		  }
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  if (f->u.udf.string_len != 0)
 	    free (iotype);
 	  /* Note: vlist is freed in free_format_data.  */
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 1a7c12345f9..d91a64d947b 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1991,7 +1991,27 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, &vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+
+	      /* 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;
+		  }
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
       }
       break;
     default:
@@ -2330,8 +2350,28 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
 				child_iostat, child_iomsg,
 				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))
+		    {
+		      char message[IOMSG_LEN];
+
+		      /* 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;
+			  }
+		      snprintf (message, child_iomsg_len, child_iomsg);
+		      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+				      message);
+		    }
+
 		  goto obj_loop;
 		}
 

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Bernhard Reutner-Fischer]

On Wed, 28 Feb 2024 21:29:06 -0800
Jerry D <jvdelisle2@gmail.com> wrote:

> The attached patch adds the error checks similar to the first patch 
> previously committed.
> 
> I noticed a redundancy in some defines MSGLEN and IOMSG_LEN so I 
> consolidated this to one define in io.h. This is just cleanup stuff.
> 
> I have added test cases for each of the places where UDTIO is done in 
> the library.
> 
> Regressions tested on x86_64.
> 
> OK for trunk?

I think the commit hooks will complain about several missing spaces
before open brace; See contrib/check_GNU_style.py /tmp/pr105456-3.diff

Would it make sense to introduce and use an internal helper like trim()?
Or would it be possible to trim the message in generate_error_common()?

And, just for my own education, the length limitation of iomsg to 255
chars is not backed by the standard AFAICS, right? It's just our
STRERR_MAXSZ?

thanks!

> 
> Regards,
> 
> Jerry
> 
> commit 640991bd6b83df4197b2eaec63d1e0e695e48b75
> Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
> Date:   Wed Feb 28 20:51:06 2024 -0800
> 
>      Fortran: Add user defined error messages for UDTIO.
> 
>      The defines IOMSG_LEN and MSGLEN were redundant so these are combined
>      into IOMSG_LEN as defined in io.h.
> 
>      The remainder of the patch adds checks for when a user defined
>      derived type IO procedure sets the IOSTAT or IOMSG variables
>      independent of the librrary defined I/O messages.
> 
>              PR libfortran/105456
> 
>      libgfortran/ChangeLog:
> 
>              * io/io.h (IOMSG_LEN): Moved to here.
>              * io/list_read.c (MSGLEN): Removed MSGLEN.
>              (convert_integer): Changed MSGLEN to IOMSG_LEN.
>              (parse_repeat): Likewise.
>              (read_logical): Likewise.
>              (read_integer): Likewise.
>              (read_character): Likewise.
>              (parse_real): Likewise.
>              (read_complex): Likewise.
>              (read_real): Likewise.
>              (check_type): Likewise.
>              (list_formatted_read_scalar): Adjust to IOMSG_LEN.
>              (nml_read_obj): Add user defined error message.
>              * io/transfer.c (unformatted_read): Add user defined error
>              message.
>              (unformatted_write): Add user defined error message.
>              (formatted_transfer_scalar_read): Add user defined error 
> message.
>              (formatted_transfer_scalar_write): Add user defined error 
> message.
>              * io/write.c (list_formatted_write_scalar): Add user 
> defined error message.
>              (nml_write_obj): Add user defined error message.
> 
>      gcc/testsuite/ChangeLog:
> 
>              * gfortran.dg/pr105456-nmlr.f90: New test.
>              * gfortran.dg/pr105456-nmlw.f90: New test.
>              * gfortran.dg/pr105456-ruf.f90: New test.
>              * gfortran.dg/pr105456-wf.f90: New test.
>              * gfortran.dg/pr105456-wuf.f90: New test.

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
> On Wed, 28 Feb 2024 21:29:06 -0800
> Jerry D <jvdelisle2@gmail.com> wrote:
> 
>> The attached patch adds the error checks similar to the first patch
>> previously committed.
>>
>> I noticed a redundancy in some defines MSGLEN and IOMSG_LEN so I
>> consolidated this to one define in io.h. This is just cleanup stuff.
>>
>> I have added test cases for each of the places where UDTIO is done in
>> the library.
>>
>> Regressions tested on x86_64.
>>
>> OK for trunk?
> 
> I think the commit hooks will complain about several missing spaces
> before open brace; See contrib/check_GNU_style.py /tmp/pr105456-3.diff

I was given the OK from git gcc-verify. Regardless if hooks fail I just 
fix and try again.

> 
> Would it make sense to introduce and use an internal helper like trim()?
> Or would it be possible to trim the message in generate_error_common()?
> 

I was debating this and what would be the best approach. I was not sure 
where to put it.  I like the idea of doing in the generate_error_common. 
  I will try that and see how it plays.

> And, just for my own education, the length limitation of iomsg to 255
> chars is not backed by the standard AFAICS, right? It's just our
> STRERR_MAXSZ?

Yes, its what we have had for a long lone time. Once you throw an error 
things get very processor dependent. I found MSGLEN set to 100 and 
IOMSG_len to 256. Nothing magic about it.

I appreciate the comments.

--- snip ---

Jerry -

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Steve Kargl]

On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
> 
> > And, just for my own education, the length limitation of iomsg to 255
> > chars is not backed by the standard AFAICS, right? It's just our
> > STRERR_MAXSZ?
> 
> Yes, its what we have had for a long lone time. Once you throw an error
> things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
> to 256. Nothing magic about it.
> 

There is no restriction on the length for the iomsg-variable
that receives the generated error message.  In fact, if the
iomsg-variable has a deferred-length type parameter, then
(re)-allocation to the exact length is expected.

  F2023

  12.11.6 IOMSG= specifier

  If an error, end-of-file, or end-of-record condition occurs during
  execution of an input/output statement, iomsg-variable is assigned
  an explanatory message, as if by intrinsic assignment. If no such
  condition occurs, the definition status and value of iomsg-variable
  are unchanged.
 
character(len=23) emsg
read(fd,*,iomsg=emsg)

Here, the generated iomsg is either truncated to a length of 23
or padded with blanks to a length of 23.

character(len=:), allocatable :: emsg
read(fd,*,iomsg=emsg)

Here, emsg should have the length of whatever error message was
generated.
 
HTH

-- 
Steve

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 2/29/24 10:13 AM, Steve Kargl wrote:
> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>
>>> And, just for my own education, the length limitation of iomsg to 255
>>> chars is not backed by the standard AFAICS, right? It's just our
>>> STRERR_MAXSZ?
>>
>> Yes, its what we have had for a long lone time. Once you throw an error
>> things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
>> to 256. Nothing magic about it.
>>
> 
> There is no restriction on the length for the iomsg-variable
> that receives the generated error message.  In fact, if the
> iomsg-variable has a deferred-length type parameter, then
> (re)-allocation to the exact length is expected.
> 
>    F2023
> 
>    12.11.6 IOMSG= specifier
> 
>    If an error, end-of-file, or end-of-record condition occurs during
>    execution of an input/output statement, iomsg-variable is assigned
>    an explanatory message, as if by intrinsic assignment. If no such
>    condition occurs, the definition status and value of iomsg-variable
>    are unchanged.
>   
> character(len=23) emsg
> read(fd,*,iomsg=emsg)
> 
> Here, the generated iomsg is either truncated to a length of 23
> or padded with blanks to a length of 23.
> 
> character(len=:), allocatable :: emsg
> read(fd,*,iomsg=emsg)
> 
> Here, emsg should have the length of whatever error message was
> generated.
>   
> HTH
> 

Well, currently, if someone uses a larger string than 256 we are going 
to chop it off.

Do we want to process this differently now?

Jerry

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Steve Kargl]

On Thu, Feb 29, 2024 at 10:28:19AM -0800, Jerry D wrote:
> On 2/29/24 10:13 AM, Steve Kargl wrote:
> > On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
> > > On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
> > > 
> > > > And, just for my own education, the length limitation of iomsg to 255
> > > > chars is not backed by the standard AFAICS, right? It's just our
> > > > STRERR_MAXSZ?
> > > 
> > > Yes, its what we have had for a long lone time. Once you throw an error
> > > things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
> > > to 256. Nothing magic about it.
> > > 
> > 
> > There is no restriction on the length for the iomsg-variable
> > that receives the generated error message.  In fact, if the
> > iomsg-variable has a deferred-length type parameter, then
> > (re)-allocation to the exact length is expected.
> > 
> >    F2023
> > 
> >    12.11.6 IOMSG= specifier
> > 
> >    If an error, end-of-file, or end-of-record condition occurs during
> >    execution of an input/output statement, iomsg-variable is assigned
> >    an explanatory message, as if by intrinsic assignment. If no such
> >    condition occurs, the definition status and value of iomsg-variable
> >    are unchanged.
> > character(len=23) emsg
> > read(fd,*,iomsg=emsg)
> > 
> > Here, the generated iomsg is either truncated to a length of 23
> > or padded with blanks to a length of 23.
> > 
> > character(len=:), allocatable :: emsg
> > read(fd,*,iomsg=emsg)
> > 
> > Here, emsg should have the length of whatever error message was
> > generated.
> > HTH
> > 
> 
> Well, currently, if someone uses a larger string than 256 we are going to
> chop it off.
> 
> Do we want to process this differently now?
> 

If I look at the interfaces for UDTIO in F2023 (pp. 254-255),
the declaration for iomsg is

  CHARACTER (LEN=*), INTENT(INOUT) :: iomsg

F2023 (p. 62) has 
  An asterisk as a type-param-value specifies that a length type
  parameter is an assumed type parameter.  It is used for a dummy
  argument to assume the type parameter value from the effective
  argument, ...

So, in theory, one should be able to get the required length
from length from the argument.

  CHARACTER(LEN=23) str
  WRITE(6,'(DT)',iomsg=str) derived-type-entity

If the subroutine supplied by the user internally creates
an error message with 300 characters, then from the above I 
would think that it will be truncated to 23 characters.
OTOH, if the user is expecting the full 300 characters with

  CHARACTER(LEN=300) str
  WRITE(6,'(DT)',iomsg=str) derived-type-entity

then truncating internally to 256 seems wrong.

Now, that I looked at the interface more closely, the declaration

  CHARACTER (LEN=*), INTENT(INOUT) :: iomsg

seems to block the use of an unallocated deferred-length 'str'
and (re)-allocation does not occur.

 

-- 
Steve

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 2/29/24 12:56 PM, Steve Kargl wrote:
> On Thu, Feb 29, 2024 at 10:28:19AM -0800, Jerry D wrote:
>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>
>>>>> And, just for my own education, the length limitation of iomsg to 255
>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>> STRERR_MAXSZ?
>>>>
>>>> Yes, its what we have had for a long lone time. Once you throw an error
>>>> things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
>>>> to 256. Nothing magic about it.
>>>>
>>>
>>> There is no restriction on the length for the iomsg-variable
>>> that receives the generated error message.  In fact, if the
>>> iomsg-variable has a deferred-length type parameter, then
>>> (re)-allocation to the exact length is expected.
>>>
>>>     F2023
>>>
>>>     12.11.6 IOMSG= specifier
>>>
>>>     If an error, end-of-file, or end-of-record condition occurs during
>>>     execution of an input/output statement, iomsg-variable is assigned
>>>     an explanatory message, as if by intrinsic assignment. If no such
>>>     condition occurs, the definition status and value of iomsg-variable
>>>     are unchanged.
>>> character(len=23) emsg
>>> read(fd,*,iomsg=emsg)
>>>
>>> Here, the generated iomsg is either truncated to a length of 23
>>> or padded with blanks to a length of 23.
>>>
>>> character(len=:), allocatable :: emsg
>>> read(fd,*,iomsg=emsg)
>>>
>>> Here, emsg should have the length of whatever error message was
>>> generated.
>>> HTH
>>>
>>
>> Well, currently, if someone uses a larger string than 256 we are going to
>> chop it off.
>>
>> Do we want to process this differently now?
>>
> 
> If I look at the interfaces for UDTIO in F2023 (pp. 254-255),
> the declaration for iomsg is
> 
>    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
> 
> F2023 (p. 62) has
>    An asterisk as a type-param-value specifies that a length type
>    parameter is an assumed type parameter.  It is used for a dummy
>    argument to assume the type parameter value from the effective
>    argument, ...
> 
> So, in theory, one should be able to get the required length
> from length from the argument.
> 
>    CHARACTER(LEN=23) str
>    WRITE(6,'(DT)',iomsg=str) derived-type-entity
> 
> If the subroutine supplied by the user internally creates
> an error message with 300 characters, then from the above I
> would think that it will be truncated to 23 characters.
> OTOH, if the user is expecting the full 300 characters with
> 
>    CHARACTER(LEN=300) str
>    WRITE(6,'(DT)',iomsg=str) derived-type-entity
> 
> then truncating internally to 256 seems wrong.
> 
> Now, that I looked at the interface more closely, the declaration
> 
>    CHARACTER (LEN=*), INTENT(INOUT) :: iomsg
> 
> seems to block the use of an unallocated deferred-length 'str'
> and (re)-allocation does not occur.
> 
>   
> 
Without addressing the length discussions above, I did find an existing 
function in libgfortran to trim the spaces at the end (string_len_trim). 
  I am using it as follows:

		if ((dtp->u.p.child_saved_iostat != 0) &&
		    !(dtp->common.flags & IOPARM_HAS_IOMSG) &&
		    !(dtp->common.flags & IOPARM_HAS_IOSTAT))
		  {
		    char message[IOMSG_LEN];
		    child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
		    snprintf (message, child_iomsg_len, child_iomsg);
		    generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
				    message);
		    goto nml_err_ret;
		  }

I will study the len questions further.

Jerry

PS I wish my mail client would not wrap text on me, working on that issue.

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[rep.dot.nop]

On 29 February 2024 23:28:44 CET, Jerry D <jvdelisle2@gmail.com> wrote:
>On 2/29/24 12:56 PM, Steve Kargl wrote:
>> On Thu, Feb 29, 2024 at 10:28:19AM -0800, Jerry D wrote:
>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>> 
>>>>>> And, just for my own education, the length limitation of iomsg to 255
>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>> STRERR_MAXSZ?
>>>>> 
>>>>> Yes, its what we have had for a long lone time. Once you throw an error
>>>>> things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
>>>>> to 256. Nothing magic about it.

It was system dependent.
In the lib, here, it was probed at runtime, cross used IOV_MAX on lunix per default, in the non error case looped.


>PS I wish my mail client would not wrap text on me, working on that issue.

try :paste
Or set tw=0, although 80 makes sense for me, or 72 in mail (if you are able to clip)

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

[-- Attachment #1: Type: text/plain, Size: 2743 bytes --]

On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
> Hi Jerry and Steve,
> 
> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com> wrote:
>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>
>>>>> And, just for my own education, the length limitation of iomsg to 255
>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>> STRERR_MAXSZ?
>>>>
>>>> Yes, its what we have had for a long lone time. Once you throw an error
>>>> things get very processor dependent. I found MSGLEN set to 100 and IOMSG_len
>>>> to 256. Nothing magic about it.
>>>>
>>>
>>> There is no restriction on the length for the iomsg-variable
>>> that receives the generated error message.  In fact, if the
>>> iomsg-variable has a deferred-length type parameter, then
>>> (re)-allocation to the exact length is expected.
>>>
>>>     F2023
>>>
>>>     12.11.6 IOMSG= specifier
>>>
>>>     If an error, end-of-file, or end-of-record condition occurs during
>>>     execution of an input/output statement, iomsg-variable is assigned
>>>     an explanatory message, as if by intrinsic assignment. If no such
>>>     condition occurs, the definition status and value of iomsg-variable
>>>     are unchanged.
>>>    character(len=23) emsg
>>> read(fd,*,iomsg=emsg)
>>>
>>> Here, the generated iomsg is either truncated to a length of 23
>>> or padded with blanks to a length of 23.
>>>
>>> character(len=:), allocatable :: emsg
>>> read(fd,*,iomsg=emsg)
>>>
>>> Here, emsg should have the length of whatever error message was
>>> generated.
>>>    HTH
>>>
>>
>> Well, currently, if someone uses a larger string than 256 we are going to chop it off.
>>
>> Do we want to process this differently now?
> 
> Yes. There is some odd hunk about discrepancy of passed len and actual len afterwards in 22-007-r1, IIRC. Didn't look closely though.
> 
--- snip ---

Attached is the revised patch using the already available 
string_len_trim function.

This hunk is only executed if a user has not passed an iostat or iomsg 
variable in the parent I/O statement and an error is triggered which 
terminates execution of the program. In this case, the iomsg string is 
provided in the usual error message in a "processor defined" way.

(F2023):

12.6.4.8.3 Executing defined input/output data transfers
---
11 If the iostat argument of the defined input/output procedure has a 
nonzero value when that procedure returns, and the processor therefore 
terminates execution of the program as described in 12.11, the processor 
shall make the value of the iomsg argument available in a 
processor-dependent manner.
---

OK for trunk?

Regards,

Jerry



[-- Attachment #2: pr105456-submit.diff --]
[-- Type: text/x-patch, Size: 25348 bytes --]

commit 51a24ace512e96b425bcde46c056e816c4606784
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date:   Mon Mar 4 18:45:49 2024 -0800

    Fortran: Add user defined error messages for UDTIO.
    
    The defines IOMSG_LEN and MSGLEN were redundant so these are combined
    into IOMSG_LEN as defined in io.h.
    
    The remainder of the patch adds checks for when a user defined
    derived type IO procedure sets the IOSTAT or IOMSG variables
    independent of the librrary defined I/O messages.
    
            PR libfortran/105456
    
    libgfortran/ChangeLog:
    
            * io/io.h (IOMSG_LEN): Moved to here.
            * io/list_read.c (MSGLEN): Removed MSGLEN.
            (convert_integer): Changed MSGLEN to IOMSG_LEN.
            (parse_repeat): Likewise.
            (read_logical): Likewise.
            (read_integer): Likewise.
            (read_character): Likewise.
            (parse_real): Likewise.
            (read_complex): Likewise.
            (read_real): Likewise.
            (check_type): Likewise.
            (list_formatted_read_scalar): Adjust to IOMSG_LEN.
            (nml_read_obj): Add user defined error message.
            * io/transfer.c (unformatted_read): Add user defined error
            message.
            (unformatted_write): Add user defined error message.
            (formatted_transfer_scalar_read): Add user defined error message.
            (formatted_transfer_scalar_write): Add user defined error message.
            * io/write.c (list_formatted_write_scalar): Add user defined error message.
            (nml_write_obj): Add user defined error message.
    
    gcc/testsuite/ChangeLog:
    
            * gfortran.dg/pr105456-nmlr.f90: New test.
            * gfortran.dg/pr105456-nmlw.f90: New test.
            * gfortran.dg/pr105456-ruf.f90: New test.
            * gfortran.dg/pr105456-wf.f90: New test.
            * gfortran.dg/pr105456-wuf.f90: New test.

diff --git a/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90 b/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90
new file mode 100644
index 00000000000..5ce5d082133
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module m
+  implicit none
+  type :: t
+    character :: c
+    integer :: k
+  contains
+    procedure :: write_formatted
+    generic :: write(formatted) => write_formatted
+    procedure :: read_formatted
+    generic :: read(formatted) => read_formatted
+  end type
+contains
+  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    if (iotype.eq."NAMELIST") then
+      write (unit, '(a1,a1,i3)') dtv%c,',', dtv%k
+    else
+      write (unit,*) dtv%c, dtv%k
+    end if
+  end subroutine
+  subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    character :: comma
+    if (iotype.eq."NAMELIST") then
+      read (unit, '(a1,a1,i3)') dtv%c, comma, dtv%k
+    else
+      read (unit,*) dtv%c, comma, dtv%k
+    endif
+    iostat = 42
+    iomsg = "The users message"
+    if (comma /= ',') STOP 1
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  character(len=50) :: buffer
+  type(t) :: x
+  namelist /nml/ x
+  x = t('a', 5)
+  write (buffer, nml)
+  if (buffer.ne.' &NML  X=a,  5  /') STOP 1
+  x = t('x', 0)
+  read (buffer, nml)
+  if (x%c.ne.'a'.or. x%k.ne.5) STOP 2
+end
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90 b/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90
new file mode 100644
index 00000000000..2c496e611f4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-nmlw.f90
@@ -0,0 +1,60 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module m
+  implicit none
+  type :: t
+    character :: c
+    integer :: k
+  contains
+    procedure :: write_formatted
+    generic :: write(formatted) => write_formatted
+    procedure :: read_formatted
+    generic :: read(formatted) => read_formatted
+  end type
+contains
+  subroutine write_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    if (iotype.eq."NAMELIST") then
+      write (unit, '(a1,a1,i3)') dtv%c,',', dtv%k
+    else
+      write (unit,*) dtv%c, dtv%k
+    end if
+    iostat = 42
+    iomsg = "The users message"
+  end subroutine
+  subroutine read_formatted(dtv, unit, iotype, v_list, iostat, iomsg)
+    class(t), intent(inout) :: dtv
+    integer, intent(in) :: unit
+    character(*), intent(in) :: iotype
+    integer, intent(in) :: v_list(:)
+    integer, intent(out) :: iostat
+    character(*), intent(inout) :: iomsg
+    character :: comma
+    if (iotype.eq."NAMELIST") then
+      read (unit, '(a1,a1,i3)') dtv%c, comma, dtv%k
+    else
+      read (unit,*) dtv%c, comma, dtv%k
+    end if
+    if (comma /= ',') STOP 1
+  end subroutine
+end module
+
+program p
+  use m
+  implicit none
+  character(len=50) :: buffer
+  type(t) :: x
+  namelist /nml/ x
+  x = t('a', 5)
+  write (buffer, nml)
+  if (buffer.ne.' &NML  X=a,  5  /') STOP 1
+  x = t('x', 0)
+  read (buffer, nml)
+  if (x%c.ne.'a'.or. x%k.ne.5) STOP 2
+end
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-ruf.f90 b/gcc/testsuite/gfortran.dg/pr105456-ruf.f90
new file mode 100644
index 00000000000..c176c4aa18c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-ruf.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface read (unformatted)
+     module procedure read_unformatted
+  end interface read (unformatted)
+contains
+  subroutine read_unformatted (dtv, unit, 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
+    read (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine read_unformatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, form='unformatted', status='scratch')
+  write (10) 'X'
+  rewind (10)
+  read (10) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-wf.f90 b/gcc/testsuite/gfortran.dg/pr105456-wf.f90
new file mode 100644
index 00000000000..f1c5350cc00
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-wf.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface write (formatted)
+     module procedure write_formatted
+  end interface write (formatted)
+contains
+  subroutine write_formatted (dtv, unit, iotype, vlist, piostat, piomsg)
+    class (char), intent(in) :: dtv
+    integer, intent(in) :: unit
+    character (len=*), intent(in) :: iotype
+    integer, intent(in) :: vlist(:)
+    integer, intent(out) :: piostat
+    character (len=*), intent(inout) :: piomsg
+    write (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine write_formatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, status='scratch')
+  write (10,*) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/gcc/testsuite/gfortran.dg/pr105456-wuf.f90 b/gcc/testsuite/gfortran.dg/pr105456-wuf.f90
new file mode 100644
index 00000000000..2b637b704a4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr105456-wuf.f90
@@ -0,0 +1,34 @@
+! { dg-do run }
+! { dg-shouldfail "The users message" }
+module sk1
+  implicit none
+  type char
+     character :: ch
+  end type char
+  interface write (unformatted)
+     module procedure write_unformatted
+  end interface write (unformatted)
+contains
+  subroutine write_unformatted (dtv, unit, piostat, piomsg)
+    class (char), intent(in) :: dtv
+    integer, intent(in) :: unit
+    !character (len=*), intent(in) :: iotype
+    !integer, intent(in) :: vlist(:)
+    integer, intent(out) :: piostat
+    character (len=*), intent(inout) :: piomsg
+    write (unit,fmt='(A1)', advance="no", iostat=piostat, iomsg=piomsg) dtv%ch
+    piostat = 42
+    piomsg="The users message"
+  end subroutine write_unformatted
+end module sk1
+
+program skip1
+  use sk1
+  implicit none
+  type (char) :: x
+  x%ch = 'X'
+  open (10, form='unformatted', status='scratch')
+  write (10) x
+end program skip1
+! { dg-output ".*(unit = 10, file = .*)" }
+! { dg-output "Fortran runtime error: The users message" }
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 59bc19ee815..1c23676cc4c 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -34,6 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 #define gcc_unreachable() __builtin_unreachable ()
 
+/* Used for building error message strings.  */
+#define IOMSG_LEN 256
+
 /* POSIX 2008 specifies that the extended locale stuff is found in
    locale.h, but some systems have them in xlocale.h.  */
 
@@ -99,10 +102,6 @@ typedef struct array_loop_spec
 }
 array_loop_spec;
 
-/* User defined input/output iomsg length. */
-
-#define IOMSG_LEN 256
-
 /* Subroutine formatted_dtio (struct, unit, iotype, v_list, iostat,
 			      iomsg, (_iotype), (_iomsg))  */
 typedef void (*formatted_dtio)(void *, GFC_INTEGER_4 *, char *,
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index ee3ab713519..3d374f55027 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -64,10 +64,6 @@ typedef unsigned char uchar;
 
 #define MAX_REPEAT 200000000
 
-
-#define MSGLEN 100
-
-
 /* Wrappers for calling the current worker functions.  */
 
 #define next_char(dtp) ((dtp)->u.p.current_unit->next_char_fn_ptr (dtp))
@@ -632,7 +628,7 @@ nml_bad_return (st_parameter_dt *dtp, char c)
 static int
 convert_integer (st_parameter_dt *dtp, int length, int negative)
 {
-  char c, *buffer, message[MSGLEN];
+  char c, *buffer, message[IOMSG_LEN];
   int m;
   GFC_UINTEGER_LARGEST v, max, max10;
   GFC_INTEGER_LARGEST value;
@@ -682,7 +678,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
       if (dtp->u.p.repeat_count == 0)
 	{
-	  snprintf (message, MSGLEN, "Zero repeat count in item %d of list input",
+	  snprintf (message, IOMSG_LEN, "Zero repeat count in item %d of list input",
 		   dtp->u.p.item_count);
 
 	  generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -695,10 +691,10 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 
  overflow:
   if (length == -1)
-    snprintf (message, MSGLEN, "Repeat count overflow in item %d of list input",
+    snprintf (message, IOMSG_LEN, "Repeat count overflow in item %d of list input",
 	     dtp->u.p.item_count);
   else
-    snprintf (message, MSGLEN, "Integer overflow while reading item %d",
+    snprintf (message, IOMSG_LEN, "Integer overflow while reading item %d",
 	     dtp->u.p.item_count);
 
   free_saved (dtp);
@@ -715,7 +711,7 @@ convert_integer (st_parameter_dt *dtp, int length, int negative)
 static int
 parse_repeat (st_parameter_dt *dtp)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, repeat;
 
   if ((c = next_char (dtp)) == EOF)
@@ -746,7 +742,7 @@ parse_repeat (st_parameter_dt *dtp)
 
 	  if (repeat > MAX_REPEAT)
 	    {
-	      snprintf (message, MSGLEN,
+	      snprintf (message, IOMSG_LEN,
 		       "Repeat count overflow in item %d of list input",
 		       dtp->u.p.item_count);
 
@@ -759,7 +755,7 @@ parse_repeat (st_parameter_dt *dtp)
 	case '*':
 	  if (repeat == 0)
 	    {
-	      snprintf (message, MSGLEN,
+	      snprintf (message, IOMSG_LEN,
 		       "Zero repeat count in item %d of list input",
 		       dtp->u.p.item_count);
 
@@ -789,7 +785,7 @@ parse_repeat (st_parameter_dt *dtp)
     }
   else
     eat_line (dtp);
-  snprintf (message, MSGLEN, "Bad repeat count in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad repeat count in item %d of list input",
 	   dtp->u.p.item_count);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
   return 1;
@@ -816,7 +812,7 @@ l_push_char (st_parameter_dt *dtp, char c)
 static void
 read_logical (st_parameter_dt *dtp, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, i, v;
 
   if (parse_repeat (dtp))
@@ -953,7 +949,7 @@ read_logical (st_parameter_dt *dtp, int length)
     }
   else if (c != '\n')
     eat_line (dtp);
-  snprintf (message, MSGLEN, "Bad logical value while reading item %d",
+  snprintf (message, IOMSG_LEN, "Bad logical value while reading item %d",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -977,7 +973,7 @@ read_logical (st_parameter_dt *dtp, int length)
 static void
 read_integer (st_parameter_dt *dtp, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, negative;
 
   negative = 0;
@@ -1112,7 +1108,7 @@ read_integer (st_parameter_dt *dtp, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad integer for item %d in list input",
+  snprintf (message, IOMSG_LEN, "Bad integer for item %d in list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1140,7 +1136,7 @@ read_integer (st_parameter_dt *dtp, int length)
 static void
 read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
 {
-  char quote, message[MSGLEN];
+  char quote, message[IOMSG_LEN];
   int c;
 
   quote = ' ';			/* Space means no quote character.  */
@@ -1286,7 +1282,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
   else
     {
       free_saved (dtp);
-      snprintf (message, MSGLEN, "Invalid string input in item %d",
+      snprintf (message, IOMSG_LEN, "Invalid string input in item %d",
 		  dtp->u.p.item_count);
       generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
     }
@@ -1306,7 +1302,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
 static int
 parse_real (st_parameter_dt *dtp, void *buffer, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c, m, seen_dp;
 
   if ((c = next_char (dtp)) == EOF)
@@ -1521,7 +1517,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad complex floating point "
+  snprintf (message, IOMSG_LEN, "Bad complex floating point "
 	    "number for item %d", dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1536,7 +1532,7 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
 static void
 read_complex (st_parameter_dt *dtp, void *dest, int kind, size_t size)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c;
 
   if (parse_repeat (dtp))
@@ -1633,7 +1629,7 @@ eol_4:
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad complex value in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad complex value in item %d of list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -1645,7 +1641,7 @@ eol_4:
 static void
 read_real (st_parameter_dt *dtp, void *dest, int length)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
   int c;
   int seen_dp;
   int is_inf;
@@ -2059,7 +2055,7 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
   else if (c != '\n')
     eat_line (dtp);
 
-  snprintf (message, MSGLEN, "Bad real number in item %d of list input",
+  snprintf (message, IOMSG_LEN, "Bad real number in item %d of list input",
 	      dtp->u.p.item_count);
   free_line (dtp);
   generate_error (&dtp->common, LIBERROR_READ_VALUE, message);
@@ -2072,11 +2068,11 @@ read_real (st_parameter_dt *dtp, void *dest, int length)
 static int
 check_type (st_parameter_dt *dtp, bt type, int kind)
 {
-  char message[MSGLEN];
+  char message[IOMSG_LEN];
 
   if (dtp->u.p.saved_type != BT_UNKNOWN && dtp->u.p.saved_type != type)
     {
-      snprintf (message, MSGLEN, "Read type %s where %s was expected for item %d",
+      snprintf (message, IOMSG_LEN, "Read type %s where %s was expected for item %d",
 		  type_name (dtp->u.p.saved_type), type_name (type),
 		  dtp->u.p.item_count);
       free_line (dtp);
@@ -2090,7 +2086,7 @@ check_type (st_parameter_dt *dtp, bt type, int kind)
   if ((type != BT_COMPLEX && dtp->u.p.saved_length != kind)
       || (type == BT_COMPLEX && dtp->u.p.saved_length != kind*2))
     {
-      snprintf (message, MSGLEN,
+      snprintf (message, IOMSG_LEN,
 		  "Read kind %d %s where kind %d is required for item %d",
 		  type == BT_COMPLEX ? dtp->u.p.saved_length / 2
 				     : dtp->u.p.saved_length,
@@ -2138,7 +2134,6 @@ 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;
@@ -2233,7 +2228,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
 	  GFC_INTEGER_4 unit = dtp->u.p.current_unit->unit_number;
 	  char iotype[] = "LISTDIRECTED";
           gfc_charlen_type iotype_len = 12;
-	  char tmp_iomsg[IOMSG_LEN] = "";
+	  char tmp_iomsg[IOMSG_LEN];
 	  char *child_iomsg;
 	  gfc_charlen_type child_iomsg_len;
 	  GFC_INTEGER_4 noiostat;
@@ -2267,20 +2262,13 @@ 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;
-		  }
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
 	      free_line (dtp);
 	      snprintf (message, child_iomsg_len, child_iomsg);
 	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
@@ -3060,7 +3048,7 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 
 		GFC_DESCRIPTOR_DATA(&vlist) = NULL;
 		GFC_DIMENSION_SET(vlist.dim[0],1, 0, 0);
-		
+
 		list_obj.vptr = nl->vtable;
 		list_obj.len = 0;
 
@@ -3088,6 +3076,19 @@ nml_read_obj (st_parameter_dt *dtp, namelist_info *nl, index_type offset,
 			  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))
+		  {
+		    char message[IOMSG_LEN];
+		    child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+		    snprintf (message, child_iomsg_len, child_iomsg);
+		    generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+				    message);
+		    goto nml_err_ret;
+		  }
+
 		goto incr_idx;
 	      }
 
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 01db4122d16..8a094a6aa09 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -1120,7 +1120,20 @@ unformatted_read (st_parameter_dt *dtp, bt type,
 	  dtp->u.p.current_unit->child_dtio++;
 	  dtp->u.p.ufdtio_ptr (dest, &unit, child_iostat, child_iomsg,
 			       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))
+	    {
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  return;
     }
 
@@ -1250,7 +1263,19 @@ unformatted_write (st_parameter_dt *dtp, bt type,
 	  dtp->u.p.current_unit->child_dtio++;
 	  dtp->u.p.ufdtio_ptr (source, &unit, child_iostat, child_iomsg,
 			       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))
+	    {
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
 	  return;
     }
 
@@ -1730,8 +1755,20 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  if (f->u.udf.string_len != 0)
 	    free (iotype);
 	  /* Note: vlist is freed in free_format_data.  */
@@ -2214,8 +2251,20 @@ formatted_transfer_scalar_write (st_parameter_dt *dtp, bt type, void *p, int kin
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
+
 	  if (f->u.udf.string_len != 0)
 	    free (iotype);
 	  /* Note: vlist is freed in free_format_data.  */
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 1a7c12345f9..913369db486 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1991,7 +1991,19 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, &vlist,
 			      child_iostat, child_iomsg,
 			      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))
+	    {
+	      char message[IOMSG_LEN];
+	      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+	      snprintf (message, child_iomsg_len, child_iomsg);
+	      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+			      message);
+	    }
       }
       break;
     default:
@@ -2330,8 +2342,22 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info *obj, index_type offset,
 				child_iostat, child_iomsg,
 				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))
+		    {
+		      char message[IOMSG_LEN];
+
+		      /* Trim trailing spaces from the message.  */
+		      child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1;
+		      snprintf (message, child_iomsg_len, child_iomsg);
+		      generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
+				      message);
+		    }
+
 		  goto obj_loop;
 		}
 

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[rep.dot.nop]

On 5 March 2024 04:15:12 CET, Jerry D <jvdelisle2@gmail.com> wrote:

>
>Attached is the revised patch using the already available string_len_trim function.
>
>This hunk is only executed if a user has not passed an iostat or iomsg variable in the parent I/O statement and an error is triggered which terminates execution of the program. In this case, the iomsg string is provided in the usual error message in a "processor defined" way.
>
>(F2023):
>
>12.6.4.8.3 Executing defined input/output data transfers
>---
>11 If the iostat argument of the defined input/output procedure has a nonzero value when that procedure returns, and the processor therefore terminates execution of the program as described in 12.11, the processor shall make the value of the iomsg argument available in a processor-dependent manner.
>---
>
>OK for trunk?

LGTM.
thanks!

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Harald Anlauf]

Hi Jerry,

I think there is the risk of buffer overrun in the following places:

+             char message[IOMSG_LEN];
+             child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg)
+ 1;
               free_line (dtp);
               snprintf (message, child_iomsg_len, child_iomsg);
               generate_error (&dtp->common, dtp->u.p.child_saved_iostat,

plus several more.  Wouldn't it be better to increase the size of
message by one?

Thanks,
Harald


On 3/5/24 04:15, Jerry D wrote:
> On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
>> Hi Jerry and Steve,
>>
>> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com> wrote:
>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>>
>>>>>> And, just for my own education, the length limitation of iomsg to 255
>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>> STRERR_MAXSZ?
>>>>>
>>>>> Yes, its what we have had for a long lone time. Once you throw an
>>>>> error
>>>>> things get very processor dependent. I found MSGLEN set to 100 and
>>>>> IOMSG_len
>>>>> to 256. Nothing magic about it.
>>>>>
>>>>
>>>> There is no restriction on the length for the iomsg-variable
>>>> that receives the generated error message.  In fact, if the
>>>> iomsg-variable has a deferred-length type parameter, then
>>>> (re)-allocation to the exact length is expected.
>>>>
>>>>     F2023
>>>>
>>>>     12.11.6 IOMSG= specifier
>>>>
>>>>     If an error, end-of-file, or end-of-record condition occurs during
>>>>     execution of an input/output statement, iomsg-variable is assigned
>>>>     an explanatory message, as if by intrinsic assignment. If no such
>>>>     condition occurs, the definition status and value of iomsg-variable
>>>>     are unchanged.
>>>>    character(len=23) emsg
>>>> read(fd,*,iomsg=emsg)
>>>>
>>>> Here, the generated iomsg is either truncated to a length of 23
>>>> or padded with blanks to a length of 23.
>>>>
>>>> character(len=:), allocatable :: emsg
>>>> read(fd,*,iomsg=emsg)
>>>>
>>>> Here, emsg should have the length of whatever error message was
>>>> generated.
>>>>    HTH
>>>>
>>>
>>> Well, currently, if someone uses a larger string than 256 we are
>>> going to chop it off.
>>>
>>> Do we want to process this differently now?
>>
>> Yes. There is some odd hunk about discrepancy of passed len and actual
>> len afterwards in 22-007-r1, IIRC. Didn't look closely though.
>>
> --- snip ---
>
> Attached is the revised patch using the already available
> string_len_trim function.
>
> This hunk is only executed if a user has not passed an iostat or iomsg
> variable in the parent I/O statement and an error is triggered which
> terminates execution of the program. In this case, the iomsg string is
> provided in the usual error message in a "processor defined" way.
>
> (F2023):
>
> 12.6.4.8.3 Executing defined input/output data transfers
> ---
> 11 If the iostat argument of the defined input/output procedure has a
> nonzero value when that procedure returns, and the processor therefore
> terminates execution of the program as described in 12.11, the processor
> shall make the value of the iomsg argument available in a
> processor-dependent manner.
> ---
>
> OK for trunk?
>
> Regards,
>
> Jerry
>
>

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Harald Anlauf]

Hi Jerry,

on further thought, do we sanitize 'child_iomsg'?
We pass it to snprintf as format.

Wouldn't a strncpy be sufficient?

Harald


On 3/5/24 22:37, Harald Anlauf wrote:
> Hi Jerry,
>
> I think there is the risk of buffer overrun in the following places:
>
> +             char message[IOMSG_LEN];
> +             child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg)
> + 1;
>                free_line (dtp);
>                snprintf (message, child_iomsg_len, child_iomsg);
>                generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
>
> plus several more.  Wouldn't it be better to increase the size of
> message by one?
>
> Thanks,
> Harald
>
>
> On 3/5/24 04:15, Jerry D wrote:
>> On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
>>> Hi Jerry and Steve,
>>>
>>> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com> wrote:
>>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>>>
>>>>>>> And, just for my own education, the length limitation of iomsg to
>>>>>>> 255
>>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>>> STRERR_MAXSZ?
>>>>>>
>>>>>> Yes, its what we have had for a long lone time. Once you throw an
>>>>>> error
>>>>>> things get very processor dependent. I found MSGLEN set to 100 and
>>>>>> IOMSG_len
>>>>>> to 256. Nothing magic about it.
>>>>>>
>>>>>
>>>>> There is no restriction on the length for the iomsg-variable
>>>>> that receives the generated error message.  In fact, if the
>>>>> iomsg-variable has a deferred-length type parameter, then
>>>>> (re)-allocation to the exact length is expected.
>>>>>
>>>>>     F2023
>>>>>
>>>>>     12.11.6 IOMSG= specifier
>>>>>
>>>>>     If an error, end-of-file, or end-of-record condition occurs during
>>>>>     execution of an input/output statement, iomsg-variable is assigned
>>>>>     an explanatory message, as if by intrinsic assignment. If no such
>>>>>     condition occurs, the definition status and value of
>>>>> iomsg-variable
>>>>>     are unchanged.
>>>>>    character(len=23) emsg
>>>>> read(fd,*,iomsg=emsg)
>>>>>
>>>>> Here, the generated iomsg is either truncated to a length of 23
>>>>> or padded with blanks to a length of 23.
>>>>>
>>>>> character(len=:), allocatable :: emsg
>>>>> read(fd,*,iomsg=emsg)
>>>>>
>>>>> Here, emsg should have the length of whatever error message was
>>>>> generated.
>>>>>    HTH
>>>>>
>>>>
>>>> Well, currently, if someone uses a larger string than 256 we are
>>>> going to chop it off.
>>>>
>>>> Do we want to process this differently now?
>>>
>>> Yes. There is some odd hunk about discrepancy of passed len and
>>> actual len afterwards in 22-007-r1, IIRC. Didn't look closely though.
>>>
>> --- snip ---
>>
>> Attached is the revised patch using the already available
>> string_len_trim function.
>>
>> This hunk is only executed if a user has not passed an iostat or iomsg
>> variable in the parent I/O statement and an error is triggered which
>> terminates execution of the program. In this case, the iomsg string is
>> provided in the usual error message in a "processor defined" way.
>>
>> (F2023):
>>
>> 12.6.4.8.3 Executing defined input/output data transfers
>> ---
>> 11 If the iostat argument of the defined input/output procedure has a
>> nonzero value when that procedure returns, and the processor therefore
>> terminates execution of the program as described in 12.11, the
>> processor shall make the value of the iomsg argument available in a
>> processor-dependent manner.
>> ---
>>
>> OK for trunk?
>>
>> Regards,
>>
>> Jerry
>>
>>
>
>
>

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 3/5/24 1:51 PM, Harald Anlauf wrote:
> Hi Jerry,
> 
> on further thought, do we sanitize 'child_iomsg'?
> We pass it to snprintf as format.
> 
> Wouldn't a strncpy be sufficient?
> 
> Harald
> 
> 

Just to be safe I will bump char message[IOMSG_LEN] to char 
message[IOMSG_LEN + 1]

This is like a C string vs a Fortran string length situation. snprintf 
guarantees we don't exceed the child_iomsg_len and null terminates it.

I added 1 to:
  child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1

Because snprintf was chopping off the last character of the fortran 
string to put the null in. (zero based vs one based char array). I test 
this with a very long string which exceeded the length and then reduced 
it until I could see the desired end.

I have not tried running a test case with sanitize. I did check with 
valgrind.  I will try the sanitize flags to see if we get a problem.  If 
not will push.

Thanks for comments,

Jerry -

> On 3/5/24 22:37, Harald Anlauf wrote:
>> Hi Jerry,
>>
>> I think there is the risk of buffer overrun in the following places:
>>
>> +             char message[IOMSG_LEN];
>> +             child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg)
>> + 1;
>>                free_line (dtp);
>>                snprintf (message, child_iomsg_len, child_iomsg);
>>                generate_error (&dtp->common, dtp->u.p.child_saved_iostat,
>>
>> plus several more.  Wouldn't it be better to increase the size of
>> message by one?
>>
>> Thanks,
>> Harald
>>
>>
>> On 3/5/24 04:15, Jerry D wrote:
>>> On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
>>>> Hi Jerry and Steve,
>>>>
>>>> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com> wrote:
>>>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>>>>
>>>>>>>> And, just for my own education, the length limitation of iomsg to
>>>>>>>> 255
>>>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>>>> STRERR_MAXSZ?
>>>>>>>
>>>>>>> Yes, its what we have had for a long lone time. Once you throw an
>>>>>>> error
>>>>>>> things get very processor dependent. I found MSGLEN set to 100 and
>>>>>>> IOMSG_len
>>>>>>> to 256. Nothing magic about it.
>>>>>>>
>>>>>>
>>>>>> There is no restriction on the length for the iomsg-variable
>>>>>> that receives the generated error message.  In fact, if the
>>>>>> iomsg-variable has a deferred-length type parameter, then
>>>>>> (re)-allocation to the exact length is expected.
>>>>>>
>>>>>>     F2023
>>>>>>
>>>>>>     12.11.6 IOMSG= specifier
>>>>>>
>>>>>>     If an error, end-of-file, or end-of-record condition occurs 
>>>>>> during
>>>>>>     execution of an input/output statement, iomsg-variable is 
>>>>>> assigned
>>>>>>     an explanatory message, as if by intrinsic assignment. If no such
>>>>>>     condition occurs, the definition status and value of
>>>>>> iomsg-variable
>>>>>>     are unchanged.
>>>>>>    character(len=23) emsg
>>>>>> read(fd,*,iomsg=emsg)
>>>>>>
>>>>>> Here, the generated iomsg is either truncated to a length of 23
>>>>>> or padded with blanks to a length of 23.
>>>>>>
>>>>>> character(len=:), allocatable :: emsg
>>>>>> read(fd,*,iomsg=emsg)
>>>>>>
>>>>>> Here, emsg should have the length of whatever error message was
>>>>>> generated.
>>>>>>    HTH
>>>>>>
>>>>>
>>>>> Well, currently, if someone uses a larger string than 256 we are
>>>>> going to chop it off.
>>>>>
>>>>> Do we want to process this differently now?
>>>>
>>>> Yes. There is some odd hunk about discrepancy of passed len and
>>>> actual len afterwards in 22-007-r1, IIRC. Didn't look closely though.
>>>>
>>> --- snip ---
>>>
>>> Attached is the revised patch using the already available
>>> string_len_trim function.
>>>
>>> This hunk is only executed if a user has not passed an iostat or iomsg
>>> variable in the parent I/O statement and an error is triggered which
>>> terminates execution of the program. In this case, the iomsg string is
>>> provided in the usual error message in a "processor defined" way.
>>>
>>> (F2023):
>>>
>>> 12.6.4.8.3 Executing defined input/output data transfers
>>> ---
>>> 11 If the iostat argument of the defined input/output procedure has a
>>> nonzero value when that procedure returns, and the processor therefore
>>> terminates execution of the program as described in 12.11, the
>>> processor shall make the value of the iomsg argument available in a
>>> processor-dependent manner.
>>> ---
>>>
>>> OK for trunk?
>>>
>>> Regards,
>>>
>>> Jerry
>>>
>>>
>>
>>
>>
> 

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Steve Kargl]

On Tue, Mar 05, 2024 at 08:06:10PM -0800, Jerry D wrote:
> On 3/5/24 1:51 PM, Harald Anlauf wrote:
> > Hi Jerry,
> > 
> > on further thought, do we sanitize 'child_iomsg'?
> > We pass it to snprintf as format.
> > 
> > Wouldn't a strncpy be sufficient?
> > 
> > Harald
> > 
> > 
> 
> Just to be safe I will bump char message[IOMSG_LEN] to char
> message[IOMSG_LEN + 1]
> 
> This is like a C string vs a Fortran string length situation. snprintf
> guarantees we don't exceed the child_iomsg_len and null terminates it.
> 
> I added 1 to:
>  child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1
> 

string_len_trim substracts 1 from the passed in argument.

gfc_charlen_type
string_len_trim (gfc_charlen_type len, const CHARTYPE *s)
{
  if (len <= 0)
    return 0;

  const size_t long_len = sizeof (unsigned long);

  size_t i = len - 1;


Does this account for the NULL?

-- 
steve

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Harald Anlauf]

Hi Jerry,

can you please replace the user message in e.g. your new testcase
pr105456-wf.f90 by say:

piomsg="The users message containing % and %% and %s and other stuff"

This behaves as expected with Intel, but dies horribly with gfortran
after your patch!

Cheers,
Harald


On 3/6/24 05:06, Jerry D wrote:
> On 3/5/24 1:51 PM, Harald Anlauf wrote:
>> Hi Jerry,
>>
>> on further thought, do we sanitize 'child_iomsg'?
>> We pass it to snprintf as format.
>>
>> Wouldn't a strncpy be sufficient?
>>
>> Harald
>>
>>
>
> Just to be safe I will bump char message[IOMSG_LEN] to char
> message[IOMSG_LEN + 1]
>
> This is like a C string vs a Fortran string length situation. snprintf
> guarantees we don't exceed the child_iomsg_len and null terminates it.
>
> I added 1 to:
>   child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1
>
> Because snprintf was chopping off the last character of the fortran
> string to put the null in. (zero based vs one based char array). I test
> this with a very long string which exceeded the length and then reduced
> it until I could see the desired end.
>
> I have not tried running a test case with sanitize. I did check with
> valgrind.  I will try the sanitize flags to see if we get a problem.  If
> not will push.
>
> Thanks for comments,
>
> Jerry -
>
>> On 3/5/24 22:37, Harald Anlauf wrote:
>>> Hi Jerry,
>>>
>>> I think there is the risk of buffer overrun in the following places:
>>>
>>> +             char message[IOMSG_LEN];
>>> +             child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg)
>>> + 1;
>>>                free_line (dtp);
>>>                snprintf (message, child_iomsg_len, child_iomsg);
>>>                generate_error (&dtp->common,
>>> dtp->u.p.child_saved_iostat,
>>>
>>> plus several more.  Wouldn't it be better to increase the size of
>>> message by one?
>>>
>>> Thanks,
>>> Harald
>>>
>>>
>>> On 3/5/24 04:15, Jerry D wrote:
>>>> On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
>>>>> Hi Jerry and Steve,
>>>>>
>>>>> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com>
>>>>> wrote:
>>>>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>>>>>
>>>>>>>>> And, just for my own education, the length limitation of iomsg to
>>>>>>>>> 255
>>>>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>>>>> STRERR_MAXSZ?
>>>>>>>>
>>>>>>>> Yes, its what we have had for a long lone time. Once you throw an
>>>>>>>> error
>>>>>>>> things get very processor dependent. I found MSGLEN set to 100 and
>>>>>>>> IOMSG_len
>>>>>>>> to 256. Nothing magic about it.
>>>>>>>>
>>>>>>>
>>>>>>> There is no restriction on the length for the iomsg-variable
>>>>>>> that receives the generated error message.  In fact, if the
>>>>>>> iomsg-variable has a deferred-length type parameter, then
>>>>>>> (re)-allocation to the exact length is expected.
>>>>>>>
>>>>>>>     F2023
>>>>>>>
>>>>>>>     12.11.6 IOMSG= specifier
>>>>>>>
>>>>>>>     If an error, end-of-file, or end-of-record condition occurs
>>>>>>> during
>>>>>>>     execution of an input/output statement, iomsg-variable is
>>>>>>> assigned
>>>>>>>     an explanatory message, as if by intrinsic assignment. If no
>>>>>>> such
>>>>>>>     condition occurs, the definition status and value of
>>>>>>> iomsg-variable
>>>>>>>     are unchanged.
>>>>>>>    character(len=23) emsg
>>>>>>> read(fd,*,iomsg=emsg)
>>>>>>>
>>>>>>> Here, the generated iomsg is either truncated to a length of 23
>>>>>>> or padded with blanks to a length of 23.
>>>>>>>
>>>>>>> character(len=:), allocatable :: emsg
>>>>>>> read(fd,*,iomsg=emsg)
>>>>>>>
>>>>>>> Here, emsg should have the length of whatever error message was
>>>>>>> generated.
>>>>>>>    HTH
>>>>>>>
>>>>>>
>>>>>> Well, currently, if someone uses a larger string than 256 we are
>>>>>> going to chop it off.
>>>>>>
>>>>>> Do we want to process this differently now?
>>>>>
>>>>> Yes. There is some odd hunk about discrepancy of passed len and
>>>>> actual len afterwards in 22-007-r1, IIRC. Didn't look closely though.
>>>>>
>>>> --- snip ---
>>>>
>>>> Attached is the revised patch using the already available
>>>> string_len_trim function.
>>>>
>>>> This hunk is only executed if a user has not passed an iostat or iomsg
>>>> variable in the parent I/O statement and an error is triggered which
>>>> terminates execution of the program. In this case, the iomsg string is
>>>> provided in the usual error message in a "processor defined" way.
>>>>
>>>> (F2023):
>>>>
>>>> 12.6.4.8.3 Executing defined input/output data transfers
>>>> ---
>>>> 11 If the iostat argument of the defined input/output procedure has a
>>>> nonzero value when that procedure returns, and the processor therefore
>>>> terminates execution of the program as described in 12.11, the
>>>> processor shall make the value of the iomsg argument available in a
>>>> processor-dependent manner.
>>>> ---
>>>>
>>>> OK for trunk?
>>>>
>>>> Regards,
>>>>
>>>> Jerry
>>>>
>>>>
>>>
>>>
>>>
>>
>
>

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Harald Anlauf]

Hi Jerry,

can you please replace the user message in e.g. your new testcase
pr105456-wf.f90 by say:

piomsg="The users message containing % and %% and %s and other stuff"

This behaves as expected with Intel, but dies horribly with gfortran
after your patch!

Cheers,
Harald


On 3/6/24 05:06, Jerry D wrote:
> On 3/5/24 1:51 PM, Harald Anlauf wrote:
>> Hi Jerry,
>>
>> on further thought, do we sanitize 'child_iomsg'?
>> We pass it to snprintf as format.
>>
>> Wouldn't a strncpy be sufficient?
>>
>> Harald
>>
>>
> 
> Just to be safe I will bump char message[IOMSG_LEN] to char 
> message[IOMSG_LEN + 1]
> 
> This is like a C string vs a Fortran string length situation. snprintf 
> guarantees we don't exceed the child_iomsg_len and null terminates it.
> 
> I added 1 to:
>   child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg) + 1
> 
> Because snprintf was chopping off the last character of the fortran 
> string to put the null in. (zero based vs one based char array). I test 
> this with a very long string which exceeded the length and then reduced 
> it until I could see the desired end.
> 
> I have not tried running a test case with sanitize. I did check with 
> valgrind.  I will try the sanitize flags to see if we get a problem.  If 
> not will push.
> 
> Thanks for comments,
> 
> Jerry -
> 
>> On 3/5/24 22:37, Harald Anlauf wrote:
>>> Hi Jerry,
>>>
>>> I think there is the risk of buffer overrun in the following places:
>>>
>>> +             char message[IOMSG_LEN];
>>> +             child_iomsg_len = string_len_trim (IOMSG_LEN, child_iomsg)
>>> + 1;
>>>                free_line (dtp);
>>>                snprintf (message, child_iomsg_len, child_iomsg);
>>>                generate_error (&dtp->common, 
>>> dtp->u.p.child_saved_iostat,
>>>
>>> plus several more.  Wouldn't it be better to increase the size of
>>> message by one?
>>>
>>> Thanks,
>>> Harald
>>>
>>>
>>> On 3/5/24 04:15, Jerry D wrote:
>>>> On 3/1/24 11:24 AM, rep.dot.nop@gmail.com wrote:
>>>>> Hi Jerry and Steve,
>>>>>
>>>>> On 29 February 2024 19:28:19 CET, Jerry D <jvdelisle2@gmail.com> 
>>>>> wrote:
>>>>>> On 2/29/24 10:13 AM, Steve Kargl wrote:
>>>>>>> On Thu, Feb 29, 2024 at 09:36:43AM -0800, Jerry D wrote:
>>>>>>>> On 2/29/24 1:47 AM, Bernhard Reutner-Fischer wrote:
>>>>>>>>
>>>>>>>>> And, just for my own education, the length limitation of iomsg to
>>>>>>>>> 255
>>>>>>>>> chars is not backed by the standard AFAICS, right? It's just our
>>>>>>>>> STRERR_MAXSZ?
>>>>>>>>
>>>>>>>> Yes, its what we have had for a long lone time. Once you throw an
>>>>>>>> error
>>>>>>>> things get very processor dependent. I found MSGLEN set to 100 and
>>>>>>>> IOMSG_len
>>>>>>>> to 256. Nothing magic about it.
>>>>>>>>
>>>>>>>
>>>>>>> There is no restriction on the length for the iomsg-variable
>>>>>>> that receives the generated error message.  In fact, if the
>>>>>>> iomsg-variable has a deferred-length type parameter, then
>>>>>>> (re)-allocation to the exact length is expected.
>>>>>>>
>>>>>>>     F2023
>>>>>>>
>>>>>>>     12.11.6 IOMSG= specifier
>>>>>>>
>>>>>>>     If an error, end-of-file, or end-of-record condition occurs 
>>>>>>> during
>>>>>>>     execution of an input/output statement, iomsg-variable is 
>>>>>>> assigned
>>>>>>>     an explanatory message, as if by intrinsic assignment. If no 
>>>>>>> such
>>>>>>>     condition occurs, the definition status and value of
>>>>>>> iomsg-variable
>>>>>>>     are unchanged.
>>>>>>>    character(len=23) emsg
>>>>>>> read(fd,*,iomsg=emsg)
>>>>>>>
>>>>>>> Here, the generated iomsg is either truncated to a length of 23
>>>>>>> or padded with blanks to a length of 23.
>>>>>>>
>>>>>>> character(len=:), allocatable :: emsg
>>>>>>> read(fd,*,iomsg=emsg)
>>>>>>>
>>>>>>> Here, emsg should have the length of whatever error message was
>>>>>>> generated.
>>>>>>>    HTH
>>>>>>>
>>>>>>
>>>>>> Well, currently, if someone uses a larger string than 256 we are
>>>>>> going to chop it off.
>>>>>>
>>>>>> Do we want to process this differently now?
>>>>>
>>>>> Yes. There is some odd hunk about discrepancy of passed len and
>>>>> actual len afterwards in 22-007-r1, IIRC. Didn't look closely though.
>>>>>
>>>> --- snip ---
>>>>
>>>> Attached is the revised patch using the already available
>>>> string_len_trim function.
>>>>
>>>> This hunk is only executed if a user has not passed an iostat or iomsg
>>>> variable in the parent I/O statement and an error is triggered which
>>>> terminates execution of the program. In this case, the iomsg string is
>>>> provided in the usual error message in a "processor defined" way.
>>>>
>>>> (F2023):
>>>>
>>>> 12.6.4.8.3 Executing defined input/output data transfers
>>>> ---
>>>> 11 If the iostat argument of the defined input/output procedure has a
>>>> nonzero value when that procedure returns, and the processor therefore
>>>> terminates execution of the program as described in 12.11, the
>>>> processor shall make the value of the iomsg argument available in a
>>>> processor-dependent manner.
>>>> ---
>>>>
>>>> OK for trunk?
>>>>
>>>> Regards,
>>>>
>>>> Jerry
>>>>
>>>>
>>>
>>>
>>>
>>
> 
> 

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 3/6/24 9:13 AM, Harald Anlauf wrote:
> Hi Jerry,
> 
> can you please replace the user message in e.g. your new testcase
> pr105456-wf.f90 by say:
> 
> piomsg="The users message containing % and %% and %s and other stuff"
> 
> This behaves as expected with Intel, but dies horribly with gfortran
> after your patch!
> 
> Cheers,
> Harald
> 
I do not have the intel compiler.

I will look at this but I do not know what the expectation is.

Is there non-standard treatment of % symbols?

Jerry

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 3/6/24 9:13 AM, Harald Anlauf wrote:
> "The users message containing % and %% and %s and other stuff"

I see what you mean. our standard error messages are expecting values in 
these places and since none are there, fault.

Should we simply output "The users message containing % and %% and %s 
and other stuff" literally? Does intel allow inserting things like error 
locus in these message strings?

Regards,

Jerry

Re: [patch, libgfortran] Part 2: PR105456 Child I/O does not propage iostat

[Jerry D]

On 3/6/24 9:13 AM, Harald Anlauf wrote:
> Hi Jerry,
> 
> can you please replace the user message in e.g. your new testcase
> pr105456-wf.f90 by say:
> 
> piomsg="The users message containing % and %% and %s and other stuff"
> 
> This behaves as expected with Intel, but dies horribly with gfortran
> after your patch!
> 
> Cheers,
> Harald
> 
> 

Fixed with:

commit 03932d3203bce244edd812b81921c2f16ea18d86 (HEAD -> master, 
origin/master, origin/HEAD)
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date:   Wed Mar 6 19:46:04 2024 -0800

     Fortran: Fix issue with using snprintf function.

     The previous patch used snprintf to set the message
     string. The message string is not a formatted string
     and the snprintf will interpret '%' related characters
     as format specifiers when there are no associated
     output variables. A segfault ensues.

     This change replaces snprintf with a fortran string copy
     function and null terminates the message string.

             PR libfortran/105456

     libgfortran/ChangeLog:

             * io/list_read.c (list_formatted_read_scalar): Use fstrcpy
             from libgfortran/runtime/string.c to replace snprintf.
             (nml_read_obj): Likewise.
             * io/transfer.c (unformatted_read): Likewise.
             (unformatted_write): Likewise.
             (formatted_transfer_scalar_read): Likewise.
             (formatted_transfer_scalar_write): Likewise.
             * io/write.c (list_formatted_write_scalar): Likewise.
             (nml_write_obj): Likewise.

     gcc/testsuite/ChangeLog:

             * gfortran.dg/pr105456.f90: Revise using '%' characters
             in users error message.

Jerry -