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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a0ee68cc148fa420b7d61b633f216957776c46ac..92076857cddfb400af92e02c7feb632b1a5adee8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

diff --git a/gcc/testsuite/gfortran.dg/make_unit.f90 b/gcc/testsuite/gfortran.dg/make_unit.f90
new file mode 100644 (file)
index 0000000..ffeb5f1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/make_unit.f90
@@ -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