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