Commit 5d75fb81 by Jerry DeLisle

re PR libfortran/33055 (Runtime error in INQUIRE unit existance with -fdefault-integer-8)

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

	PR fortran/33055
	Revert previous patch.

From-SVN: r127877
parent d05fd136
...@@ -1094,30 +1094,6 @@ gfc_trans_flush (gfc_code * code) ...@@ -1094,30 +1094,6 @@ 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. */ /* Translate the non-IOLENGTH form of an INQUIRE statement. */
tree tree
...@@ -1157,17 +1133,8 @@ gfc_trans_inquire (gfc_code * code) ...@@ -1157,17 +1133,8 @@ gfc_trans_inquire (gfc_code * code)
p->file); p->file);
if (p->exist) if (p->exist)
{ mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist, p->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) if (p->opened)
mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened, mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_opened,
......
...@@ -7,7 +7,6 @@ ...@@ -7,7 +7,6 @@
! !
! Bugs submitted by Walt Brainerd ! Bugs submitted by Walt Brainerd
integer i integer i
integer, parameter ::ERROR_BAD_UNIT = 5005
logical l logical l
i = 0 i = 0
...@@ -23,10 +22,4 @@ ...@@ -23,10 +22,4 @@
inquire (unit=-42, exist=l) inquire (unit=-42, exist=l)
if (l) call abort 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 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
...@@ -47,17 +47,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) ...@@ -47,17 +47,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
GFC_INTEGER_4 cf = iqp->common.flags; GFC_INTEGER_4 cf = iqp->common.flags;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) 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) if ((cf & IOPARM_INQUIRE_HAS_OPENED) != 0)
*iqp->opened = (u != NULL); *iqp->opened = (u != NULL);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment