2007-08-26 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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@127817 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e5addac..efda5e7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-08-26  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.
+
 2007-08-26  H.J. Lu  <hongjiu.lu@intel.com>
 
        * gfortran.h (gfc_isym_id): Add GFC_ISYM_GAMMA and

diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 80646cd..cd25108 100644 (file)
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -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,

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 10e6009..2659670 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2007-08-26  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       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.
+
 2007-08-24  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/32972

diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index b1f4a14..547b831 100644 (file)
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -47,7 +47,17 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
   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);