public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* Re: [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
@ 2017-03-22 17:05 Dominique d'Humières
  0 siblings, 0 replies; 6+ messages in thread
From: Dominique d'Humières @ 2017-03-22 17:05 UTC (permalink / raw)
  To: jvdelisle; +Cc: GCC-Fortran-ML, GCC-Patches-ML

The patch works as expected. Note that the line

! { dg-final { cleanup-modules "t_m" } }
in  dtio_26.f03 and  dtio_27.f03 can/should be removed IIRC.

Cheers,

Dominique

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
  2017-03-25 18:49   ` Jerry DeLisle
@ 2017-03-27  7:33     ` Christophe Lyon
  0 siblings, 0 replies; 6+ messages in thread
From: Christophe Lyon @ 2017-03-27  7:33 UTC (permalink / raw)
  To: Jerry DeLisle; +Cc: Paul Richard Thomas, fortran, GCC Patches

Hi,


On 25 March 2017 at 19:49, Jerry DeLisle <jvdelisle@charter.net> wrote:
> On 03/25/2017 11:00 AM, Paul Richard Thomas wrote:
>>
>> Hi Jerry,
>>
>> This looks fine to me. OK for trunk.
>>
>> Thanks for the patch.
>>
>> Paul
>>
>
> Thanks for review Paul.
>
>         A       gcc/testsuite/gfortran.dg/dtio_26.f03
>         M       gcc/testsuite/ChangeLog
>         M       libgfortran/ChangeLog
>         M       libgfortran/io/io.h
>         M       libgfortran/io/list_read.c
>         M       libgfortran/io/transfer.c
> Committed r246478
>

Besides the typo in the ChangeLog (the new testcase is dtio_26.f03,
not dtio_26.f90),
I've noticed that the new test fails on arm-linux-gnueabihf targets, but passes
on arm-linux-gnueabi targets.
My gfortran.log only says:
Program aborted.

Christophe



> Jerry

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
  2017-03-25 18:00 ` Paul Richard Thomas
@ 2017-03-25 18:49   ` Jerry DeLisle
  2017-03-27  7:33     ` Christophe Lyon
  0 siblings, 1 reply; 6+ messages in thread
From: Jerry DeLisle @ 2017-03-25 18:49 UTC (permalink / raw)
  To: Paul Richard Thomas; +Cc: fortran, GCC Patches

On 03/25/2017 11:00 AM, Paul Richard Thomas wrote:
> Hi Jerry,
>
> This looks fine to me. OK for trunk.
>
> Thanks for the patch.
>
> Paul
>

Thanks for review Paul.

	A	gcc/testsuite/gfortran.dg/dtio_26.f03
	M	gcc/testsuite/ChangeLog
	M	libgfortran/ChangeLog
	M	libgfortran/io/io.h
	M	libgfortran/io/list_read.c
	M	libgfortran/io/transfer.c
Committed r246478

Jerry

^ permalink raw reply	[flat|nested] 6+ messages in thread

* Re: [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
  2017-03-25 13:41 Jerry DeLisle
@ 2017-03-25 18:00 ` Paul Richard Thomas
  2017-03-25 18:49   ` Jerry DeLisle
  0 siblings, 1 reply; 6+ messages in thread
From: Paul Richard Thomas @ 2017-03-25 18:00 UTC (permalink / raw)
  To: Jerry DeLisle; +Cc: fortran, GCC Patches

Hi Jerry,

This looks fine to me. OK for trunk.

Thanks for the patch.

Paul

On 25 March 2017 at 13:41, Jerry DeLisle <jvdelisle@charter.net> wrote:
> Hi all,
>
> I managed to figure out the rest of this.
>
> Attached is updated full patch. I consolidated the two previous test cases
> into one which checks all four conditions I was concerned with.
>
> Regression tested on x86_64_linux.
>
> Ok for trunk?
>
> Regards,
>
> Jerry
>
> 2017-03-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
>
>         PR libgfortran/78881
>         * io/io.h (st_parameter_dt): Rename unused component last_char to
>         child_saved_iostat. Move comment to gfc_unit.
>         * io/list_read.c (list_formatted_read_scalar): After call to
>         child READ procedure, save the returned iostat value for later
>         check. (finish_list_read): Only finish READ if child_saved_iostat
>         was OK.
>         * io/transfer.c (read_sf_internal): If there is a saved character
>         in last character, seek back one. Add a new check for EOR
>         condition. (read_sf): If there is a saved character
>         in last character, seek back one. (formatted_transfer_scalar_read):
>         Initialize last character before invoking child procedure.
>         (data_transfer_init): If child dtio, set advance
>         status to nonadvancing. Move update of size and check for EOR
>         condition to before child dtio return.
>
> Changelog for test case will be added.



-- 
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein

^ permalink raw reply	[flat|nested] 6+ messages in thread

* [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
@ 2017-03-25 13:41 Jerry DeLisle
  2017-03-25 18:00 ` Paul Richard Thomas
  0 siblings, 1 reply; 6+ messages in thread
From: Jerry DeLisle @ 2017-03-25 13:41 UTC (permalink / raw)
  To: fortran; +Cc: GCC Patches

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

Hi all,

I managed to figure out the rest of this.

Attached is updated full patch. I consolidated the two previous test cases into 
one which checks all four conditions I was concerned with.

Regression tested on x86_64_linux.

Ok for trunk?

Regards,

Jerry

2017-03-25  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/78881
	* io/io.h (st_parameter_dt): Rename unused component last_char to
	child_saved_iostat. Move comment to gfc_unit.
	* io/list_read.c (list_formatted_read_scalar): After call to
	child READ procedure, save the returned iostat value for later
	check. (finish_list_read): Only finish READ if child_saved_iostat
	was OK.
	* io/transfer.c (read_sf_internal): If there is a saved character
	in last character, seek back one. Add a new check for EOR
	condition. (read_sf): If there is a saved character
	in last character, seek back one. (formatted_transfer_scalar_read):
	Initialize last character before invoking child procedure.
	(data_transfer_init): If child dtio, set advance
	status to nonadvancing. Move update of size and check for EOR
	condition to before child dtio return.

Changelog for test case will be added.

[-- Attachment #2: pr78881-2.diff --]
[-- Type: text/x-patch, Size: 5530 bytes --]

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 277c5ed7..df491577 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -534,10 +534,7 @@ typedef struct st_parameter_dt
 	  unsigned expanded_read : 1;
 	  /* 13 unused bits.  */
 
-	  /* Used for ungetc() style functionality. Possible values
-	     are an unsigned char, EOF, or EOF - 1 used to mark the
-	     field as not valid.  */
-	  int last_char; /* No longer used, moved to gfc_unit.  */
+	  int child_saved_iostat;
 	  int nml_delim;
 	  int repeat_count;
 	  int saved_length;
@@ -701,6 +698,10 @@ typedef struct gfc_unit
 
   /* DTIO Parent/Child procedure, 0 = parent, >0 = child level.  */
   int child_dtio;
+
+  /* Used for ungetc() style functionality. Possible values
+     are an unsigned char, EOF, or EOF - 1 used to mark the
+     field as not valid.  */
   int last_char;
   bool has_size;
   GFC_IO_INT size_used;
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 7f57ff1a..39805baa 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -2221,6 +2221,7 @@ list_formatted_read_scalar (st_parameter_dt *dtp, bt type, void *p,
 	  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--;
       }
       break;
@@ -2352,15 +2353,18 @@ finish_list_read (st_parameter_dt *dtp)
       /* Set the next_char and push_char worker functions.  */
       set_workers (dtp);
 
-      c = next_char (dtp);
-      if (c == EOF)
+      if (likely (dtp->u.p.child_saved_iostat == LIBERROR_OK))
 	{
-	  free_line (dtp);
-	  hit_eof (dtp);
-	  return;
+	  c = next_char (dtp);
+	  if (c == EOF)
+	    {
+	      free_line (dtp);
+	      hit_eof (dtp);
+	      return;
+	    }
+	  if (c != '\n')
+	    eat_line (dtp);
 	}
-      if (c != '\n')
-	eat_line (dtp);
     }
 
   free_line (dtp);
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fc22d802..1e56b5de 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -226,7 +226,7 @@ static char *
 read_sf_internal (st_parameter_dt *dtp, int * length)
 {
   static char *empty_string[0];
-  char *base;
+  char *base = NULL;
   int lorig;
 
   /* Zero size array gives internal unit len of 0.  Nothing to read. */
@@ -244,6 +244,15 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
       return (char*) empty_string;
     }
 
+  /* There are some cases with mixed DTIO where we have read a character
+     and saved it in the last character buffer, so we need to backup.  */
+  if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+		dtp->u.p.current_unit->last_char != EOF - 1))
+    {
+      dtp->u.p.current_unit->last_char = EOF - 1;
+      sseek (dtp->u.p.current_unit->s, -1, SEEK_CUR);
+    }
+
   lorig = *length;
   if (is_char4_unit(dtp))
     {
@@ -263,6 +272,12 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
       return NULL;
     }
 
