This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch,libgfortran] PR28335 flush() / write() statement on closed units


:ADDPATCH fortran:

I plan to commit to trunk the attached trivial patch in 24 hours.

Regression tested OK after getting rid of a loose CLOSE(10) statement in gfortran.dg/temporary_1.f90. Fixed test case attached has nothing to do with I/O

Regards,

Jerry

2006-07-24 Jerry DeLisle <jvdelisle@gcc.gnu.org>

	PR libgfortran/258335
	* close.c (st_close): Add error when UNIT does not exist.
	* file_pos.c (st_flush): Add error when UNIT does not exist.


Index: io/file_pos.c
===================================================================
*** io/file_pos.c	(revision 115692)
--- io/file_pos.c	(working copy)
*************** st_flush (st_parameter_filepos *fpp)
*** 340,345 ****
--- 340,348 ----
        flush (u->s);
        unlock_unit (u);
      }
+   else
+     generate_error (&fpp->common, ERROR_BAD_OPTION,
+ 			"Can't find specified UNIT in FLUSH");
  
    library_end ();
  }
Index: io/close.c
===================================================================
*** io/close.c	(revision 115692)
--- io/close.c	(working copy)
*************** st_close (st_parameter_close *clp)
*** 102,107 ****
          unlink (path);
  #endif
      }
! 
    library_end ();
  }
--- 102,109 ----
          unlink (path);
  #endif
      }
!   else
!     generate_error (&clp->common, ERROR_BAD_OPTION,
! 			    "Can't find specified UNIT in CLOSE");
    library_end ();
  }
! { dg-do run }
! PR 27662. Don't zero the first stride to indicate a temporary. It
! may be used later.
program pr27662
 implicit none
 real(kind=kind(1.0d0)), dimension (2, 2):: x, y, z;
 integer i, j
 x(1,1) = 1.d0 
 x(2,1) = 0.d0
 x(1,2) = 0.d0
 x(2,2) = 1.d0 
 z = matmul (x, transpose (test ()))
 do i = 1, size (x, 1)
   do j = 1, size (x, 2)
     if (x (i, j) .ne. z (i, j)) call abort ()
   end do
 end do

contains
 function test () result (res)
   real(kind=kind(1.0d0)), dimension(2,2) :: res
   res(1,1) = 1.d0 
   res(2,1) = 0.d0
   res(1,2) = 0.d0
   res(2,2) = 1.d0 
 end function
end

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]