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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6769ff794aa21d603b105923aa2e82ea5d0b02fb..7fe42de5bf297bae6976c9d82cf8899b1ce0fe93 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

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 (file)
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 2a28f8405513a65b5cd2bb07d3423eb60402af34..31d5b57ef91339790f3f5fc17bd96b916fc2e9bc 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index d9cfde853f5b0957f0a33599aa214dc56b370c66..19fab1d683f2646342a1f1ccc57b0d80f46b231a 100644 (file)
--- 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,
@@ -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);