re PR fortran/61933 (Inquire on internal units)
2015-01-22 Jerry DeLisle <jvdelisle@gcc.gnu.org> PR fortran/61933 * gfortran.dg/make_unit.f90: New test. From-SVN: r220026
This commit is contained in:
parent
20056f6002
commit
bae420fcdb
|
@ -1,3 +1,8 @@
|
|||
2015-01-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR fortran/61933
|
||||
* gfortran.dg/make_unit.f90: New test.
|
||||
|
||||
2015-01-22 Jerry DeLisle <jvdelisle@gcc.gnu.org>
|
||||
|
||||
PR fortran/61933
|
||||
|
|
|
@ -0,0 +1,34 @@
|
|||
! { dg-do run }
|
||||
! PR61933, useing inquire to get available units.
|
||||
program makeunit
|
||||
integer :: ic, istat, nc
|
||||
logical :: exists, is_open
|
||||
|
||||
if (get_unit_number("foo0.dat") .ne. 10) call abort
|
||||
if (get_unit_number("foo1.dat") .ne. 11) call abort
|
||||
if (get_unit_number("foo2.dat") .ne. 12) call abort
|
||||
if (get_unit_number("foo3.dat") .ne. 13) call abort
|
||||
|
||||
close(unit=12, status="delete")
|
||||
if (get_unit_number("foo2.dat") .ne. 12) call abort()
|
||||
close(unit=10, status="delete")
|
||||
close(unit=11, status="delete")
|
||||
close(unit=12, status="delete")
|
||||
close(unit=13, status="delete")
|
||||
|
||||
contains
|
||||
function get_unit_number(file_name) result(unit_number)
|
||||
character(len=*), intent(in), optional :: file_name
|
||||
integer :: unit_number
|
||||
! get a new unit number
|
||||
do unit_number=10,100
|
||||
inquire (unit=unit_number,exist=exists,opened=is_open,iostat=istat)
|
||||
if (exists.and.(.not.is_open).and.(istat == 0)) then
|
||||
open(unit=unit_number, file=file_name)
|
||||
return
|
||||
endif
|
||||
end do
|
||||
unit_number = -1
|
||||
end function get_unit_number
|
||||
|
||||
end program makeunit
|
Loading…
Reference in New Issue