| Message ID | 540B81D8.6050306@charter.net |
|---|---|
| State | New |
| Headers | show |
On Sun, Sep 7, 2014 at 12:51 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: > Hi, > > The attached patch adds a compile time check for negative unit numbers given in > an INQUIRE statement. A new test case is provided and one updated. What about units opened with newunit= ? Those have negative unit numbers. It seems strange that one wouldn't be allowed to inquire such units? Or if that indeed is the case, I suggest it's a bug in the standard (one can imagine such happening by forgetting to update inquire constraints after adding newunit= in f2003). program negunit implicit none logical :: file_exists integer :: u open(newunit=u, file="test.dat") inquire(unit=u, exist=file_exists) write(*,*) u, file_exists close(u, status="delete") end program negunit Testing with gfortran 4.9.1 (homebrew) on a Mac, the above program prints -10 F which is wrong, but a slightly different issue. The almost identical program program posunit implicit none logical :: file_exists integer :: u=10 open(u, file="test.dat") inquire(unit=u, exist=file_exists) write(*,*) u, file_exists close(u, status="delete") end program posunit correctly prints 10 T
On 06/09/14 21:08, Janne Blomqvist wrote: > On Sun, Sep 7, 2014 at 12:51 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: >> Hi, >> >> The attached patch adds a compile time check for negative unit numbers given in >> an INQUIRE statement. A new test case is provided and one updated. > > What about units opened with newunit= ? Those have negative unit > numbers. It seems strange that one wouldn't be allowed to inquire such > units? Or if that indeed is the case, I suggest it's a bug in the > standard (one can imagine such happening by forgetting to update > inquire constraints after adding newunit= in f2003). > > program negunit > implicit none > logical :: file_exists > integer :: u > open(newunit=u, file="test.dat") > inquire(unit=u, exist=file_exists) > write(*,*) u, file_exists > close(u, status="delete") > end program negunit > I was thinking of the same issue. The front end patch is correct. But I need to work further on the run time side. NEWUNIT presents a particular problem. The INQUIRE should search the treap for the negative unit and if found, return true. Having the negative unit number by itself is not sufficient. I will work on the run time part next. Frontend OK? Jerry
On Sun, Sep 7, 2014 at 7:35 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: > On 06/09/14 21:08, Janne Blomqvist wrote: >> On Sun, Sep 7, 2014 at 12:51 AM, Jerry DeLisle <jvdelisle@charter.net> wrote: >>> Hi, >>> >>> The attached patch adds a compile time check for negative unit numbers given in >>> an INQUIRE statement. A new test case is provided and one updated. >> >> What about units opened with newunit= ? Those have negative unit >> numbers. It seems strange that one wouldn't be allowed to inquire such >> units? Or if that indeed is the case, I suggest it's a bug in the >> standard (one can imagine such happening by forgetting to update >> inquire constraints after adding newunit= in f2003). >> >> program negunit >> implicit none >> logical :: file_exists >> integer :: u >> open(newunit=u, file="test.dat") >> inquire(unit=u, exist=file_exists) >> write(*,*) u, file_exists >> close(u, status="delete") >> end program negunit >> > > I was thinking of the same issue. The front end patch is correct. Is it? Is it really the intention that negative units are allowed if the specifier is a variable, but not if it is a constant? Consider the following, admittedly silly, example modified from the previous one: program negunit implicit none logical :: file_exists integer :: u open(newunit=u, file="test.dat") ! By secret magic I know that u=-10 inquire(unit=-10, exist=file_exists) write(*,*) u, file_exists close(u, status="delete") end program negunit Is this not conforming while the previous one is? Sounds a bit strange? > But I need to > work further on the run time side. NEWUNIT presents a particular problem. The > INQUIRE should search the treap for the negative unit and if found, return true. > Having the negative unit number by itself is not sufficient. Isn't it enough to just remove any checks for the unit number being positive?
Index: gcc/fortran/io.c =================================================================== --- gcc/fortran/io.c (revision 214973) +++ gcc/fortran/io.c (working copy) @@ -3998,6 +3998,14 @@ goto cleanup; } + if (inquire->unit != NULL && inquire->unit->expr_type == EXPR_CONSTANT + && inquire->unit->ts.type == BT_INTEGER + && mpz_sgn (inquire->unit->value.integer) == -1) + { + gfc_error ("INQUIRE statement at %L requires positive UNIT", &loc); + goto cleanup; + } + if (gfc_pure (NULL)) { gfc_error ("INQUIRE statement not allowed in PURE procedure at %C"); Index: gcc/testsuite/gfortran.dg/inquire_9.f90 =================================================================== --- gcc/testsuite/gfortran.dg/inquire_9.f90 (revision 214973) +++ gcc/testsuite/gfortran.dg/inquire_9.f90 (working copy) @@ -5,8 +5,6 @@ inquire (file='inquire_9 file that should not exist', exist=l) if (l) call abort l = .true. - inquire (unit=-16, exist=l) - if (l) call abort open (unit=16, file='inquire_9.tst') write (unit=16, fmt='(a)') 'Test' l = .false. Index: gcc/testsuite/gfortran.dg/negative_unit_check.f90 =================================================================== --- gcc/testsuite/gfortran.dg/negative_unit_check.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/negative_unit_check.f90 (working copy) @@ -0,0 +1,5 @@ +! { dg-do compile } +! Test case from PR61933. + LOGICAL :: file_exists + INQUIRE(UNIT=-1,EXIST=file_exists)! { dg-error "requires positive UNIT" } +END Index: libgfortran/io/lock.c =================================================================== --- libgfortran/io/lock.c (revision 214973) +++ libgfortran/io/lock.c (working copy) @@ -27,7 +27,7 @@ #include <string.h> #include <stdlib.h> -/* library_start()-- Called with a library call is entered. */ +/* library_start()-- Called when a library call is entered. */ void library_start (st_parameter_common *cmp)