re PR fortran/40008 (F2008: Add NEWUNIT= for OPEN statement)

2009-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/40008
	* libgfortran.h: Define IOPARM_OPEN_HAS_NEWUNIT.
	* io/open.c (st_open): Don't error on negative unit number if NEWUNIT
	was specified. If NEWUNIT is specified, call new function to get the
	unique unit number and assign it.
	* io/io.h (st_parameter_open): Add pointer to newunit.  Add prototype for
	next_available_newunit. Add prototype for new function,
	get_unique_unit_number.
	* io/unit.c: Declare next_available_newunit. Define the first newunit
	number. (init_units): Initialize next_available_unit.
	(get_unique_unit_number): New function. Fix whitespace and comments.
	* io/transfer.c (data_transfer_init): Update error message to not be
	specific to OPEN statements.

From-SVN: r148253

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 6558936b1d026bba0ff0723d140738da09d35104..1377d68adf61d74bcbd1c7a72a202f292e573776 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,19 @@
+2009-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/40008
+       * libgfortran.h: Define IOPARM_OPEN_HAS_NEWUNIT.
+       * io/open.c (st_open): Don't error on negative unit number if NEWUNIT
+       was specified. If NEWUNIT is specified, call new function to get the
+       unique unit number and assign it.
+       * io/io.h (st_parameter_open): Add pointer to newunit.  Add prototype for
+       next_available_newunit. Add prototype for new function,
+       get_unique_unit_number.
+       * io/unit.c: Declare next_available_newunit. Define the first newunit
+       number. (init_units): Initialize next_available_unit.
+       (get_unique_unit_number): New function. Fix whitespace and comments.
+       * io/transfer.c (data_transfer_init): Update error message to not be
+       specific to OPEN statements.
+
 2009-06-07  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/40334

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 22e097ae22d61cdf1cd928db50b855e85a3b6525..9e1e45e252b11e78531352856ab4079d1b4dd124 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -297,6 +297,7 @@ typedef struct
   CHARACTER2 (round);
   CHARACTER1 (sign);
   CHARACTER2 (asynchronous);
+  GFC_INTEGER_4 *newunit;
 }
 st_parameter_open;
 
@@ -794,6 +795,10 @@ internal_proto(unpack_filename);
 extern gfc_offset max_offset;
 internal_proto(max_offset);
 
+/* Unit number to be assigned when NEWUNIT is used in an OPEN statement.  */
+extern GFC_INTEGER_4 next_available_newunit;
+internal_proto(next_available_newunit);
+
 /* Unit tree root.  */
 extern gfc_unit *unit_root;
 internal_proto(unit_root);
@@ -831,6 +836,9 @@ internal_proto (finish_last_advance_record);
 extern int unit_truncate (gfc_unit *, gfc_offset, st_parameter_common *);
 internal_proto (unit_truncate);
 
+extern GFC_INTEGER_4 get_unique_unit_number (st_parameter_open *);
+internal_proto(get_unique_unit_number);
+
 /* open.c */
 
 extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);

diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index ba6e9d8804a6ae47bc1e09a35c1589dad12d5c36..d5b4007ea23c97f6e6cf66f9ac7a51dafa0fe2e0 100644 (file)
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -814,7 +814,7 @@ st_open (st_parameter_open *opp)
 
   flags.convert = conv;
 
-  if (opp->common.unit < 0)
+  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");
 
@@ -842,8 +842,13 @@ st_open (st_parameter_open *opp)
 
   if ((opp->common.flags & IOPARM_LIBRETURN_MASK) == IOPARM_LIBRETURN_OK)
     {
-      u = find_or_create_unit (opp->common.unit);
+      if ((opp->common.flags & IOPARM_OPEN_HAS_NEWUNIT))
+       {
+         *opp->newunit = get_unique_unit_number(opp);
+         opp->common.unit = *opp->newunit;
+       }
 
+      u = find_or_create_unit (opp->common.unit);
       if (u->s == NULL)
        {
          u = new_unit (opp, u, &flags);

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index ea1ef7a44bf6ab169db7f9e43bbe8b4d79c27a38..08ba7f56f5915a5d3009b6331c6e494188fd54e5 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2020,7 +2020,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
        close_unit (dtp->u.p.current_unit);
        dtp->u.p.current_unit = NULL;
        generate_error (&dtp->common, LIBERROR_BAD_OPTION,
-                       "Bad unit number in OPEN statement");
+                       "Bad unit number in statement");
        return;
       }
     memset (&u_flags, '\0', sizeof (u_flags));

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index 77afd9b2bb6ba8cf01f3a6a166e5a7acb222d93b..d8d0c29a8f517eaf44b021b23c60f82723565f45 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -67,6 +67,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see
 
 /* Subroutines related to units */
 
