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

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

Hi All,

This is a resubmission of my previous patch with the backend declaration for the 
dummy variable fixed.

Thanks to Paul Thomas for that fix.

Three test cases included.  The last checking the compile with INQUIRE within a 
module.

Regression tested on x86-64.

OK for trunk?

Regards,

Jerry

	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 128892)
+++ gcc/fortran/trans-io.c	(working copy)
@@ -1083,6 +1083,32 @@ 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;
+
+  gfc_get_ha_sym_tree ("@iostat", &st);
+  st->n.sym->ts.type = BT_INTEGER;
+  st->n.sym->ts.kind = gfc_default_integer_kind;
+  gfc_set_sym_referenced (st->n.sym);
+  st->n.sym->backend_decl
+	= gfc_create_var (gfc_get_int_type (st->n.sym->ts.kind),
+			  st->n.sym->name);
+
+  e = gfc_get_expr ();
+  e->expr_type = EXPR_VARIABLE;
+  e->symtree = st;
+  e->ts.type = BT_INTEGER;
+  e->ts.kind = st->n.sym->ts.kind;
+
+  return e;
+}
+
+
 /* Translate the non-IOLENGTH form of an INQUIRE statement.  */
 
 tree
@@ -1122,8 +1148,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 128892)
+++ libgfortran/io/inquire.c	(working copy)
@@ -45,7 +45,18 @@ 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 = LIBERROR_BAD_UNIT;
+	  *iqp->exist = *iqp->exist
+			&& (*iqp->common.iostat != LIBERROR_BAD_UNIT);
+	}
+    }
 
   if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
     *iqp->opened = (u != NULL);

! { dg-do compile }
! PR 33055 Runtime error in INQUIRE unit existance with -fdefault-integer-8
! Test case from PR33217 prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
MODULE print_it
CONTAINS
  SUBROUTINE i()
    LOGICAL :: qexist
    INQUIRE (UNIT=1, EXIST=qexist)
  END SUBROUTINE i
END MODULE print_it

! { dg-do run }
!
! 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
      logical l
      
      i = 0
! gfortran created a 'fort.-1' file and wrote "Hello" in it
      write (unit=-1, fmt=*, iostat=i) "Hello"
      if (i <= 0) call abort
      
      i = 0
      open (unit=-11, file="xxx", iostat=i)
      if (i <= 0) call abort

      i = 0
      inquire (unit=-42, exist=l)
      if (l) call abort

      end

! { dg-do run }
! { dg-options "-fdefault-integer-8" }
! 
! NOTE: This test is identical to negative_unit.f except -fdefault-integer-8
!
! 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
! gfortran created a 'fort.-1' file and wrote "Hello" in it
      write (unit=-1, fmt=*, iostat=i) "Hello"
      if (i <= 0) call abort
      
      i = 0
      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