FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/20660 (INQUIRE incorrectly reports the existence of UNITS)

Browse source 
PR libfortran/20660
    * io/inquire.c (inquire_via_unit): Non-opened units should still be
    reported by an INQUIRE statement as existing.
    * io/transfer.c (data_transfer_init): Never accept negative units.

    PR libfortran/20660
    * gfortran.dg/negative_unit.f: New test.

From-SVN: r97326
This commit is contained in:
Francois-Xavier Coudert 2005-03-31 17:30:06 +02:00 • committed by François-Xavier Coudert
parent 406490a849
commit 14fd645e24
5 changed files with 46 additions and 1 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 @@
2005-03-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20660
* gfortran.dg/negative_unit.f: New test.
2005-03-31 Mostafa Hagog <mustafa@il.ibm.com>
* gcc.dg/20050330-1.c: New test.

22
gcc/testsuite/gfortran.dg/negative_unit.f Normal file
View file

@ -0,0 +1,22 @@
! {dg-do run}
!
! PR libfortran/20660 and other bugs (not filed in bugzilla) relating
! to negative units
!
! 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
inquire (unit=-42, exist=l)
if (l) call abort
end

7
libgfortran/ChangeLog
View file

@ -1,3 +1,10 @@
2005-03-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20660
* io/inquire.c (inquire_via_unit): Non-opened units should still be
reported by an INQUIRE statement as existing.
* io/transfer.c (data_transfer_init): Never accept negative units.
2005-03-29 Dale Ranta <dir@lanl.gov>
Francois-Xavier Coudert <coudert@clipper.ens.fr>

7
libgfortran/io/inquire.c
View file

@ -46,7 +46,12 @@ inquire_via_unit (gfc_unit * u)
const char *p;
if (ioparm.exist != NULL)
*ioparm.exist = (u != NULL);
{
if (ioparm.unit >= 0)
*ioparm.exist = 1;
else
*ioparm.exist = 0;
}
if (ioparm.opened != NULL)
*ioparm.opened = (u != NULL);

6
libgfortran/io/transfer.c
View file

@ -935,6 +935,12 @@ data_transfer_init (int read_flag)
current_unit = get_unit (read_flag);
if (current_unit == NULL)
{ /* Open the unit with some default flags. */
if (ioparm.unit < 0)
{
generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
library_end ();
return;
}
memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE;