This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, FORTRAN] PR61933 Inquire on Internal Unit
- From: Jerry DeLisle <jvdelisle at charter dot net>
- To: gfortran <fortran at gcc dot gnu dot org>
- Cc: gcc patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 06 Sep 2014 14:51:20 -0700
- Subject: [Patch, FORTRAN] PR61933 Inquire on Internal Unit
- Authentication-results: sourceware.org; auth=none
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.
Regression tested on x86-64.
OK for trunk?
2014-09-06 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/61933
* io.c (gfc_match_inquire): Add error check for negative unit.
* gfortran.dg/negative_unit_check.f90: New test.
* gfortran.dg/inquire_9.f90: Update test
*libgfortran/io/lock.c: Fix a typo.
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)
! { dg-do compile }
! Test case from PR61933.
LOGICAL :: file_exists
INQUIRE(UNIT=-1,EXIST=file_exists)! { dg-error "requires positive UNIT" }
END