[patch, fortran] PR33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

Hi all,

The attached patch is a bit tricky because there is interaction between the 
front end and the run-time library.

The problem here is that when INQUIRE'ing by UNIT to determine existence, an 
error was generated for a bad unit number.  All UNITs with good unit numbers 
exist since they can be opened implicitly (i.e. fort.10)

So by definition, the unit does not exist when a the unit number is bad.  Bad 
meaning less than zero or greater than GFC_INTEGER_4_HUGE.

In a previous bug we found that certain constructs passed as integer-8 that are 
outside the acceptable integer-4 range would get wrapped when converted to 
integer-4 and result in a valid unit number.  An example of this is:

	unit=2_8*huge(0_4)+20_8

To catch this we had to put error detection in the front end to check the unit 
number before the conversion.  This is done in trans-io.c (set_parameter_value).
The consequence of this was that in the INQUIRE statement we were throwing an 
error when -fdefault-integer-8 was used because this checking is enabled when 
the unit number coming in is not KIND=4.  There was no way that the INQUIRE 
frontend or run-time would know an error occurred.

The attached patch fixes this by doing the following:

In gfc_trans_inquire, if EXIST has been given, we check to see if it is by UNIT 
and if IOSTAT is there.  If IOSTAT is there, we allow the error mechanism to 
operate as-is and pass the IOSTAT variable to generate_error, where it is 
intercepted and no error is emitted, only the IOSTAT variable is set.

If, however, there is no IOSTAT in the INQUIRE, a dummy variable is created and 
 used to pass the error code, if any, to generate_error.  Thus, we pass the 
ERROR_BAD_UNIT code to the library.

In the library, inquire.c (inquire_via_unit), the various conditions are 
checked.  The effect is that if EXIST has been given, no error will be issued 
for a bad unit number, but EXIST is set to FALSE.  If an IOSTAT was passed, it 
is set to ERROR_BAD_UNIT.  Also, (inquire_via_unit) is used by st_inquire for 
INQUIRE by file name, so this is also checked to avoid any conflicts.  INQUIRE 
by UNIT and INQUIRE by file name are always mutually exclusive.

Regression tested on x86-64-Gnu-Linux.  Updated test case provided in patch to 
include the tricky code.  Checked with -fdefault-integer-8.

OK for trunk?

Regards,

Jerry

2007-08-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/33055
	* trans-io.c (create_dummy_iostat): New function to create a unique
	dummy variable expression to use with IOSTAT.
	(gfc_trans_inquire): Use the new function to pass unit number error info
	to run-time library if a regular IOSTAT variable was not given.

	PR libfortran/33055
	* io/inquire.c (inquire_via_unit):  If inquiring by unit, check for
	an error condition from the IOSTAT variable and set EXIST to false if
	there was a bad unit number.

Index: gcc/fortran/trans-io.c
===================================================================
--- gcc/fortran/trans-io.c	(revision 127758)
+++ gcc/fortran/trans-io.c	(working copy)
@@ -1094,6 +1094,30 @@ gfc_trans_flush (gfc_code * code)
 }
 
 
+/* Create a dummy iostat variable to catch any error due to bad unit.  */
+
+static gfc_expr *
+create_dummy_iostat (void)
+{
+  gfc_symtree *st;
+  gfc_expr *e;
+
+  st = gfc_get_unique_symtree (gfc_current_ns);
+  st->n.sym = gfc_new_symbol (st->name, gfc_current_ns);
+  st->n.sym->ts.type = BT_INTEGER;
+  st->n.sym->ts.kind = 4;
+  st->n.sym->attr.referenced = 1;
+  st->n.sym->refs = 1;
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_VARIABLE;
+  e->symtree = st;
+  e->ts.type = BT_INTEGER;
+  e->ts.kind = 4;
+
+  return e;
+}
+
+
 /* Translate the non-IOLENGTH form of an INQUIRE statement.  */
 
 tree
@@ -1133,8 +1157,17 @@ gfc_trans_inquire (gfc_code * code)
 			p->file);
 
   if (p->exist)
-    mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
-			       p->exist);
+    {
+      mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
+				 p->exist);
+    
+      if (p->unit && !p->iostat)
+	{
+	  p->iostat = create_dummy_iostat ();
+	  mask |= set_parameter_ref (&block, &post_block, var,
+				     IOPARM_common_iostat, p->iostat);
+	}
+    }
 
   if (p->opened)
     mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened,
Index: libgfortran/io/inquire.c
===================================================================
--- libgfortran/io/inquire.c	(revision 127756)
+++ libgfortran/io/inquire.c	(working copy)
@@ -47,7 +47,17 @@ inquire_via_unit (st_parameter_inquire *
   GFC_INTEGER_4 cf = iqp->common.flags;
 
   if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
-    *iqp->exist = iqp->common.unit >= 0;
+    {
+      *iqp->exist = (iqp->common.unit >= 0
+		     && iqp->common.unit <= GFC_INTEGER_4_HUGE);
+
+      if ((cf & IOPARM_INQUIRE_HAS_FILE) == 0)
+	{
+	  if (!(*iqp->exist))
+	    *iqp->common.iostat = ERROR_BAD_UNIT;
+          *iqp->exist = *iqp->exist && (*iqp->common.iostat != ERROR_BAD_UNIT);
+	}
+    }
 
   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
     *iqp->opened = (u != NULL);
Index: gcc/testsuite/gfortran.dg/negative_unit.f
===================================================================
--- gcc/testsuite/gfortran.dg/negative_unit.f	(revision 127756)
+++ gcc/testsuite/gfortran.dg/negative_unit.f	(working copy)
@@ -2,9 +2,12 @@
 !
 ! PR libfortran/20660 and other bugs (not filed in bugzilla) relating
 ! to negative units
+! PR 33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8
+! Test case update by Jerry DeLisle <jvdelisle@gcc.gnu.org>
 !
 ! Bugs submitted by Walt Brainerd
       integer i
+      integer, parameter ::ERROR_BAD_UNIT = 5005
       logical l
       
       i = 0
@@ -16,7 +19,14 @@
       open (unit=-11, file="xxx", iostat=i)
       if (i <= 0) call abort
 
+      i = 0
       inquire (unit=-42, exist=l)
       if (l) call abort
 
+      i = 0 
+! This one is nasty
+      inquire (unit=2_8*huge(0_4)+20_8, exist=l, iostat=i)
+      if (l) call abort
+      if (i.ne.ERROR_BAD_UNIT) call abort
+
       end