diff --git a/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 b/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 new file mode 100644 index 0000000..6446436 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 @@ -0,0 +1,21 @@ +! { dg-do run } +! PR48618 - Negative unit number in OPEN(...) is sometimes allowed +! +! Test originally from Janne Blomqvist in PR: +! http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48618 + +program nutest + implicit none + integer id, ios + + open(newunit=id, file="foo.txt", iostat=ios) + if (ios /= 0) call abort + + open(id, file="bar.txt", iostat=ios) + if (ios /= 0) call abort + + close(id, status="delete") + + open(-10, file="foo.txt", iostat=ios) + if (ios == 0) call abort +end program nutest diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 54ac573..f8e3f52 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,9 @@ +2013-03-06 Tilo Schwarz + + PR libfortran/48618 + * io/open.c (st_open): Raise error for unit number < 0 only if + unit number does not exist already. + 2013-02-21 Janne Blomqvist PR libfortran/30162 diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c index d9cfde8..df4808e 100644 --- a/libgfortran/io/open.c +++ b/libgfortran/io/open.c @@ -818,10 +818,6 @@ st_open (st_parameter_open *opp) flags.convert = conv; - if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0) - generate_error (&opp->common, LIBERROR_BAD_OPTION, - "Bad unit number in OPEN statement"); - if (flags.position != POSITION_UNSPECIFIED && flags.access == ACCESS_DIRECT) generate_error (&opp->common, LIBERROR_BAD_OPTION, @@ -841,6 +837,18 @@ st_open (st_parameter_open *opp) flags.position = POSITION_APPEND; } + if (!(opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT) && opp->common.unit < 0) + { + u = find_unit (opp->common.unit); + if (u == NULL) /* negative unit and no unit found */ + generate_error (&opp->common, LIBERROR_BAD_OPTION, + "Bad unit number in OPEN statement"); + /* check for previous error, otherwise unit won't be unlocked later */ + else if ((opp->common.flags & IOPARM_LIBRETURN_MASK) + != IOPARM_LIBRETURN_OK) + unlock_unit (u); + } + if (flags.position == POSITION_UNSPECIFIED) flags.position = POSITION_ASIS; @@ -849,7 +857,8 @@ st_open (st_parameter_open *opp) if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT)) opp->common.unit = get_unique_unit_number(opp); - u = find_or_create_unit (opp->common.unit); + if (u == NULL) + u = find_or_create_unit (opp->common.unit); if (u->s == NULL) { u = new_unit (opp, u, &flags);