[Patch, FORTRAN] PR61933 Inquire on Internal Unit

[Jerry DeLisle]

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  <jvdeli...@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