From bae420fcdb5715f37cb519f898152d8c4a6c394d Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 23 Jan 2015 03:37:30 +0000 Subject: [PATCH] re PR fortran/61933 (Inquire on internal units) 2015-01-22 Jerry DeLisle PR fortran/61933 * gfortran.dg/make_unit.f90: New test. From-SVN: r220026 --- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/make_unit.f90 | 34 +++++++++++++++++++++++++ 2 files changed, 39 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/make_unit.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a0ee68cc148..92076857cdd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-22 Jerry DeLisle + + PR fortran/61933 + * gfortran.dg/make_unit.f90: New test. + 2015-01-22 Jerry DeLisle 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 index 00000000000..ffeb5f1b2d0 --- /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 -- 2.30.2