OSDN Git Service

2009-06-07 Jerry DeLisle <jvdelisle@gcc.gnu.org>
authorjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 7 Jun 2009 19:00:47 +0000 (19:00 +0000)
committerjvdelisle <jvdelisle@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 7 Jun 2009 19:00:47 +0000 (19:00 +0000)
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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@148253 138bc75d-0d04-0410-961f-82ee72b054a4

libgfortran/ChangeLog
libgfortran/io/io.h
libgfortran/io/open.c
libgfortran/io/transfer.c
libgfortran/io/unit.c
libgfortran/libgfortran.h

index 6558936..1377d68 100644 (file)
@@ -1,5 +1,21 @@
 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
        * io/list_read.c (list_formatted_read_scalar): Set the end file
        conditions after a return from EOF error.
index 22e097a..9e1e45e 100644 (file)
@@ -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 *);
index ba6e9d8..d5b4007 100644 (file)
@@ -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);
index ea1ef7a..08ba7f5 100644 (file)
@@ -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));
index 77afd9b..d8d0c29 100644 (file)
@@ -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;
+}
index 3591fa9..a2f3e06 100644 (file)
@@ -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  */