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.

5 files changed, 224 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90 b/gcc/testsuite/gfortran.dg/pr105456-nmlr.f90
new file mode 100644
index 0000000..5ce5d08
--- /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 0000000..2c496e6
--- /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 0000000..c176c4a
--- /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 0000000..f1c5350
--- /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 0000000..2b637b7
--- /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" }