gcc/testsuite/gfortran.dg/make_unit.f90

   1 ! { dg-do run }
   2 ! PR61933, useing inquire to get available units.
   3 program makeunit
   4 integer  :: ic, istat, nc
   5 logical  :: exists, is_open
   6
   7 if (get_unit_number("foo0.dat") .ne. 10) call abort
   8 if (get_unit_number("foo1.dat") .ne. 11) call abort
   9 if (get_unit_number("foo2.dat") .ne. 12) call abort
  10 if (get_unit_number("foo3.dat") .ne. 13) call abort
  11
  12 close(unit=12, status="delete")
  13 if (get_unit_number("foo2.dat") .ne. 12) call abort()
  14 close(unit=10, status="delete")
  15 close(unit=11, status="delete")
  16 close(unit=12, status="delete")
  17 close(unit=13, status="delete")
  18
  19 contains
  20   function get_unit_number(file_name) result(unit_number)
  21     character(len=*), intent(in), optional   :: file_name
  22     integer                                  :: unit_number
  23     ! get a new unit number
  24     do unit_number=10,100
  25        inquire (unit=unit_number,exist=exists,opened=is_open,iostat=istat)
  26        if (exists.and.(.not.is_open).and.(istat == 0)) then
  27            open(unit=unit_number, file=file_name)
  28            return
  29        endif
  30     end do
  31     unit_number = -1
  32   end function get_unit_number
  33
  34 end program makeunit