[patch, fortran] Fix PR 88411, wrong code with async I/O

[Thomas Koenig]

Hello world,

the attached patch fixes the wrong-code regression by changing the
way synchronous writes are handled on files using asynchronous I/O:
The are now handled synchronously.

This also means that two places where a wait instruction was
issued in such a case are no longer needed.

I tried to construct a failing test case for this new behavior,
but failed :-)

Regression-tested.

OK for trunk?

Regards

        Thomas

Index: io/transfer.c
===================================================================
--- io/transfer.c	(Revision 266250)
+++ io/transfer.c	(Arbeitskopie)
@@ -3189,7 +3189,7 @@ data_transfer_init (st_parameter_dt *dtp, int read
 	}
     }
 
-  if (au)
+  if (au && dtp->u.p.async)
     {
       NOTE ("enqueue_data_transfer");
       enqueue_data_transfer_init (au, dtp, read_flag);
@@ -4313,11 +4313,8 @@ st_read_done (st_parameter_dt *dtp)
 	    *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au, AIO_READ_DONE);  
 	  else
 	    {
-	      enqueue_done (dtp->u.p.current_unit->au, AIO_READ_DONE);
-	      /* An asynchronous unit without ASYNCHRONOUS="YES" - make this
-		 synchronous by performing a wait operation.  */
-	      if (!dtp->u.p.async)
-		async_wait (&dtp->common, dtp->u.p.current_unit->au);
+	      if (dtp->u.p.async)
+		enqueue_done (dtp->u.p.current_unit->au, AIO_READ_DONE);
 	    }
 	}
       else
@@ -4401,7 +4398,7 @@ st_write_done (st_parameter_dt *dtp)
 {
   if (dtp->u.p.current_unit)
     {
-      if (dtp->u.p.current_unit->au)
+      if (dtp->u.p.current_unit->au && dtp->u.p.async)
 	{
 	  if (dtp->common.flags & IOPARM_DT_HAS_ID)
 	    *dtp->id = enqueue_done_id (dtp->u.p.current_unit->au,
@@ -4408,11 +4405,10 @@ st_write_done (st_parameter_dt *dtp)
 					AIO_WRITE_DONE);
 	  else
 	    {
-	      enqueue_done (dtp->u.p.current_unit->au, AIO_WRITE_DONE);
-	      /* An asynchronous unit without ASYNCHRONOUS="YES" - make this
-		 synchronous by performing a wait operation.  */
-	      if (!dtp->u.p.async)
-		async_wait (&dtp->common, dtp->u.p.current_unit->au);
+	      /* We perform synchronous I/O on an asynchronous unit, so no need
+		 to enqueue AIO_READ_DONE.  */
+	      if (dtp->u.p.async)
+		enqueue_done (dtp->u.p.current_unit->au, AIO_WRITE_DONE);
 	    }
 	}
       else

! { dg-do run }
! PR libfortran/88411
! This used to generate errors due to a mixup of
! synchronous and asynchronous execution.
! Test case by Harald Anlauf.
program gfcbug153
  implicit none
  integer :: iu, irecl
  real    :: a(100,20), b(1,3000)
  iu = 10
  a  = 0.
  b  = 0.
  inquire (iolength = irecl) a
  open (iu, file="file1.dat", access='direct', &
       asynchronous='yes', &
       recl=irecl)
  write(iu, rec=1) a(:,:)
  write(iu, rec=2) a(:,:)
  write(iu, rec=3) a(:,:)
  close (iu,status="delete")

  inquire (iolength = irecl) b
  open (iu, file="file2.dat", access='direct', &
       asynchronous='yes', &
       recl=irecl)
  write(iu, rec=1) b(:,:)
  write(iu, rec=2) b(:,:)
  write(iu, rec=3) b(:,:)
  close (iu,status="delete")
end program