+  if (base && *base == 0)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      return NULL;
+    }
+
   dtp->u.p.current_unit->bytes_left -= *length;
 
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -304,6 +319,15 @@ read_sf (st_parameter_dt *dtp, int * length)
       return (char*) empty_string;
     }
 
+  /* There are some cases with mixed DTIO where we have read a character
+     and saved it in the last character buffer, so we need to backup.  */
+  if (unlikely (dtp->u.p.current_unit->child_dtio > 0 &&
+		dtp->u.p.current_unit->last_char != EOF - 1))
+    {
+      dtp->u.p.current_unit->last_char = EOF - 1;
+      fbuf_seek (dtp->u.p.current_unit, -1, SEEK_CUR);
+    }
+
   n = seen_comma = 0;
 
   /* Read data into format buffer and scan through it.  */
@@ -1499,6 +1523,7 @@ formatted_transfer_scalar_read (st_parameter_dt *dtp, bt type, void *p, int kind
 
 	  /* Call the user defined formatted READ procedure.  */
 	  dtp->u.p.current_unit->child_dtio++;
+	  dtp->u.p.current_unit->last_char = EOF - 1;
 	  dtp->u.p.fdtio_ptr (p, &unit, iotype, f->u.udf.vlist,
 			      child_iostat, child_iomsg,
 			      iotype_len, child_iomsg_len);
@@ -2856,6 +2881,11 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	}
     }
 