+GFC_INTEGER_4 next_available_newunit;
+#define GFC_FIRST_NEWUNIT -10
 
 #define CACHE_SIZE 3
 static gfc_unit *unit_cache[CACHE_SIZE];
@@ -131,7 +133,6 @@ rotate_right (gfc_unit * t)
 }
 
 
-
 static int
 compare (int a, int b)
 {
@@ -480,7 +481,7 @@ free_internal_unit (st_parameter_dt *dtp)
 
 
 /* get_unit()-- Returns the unit structure associated with the integer
- * unit or the internal file. */
+   unit or the internal file.  */
 
 gfc_unit *
 get_unit (st_parameter_dt *dtp, int do_create)
@@ -489,7 +490,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
   if ((dtp->common.flags & IOPARM_DT_HAS_INTERNAL_UNIT) != 0)
     return get_internal_unit(dtp);
 
-  /* Has to be an external unit */
+  /* Has to be an external unit.  */
 
   dtp->u.p.unit_is_internal = 0;
   dtp->internal_unit_desc = NULL;
@@ -499,7 +500,7 @@ get_unit (st_parameter_dt *dtp, int do_create)
 
 
 /*************************/
-/* Initialize everything */
+/* Initialize everything.  */
 
 void
 init_units (void)
@@ -511,6 +512,8 @@ init_units (void)
   __GTHREAD_MUTEX_INIT_FUNCTION (&unit_lock);
 #endif
 
+  next_available_newunit = GFC_FIRST_NEWUNIT;
+
   if (options.stdin_unit >= 0)
     {                          /* STDIN */
       u = insert_unit (options.stdin_unit);
@@ -601,10 +604,8 @@ init_units (void)
     }
 
   /* Calculate the maximum file offset in a portable manner.
-   * max will be the largest signed number for the type gfc_offset.
-   *
-   * set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit. */
-
+     max will be the largest signed number for the type gfc_offset.
+     set a 1 in the LSB and keep a running sum, stopping at MSB-1 bit.  */
   max_offset = 0;
   for (i = 0; i < sizeof (max_offset) * 8 - 1; i++)
     max_offset = max_offset + ((gfc_offset) 1 << i);
@@ -663,8 +664,8 @@ unlock_unit (gfc_unit *u)
 }
 
 /* close_unit()-- Close a unit.  The stream is closed, and any memory
- * associated with the stream is freed.  Returns nonzero on I/O error.
- * Should be called with the u->lock locked. */
+   associated with the stream is freed.  Returns nonzero on I/O error.
+   Should be called with the u->lock locked. */
 
 int
 close_unit (gfc_unit *u)
@@ -674,11 +675,11 @@ close_unit (gfc_unit *u)
 
 
 /* close_units()-- Delete units on completion.  We just keep deleting
- * the root of the treap until there is nothing left.
- * Not sure what to do with locking here.  Some other thread might be
- * holding some unit's lock and perhaps hold it indefinitely
- * (e.g. waiting for input from some pipe) and close_units shouldn't
- * delay the program too much.  */
+   the root of the treap until there is nothing left.
+   Not sure what to do with locking here.  Some other thread might be
+   holding some unit's lock and perhaps hold it indefinitely
+   (e.g. waiting for input from some pipe) and close_units shouldn't
+   delay the program too much.  */
 
 void
 close_units (void)
@@ -813,3 +814,22 @@ finish_last_advance_record (gfc_unit *u)
   fbuf_flush (u, u->mode);
 }
 
+/* Assign a negative number for NEWUNIT in OPEN statements.  */
+GFC_INTEGER_4
+get_unique_unit_number (st_parameter_open *opp)
+{
+  GFC_INTEGER_4 num;
+
+  __gthread_mutex_lock (&unit_lock);
+  num = next_available_newunit--;
+
+  /* Do not allow NEWUNIT numbers to wrap.  */
+  if (next_available_newunit >=  GFC_FIRST_NEWUNIT )
+    {
+      __gthread_mutex_unlock (&unit_lock);
+      generate_error (&opp->common, LIBERROR_INTERNAL, "NEWUNIT exhausted");
+      return 0;
+    }
+  __gthread_mutex_unlock (&unit_lock);
+  return num;
+}

diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index 3591fa9c279d1e0602caccd143731be3b2972638..a2f3e0623d2393bc07b281bb0cac9975e2f0ebfc 100644 (file)
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -590,6 +590,7 @@ st_parameter_common;
 #define IOPARM_OPEN_HAS_ROUND          (1 << 20)
 #define IOPARM_OPEN_HAS_SIGN           (1 << 21)
 #define IOPARM_OPEN_HAS_ASYNCHRONOUS   (1 << 22)
+#define IOPARM_OPEN_HAS_NEWUNIT                (1 << 23)
 
 /* library start function and end macro.  These can be expanded if needed
    in the future.  cmp is st_parameter_common *cmp  */