As of Fortran 2018 it's allowed to open the same file on multiple
units.
fortran/ChangeLog:
2019-05-15 Janne Blomqvist <j...@gcc.gnu.org>
PR fortran/90461
* io/open.c (new_unit): Don't check if the file is already open
for F2018.
testsuite/ChangeLog:
2019-05-15 Janne Blomqvist <j...@gcc.gnu.org>
PR fortran/90461
* gfortran.dg/open_errors_2.f90: Add -std=f2008, adjust line number.
* gfortran.dg/open_errors_3.f90: New test.
Regtested on x86_64-pc-linux-gnu, Ok for trunk?
---
gcc/testsuite/gfortran.dg/open_errors_2.f90 | 3 ++-
gcc/testsuite/gfortran.dg/open_errors_3.f90 | 11 +++++++++++
libgfortran/io/open.c | 3 ++-
3 files changed, 15 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/open_errors_3.f90
diff --git a/gcc/testsuite/gfortran.dg/open_errors_2.f90
b/gcc/testsuite/gfortran.dg/open_errors_2.f90
index 5b418349e19..72d63bb3a39 100644
--- a/gcc/testsuite/gfortran.dg/open_errors_2.f90
+++ b/gcc/testsuite/gfortran.dg/open_errors_2.f90
@@ -1,6 +1,7 @@
! { dg-do run }
+! { dg-options "-std=f2008" }
! { dg-shouldfail "runtime error" }
-! { dg-output "At line 13.*File already opened" }
+! { dg-output "At line 14.*File already opened" }
! PR 65563 - this used to segfault for some versions.
variable_1 = 0
diff --git a/gcc/testsuite/gfortran.dg/open_errors_3.f90
b/gcc/testsuite/gfortran.dg/open_errors_3.f90
new file mode 100644
index 00000000000..da9495610d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/open_errors_3.f90
@@ -0,0 +1,11 @@
+! { dg-do run }
+! PR 90461 Open file on multiple units as of F2018
+program openmult
+ implicit none
+ character(len=*), parameter :: fname="pr90461.dat"
+ open(10, file=fname, form="unformatted")
+ open(11, file=fname, form="unformatted")
+ close(11)
+ close(10, status="delete")
+end program openmult
+! { dg-final { remote_file build delete "pr90461.dat" } }
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index b48afabf7a3..d3bb11f5965 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -515,7 +515,8 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags
*flags)
Do not error if opening file preconnected to stdin, stdout, stderr. */
u2 = NULL;
- if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0)
+ if ((opp->common.flags & IOPARM_OPEN_HAS_FILE) != 0
+ && !(compile_options.allow_std & GFC_STD_F2018))
u2 = find_file (opp->file, opp->file_len);
if (u2 != NULL
&& (options.stdin_unit < 0 || u2->unit_number != options.stdin_unit)
--
2.17.1