+  /* Child IO is non-advancing and any ADVANCE= specifier is ignored.
+     F2008 9.6.2.4  */
+  if (dtp->u.p.current_unit->child_dtio  > 0)
+    dtp->u.p.advance_status = ADVANCE_NO;
+
   if (read_flag)
     {
       dtp->u.p.current_unit->previous_nonadvancing_write = 0;
@@ -3856,6 +3886,15 @@ finalize_transfer (st_parameter_dt *dtp)
 	 namelist_write (dtp);
     }
 
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    *dtp->size = dtp->u.p.current_unit->size_used;
+
+  if (dtp->u.p.eor_condition)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      goto done;
+    }
+
   if (dtp->u.p.current_unit && (dtp->u.p.current_unit->child_dtio  > 0))
     {
       if (cf & IOPARM_DT_HAS_FORMAT)
@@ -3866,15 +3905,6 @@ finalize_transfer (st_parameter_dt *dtp)
       return;
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    *dtp->size = dtp->u.p.current_unit->size_used;
-
-  if (dtp->u.p.eor_condition)
-    {
-      generate_error (&dtp->common, LIBERROR_EOR, NULL);
-      goto done;
-    }
-
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     {
       if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL)

[-- Attachment #3: dtio_26.f03 --]
[-- Type: text/plain, Size: 2126 bytes --]

! { dg-do run }
! PR78881 test for correct end of record condition and ignoring advance=
module t_m
   use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
   implicit none
   type, public :: t
      character(len=:), allocatable :: m_s
   contains
      procedure, pass(this) :: read_t
      generic :: read(formatted) => read_t
   end type t
contains
subroutine read_t(this, lun, iotype, vlist, istat, imsg)
  class(t), intent(inout)         :: this
  integer, intent(in)             :: lun
  character(len=*), intent(in)    :: iotype
  integer, intent(in)             :: vlist(:)
  integer, intent(out)            :: istat
  character(len=*), intent(inout) :: imsg
  character(len=1) :: c
  integer :: i
  i = 0 ; imsg=''
  loop_read: do
    i = i + 1
    read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
    select case ( istat )
    case ( 0 )
      if (i.eq.1 .and. c.ne.'h') exit loop_read
      !write( output_unit, fmt=sfmt) "i = ", i, ", c = ", c
    case ( iostat_end )
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_end"
      exit loop_read
    case ( iostat_eor )
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_eor"
      exit loop_read
    case default
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = ", istat
      exit loop_read
    end select
    if (i.gt.10) exit loop_read
  end do loop_read
end subroutine read_t
end module t_m

program p
  use t_m, only : t
  implicit none
  
  character(len=:), allocatable :: s
  type(t) :: foo
  character(len=256) :: imsg
  integer :: istat
  
  open(10, status="scratch")
  write(10,'(a)') 'hello'
  rewind(10)
  read(unit=10, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  if (imsg.ne."End of record") call abort
  rewind(10)
  read(unit=10, fmt=*, iostat=istat, iomsg=imsg) foo
  if (imsg.ne."End of record") call abort
  s = "hello"
  read( unit=s, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  if (imsg.ne."End of record") call abort
  read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo
  if (imsg.ne."End of record") call abort
end program p

! { dg-final { cleanup-modules "t_m" } }

^ permalink raw reply	[flat|nested] 6+ messages in thread

* [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly
@ 2017-03-22  4:28 Jerry DeLisle
  0 siblings, 0 replies; 6+ messages in thread
From: Jerry DeLisle @ 2017-03-22  4:28 UTC (permalink / raw)
  To: fortran; +Cc: GCC Patches

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

Hi all,

The attached patch is part 1 of a 2 part patch.  This part fixes a few problems 
with handling of advance= and EOR conditions.  This does not resolve the 
original case in the PR but gets some issues out of the way so I can continue.

The most notable change is that per standard, child I/O is by definition 
non-advancing and any advance= specifier is ignored. We still do the typical 
error checks for on the advance= and give errors when not valid to specify it, 
but where it is valid, we just ignore it as stated in the standard (set it to 
non-advancing regardless).

"A formatted child input/output statement is a nonadvancing input/output 
statement, and any ADVANCE= specifier is ignored." 9.6.2.4

Regarding the original test case, note that if I use a format specifier of 
'(DT)' instead of *, the test case works as expected. So, evidently with list 
directed I/O we are eating the first character for some reason. I will keep 
working on this issue.

In the meantime, the attached patch and test cases, regression tested on 
x86_64-linux.

OK for trunk?

Jerry

2017-03-21  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/78881
	* io/transfer.c (read_sf_internal): Add a new check for EOR
	condition. (data_transfer_init): If child dtio, set advance
	status to nonadvancing. Move update of size and check for EOR
	condition to before child dtio return.

[-- Attachment #2: pr78881-1.diff --]
[-- Type: text/x-patch, Size: 2047 bytes --]

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index fc22d802..30a8a0c4 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -226,7 +226,7 @@ static char *
 read_sf_internal (st_parameter_dt *dtp, int * length)
 {
   static char *empty_string[0];
-  char *base;
+  char *base = NULL;
   int lorig;
 
   /* Zero size array gives internal unit len of 0.  Nothing to read. */
@@ -263,6 +263,12 @@ read_sf_internal (st_parameter_dt *dtp, int * length)
       return NULL;
     }
 
+  if (base && *base == 0)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      return NULL;
+    }
+
   dtp->u.p.current_unit->bytes_left -= *length;
 
   if (((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) ||
@@ -2856,6 +2862,11 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	}
     }
 
+  /* Child IO is non-advancing and any ADVANCE= specifier is ignored.
+     F2008 9.6.2.4  */
+  if (dtp->u.p.current_unit->child_dtio  > 0)
+    dtp->u.p.advance_status = ADVANCE_NO;
+
   if (read_flag)
     {
       dtp->u.p.current_unit->previous_nonadvancing_write = 0;
@@ -3856,6 +3867,15 @@ finalize_transfer (st_parameter_dt *dtp)
 	 namelist_write (dtp);
     }
 
+  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
+    *dtp->size = dtp->u.p.current_unit->size_used;
+
+  if (dtp->u.p.eor_condition)
+    {
+      generate_error (&dtp->common, LIBERROR_EOR, NULL);
+      goto done;
+    }
+
   if (dtp->u.p.current_unit && (dtp->u.p.current_unit->child_dtio  > 0))
     {
       if (cf & IOPARM_DT_HAS_FORMAT)
@@ -3866,15 +3886,6 @@ finalize_transfer (st_parameter_dt *dtp)
       return;
     }
 
-  if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
-    *dtp->size = dtp->u.p.current_unit->size_used;
-
-  if (dtp->u.p.eor_condition)
-    {
-      generate_error (&dtp->common, LIBERROR_EOR, NULL);
-      goto done;
-    }
-
   if ((dtp->common.flags & IOPARM_LIBRETURN_MASK) != IOPARM_LIBRETURN_OK)
     {
       if (dtp->u.p.current_unit && current_mode (dtp) == UNFORMATTED_SEQUENTIAL)

[-- Attachment #3: dtio_26.f03 --]
[-- Type: text/plain, Size: 1820 bytes --]

! { dg-do run }
! PR78881 test for correct end ofrecord condition and ignoring advance=
module t_m
   use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
   implicit none
   type, public :: t
      character(len=:), allocatable :: m_s
   contains
      procedure, pass(this) :: read_t
      generic :: read(formatted) => read_t
   end type t
contains
subroutine read_t(this, lun, iotype, vlist, istat, imsg)
  class(t), intent(inout)         :: this
  integer, intent(in)             :: lun
  character(len=*), intent(in)    :: iotype
  integer, intent(in)             :: vlist(:)
  integer, intent(out)            :: istat
  character(len=*), intent(inout) :: imsg
  character(len=1) :: c
  integer :: i
  i = 0 ; imsg=''
  loop_read: do
    i = i + 1
    read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
    select case ( istat )
    case ( 0 )
      if (i.eq.1 .and. c.ne.'h') exit loop_read
      !write( output_unit, fmt=sfmt) "i = ", i, ", c = ", c
    case ( iostat_end )
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_end"
      exit loop_read
    case ( iostat_eor )
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = iostat_eor"
      exit loop_read
    case default
      !write( output_unit, fmt=sfmt) "i = ", i, ", istat = ", istat
      exit loop_read
    end select
    if (i.gt.10) exit loop_read
  end do loop_read
end subroutine read_t
end module t_m

program p
  use t_m, only : t
  implicit none
  
  character(len=:), allocatable :: s
  type(t) :: foo
  character(len=256) :: imsg
  integer :: istat
  
  open(10, status="scratch")
  write(10,'(a)') 'hello'
  rewind(10)
  read(unit=10, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  close(10)
  if (imsg.ne."End of record") call abort
end program p

! { dg-final { cleanup-modules "t_m" } }

[-- Attachment #4: dtio_27.f03 --]
[-- Type: text/plain, Size: 1725 bytes --]

! { dg-do run }
! PR78881 test for correct end ofrecord condition and ignoring advance=
module t_m
  use, intrinsic :: iso_fortran_env, only : iostat_end, iostat_eor, output_unit
  implicit none
  type, public :: t
    character(len=:), allocatable :: m_s
  contains
    procedure, pass(this) :: read_t
    generic :: read(formatted) => read_t
  end type t
contains
subroutine read_t(this, lun, iotype, vlist, istat, imsg)
  class(t), intent(inout)         :: this
  integer, intent(in)             :: lun
  character(len=*), intent(in)    :: iotype
  integer, intent(in)             :: vlist(:)
  integer, intent(out)            :: istat
  character(len=*), intent(inout) :: imsg
  character(len=1) :: c
  integer :: i
  i = 0 ; imsg=''
  loop_read: do
    i = i + 1
    read( unit=lun, fmt='(a1)', iostat=istat, iomsg=imsg) c
    select case ( istat )
    case ( 0 )
      if (i.eq.1 .and. c.ne.'H') exit loop_read
      !write( output_unit, fmt=*) "i = ", i, ", c = ", c
    case ( iostat_end )
      !write( output_unit, fmt=*) "i = ", i, ", istat = iostat_end"
      exit loop_read
    case ( iostat_eor )
      !write( output_unit, fmt=*) "i = ", i, ", istat = iostat_eor"
      exit loop_read
    case default
      !write( output_unit, fmt=*) "i = ", i, ", istat = ", istat
      exit loop_read
    end select
    if (i.gt.10) exit loop_read
  end do loop_read
end subroutine read_t
end module t_m

program p
  use t_m, only : t
  implicit none
  character(len=:), allocatable :: s
  type(t) :: foo
  character(len=256) :: imsg
  integer :: istat
  s = "Hello"
  read( unit=s, fmt='(dt)', iostat=istat, iomsg=imsg) foo
  if (imsg.ne."End of record") call abort
end program p

! { dg-final { cleanup-modules "t_m" } }

^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2017-03-27  7:33 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2017-03-22 17:05 [patch, libgfortran] PR78881 [F03] reading from string with DTIO procedure does not work properly Dominique d'Humières
  -- strict thread matches above, loose matches on Subject: below --
2017-03-25 13:41 Jerry DeLisle
2017-03-25 18:00 ` Paul Richard Thomas
2017-03-25 18:49   ` Jerry DeLisle
2017-03-27  7:33     ` Christophe Lyon
2017-03-22  4:28 Jerry DeLisle

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).