OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR libfortran/48618 (Negative unit number in OPEN(...) is sometimes allowed) 

2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/48618
        * io/open.c (st_open): Raise error for unit number < 0 only if
        unit number does not exist already.

2013-03-20  Tilo Schwarz  <tilo@tilo-schwarz.de>

        PR libfortran/48618
        * gfortran.dg/open_negative_unit_1.f90: New.

From-SVN: r196805
This commit is contained in:
Tilo Schwarz 2013-03-20 07:45:49 +00:00 committed by Tobias Burnus
parent a192015dba
commit 09c7dc636d
4 changed files with 41 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/48618
* gfortran.dg/open_negative_unit_1.f90: New.
2013-03-19 Ian Bolton <ian.bolton@arm.com>
* gcc.target/aarch64/sbc.c: New test.

21
gcc/testsuite/gfortran.dg/open_negative_unit_1.f90 Normal file
View File

@ -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

6
libgfortran/ChangeLog
View File

@ -1,3 +1,9 @@
2013-03-20 Tilo Schwarz <tilo@tilo-schwarz.de>
PR libfortran/48618
* io/open.c (st_open): Raise error for unit number < 0 only if
unit number does not exist already.
2013-03-19 Janne Blomqvist <jb@gcc.gnu.org>
* libgfortran.h: Include stdbool.h.

14
libgfortran/io/open.c
View File

@ -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,
@ -848,8 +844,16 @@ st_open (st_parameter_open *opp)
{
if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
opp->common.unit = get_unique_unit_number(opp);
else if (opp->common.unit < 0)
{
u = find_unit (opp->common.unit);
if (u == NULL) /* Negative unit and no NEWUNIT-created unit found. */
generate_error (&opp->common, LIBERROR_BAD_OPTION,
"Bad unit number in OPEN statement");
}
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);