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

Message ID 943c3685-c4d4-4f22-8b65-6336f8770043@gmail.com
State Unresolved
Headers
Series [libgfortran] Part 2: PR105456 Child I/O does not propage iostat |

Checks

Context Check Description
snail/gcc-patch-check warning Git am fail log

Commit Message

Jerry D Feb. 29, 2024, 5:29 a.m. UTC
  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.
  

Comments

Bernhard Reutner-Fischer Feb. 29, 2024, 9:47 a.m. UTC | #1
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.
  
Jerry D Feb. 29, 2024, 5:36 p.m. UTC | #2
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 -
  
Steve Kargl Feb. 29, 2024, 6:13 p.m. UTC | #3
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
  

Patch

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;
 		}