Re: [Patch, libfortran, 2nd version] PR 48618 - Negative unit number in OPEN(...) is sometimes allowed

[Tilo Schwarz]

Hi,

this patch fixes PR 48618.

Built and regtested on Linux 3.2.0-4-686-pae.

Thanks for input and corrections to Tobias Burnus.


Regards,

        Tilo
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  <t...@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-02-21  Janne Blomqvist  <j...@gcc.gnu.org>
 
 	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);