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

	PR libfortran/40330
	PR libfortran/40662
	* io/io.h (st_parameter_dt): Define format_not_saved bit used to signal
	whether the parsed format data was previously saved. Used to determine
	if the current format data should be freed or not.
	* io/transfer.c (st_read_done): Use the format_not_saved bit.
	(st_write_done): Likewise.
	* io/format.c (parse_format_list): Add boolean pointer to arg list. This
	pointer is used to return status to the caller regarding whether it is
	safe to cache the parsed format data.  Currently, if a FMT_STRING token
	is encounetered, it is not safe to cache. Also, added a local boolean
	variable to hold this information as recursive calls to
	parse_format_list are made.  Remove previous save_format logic.
	(parse_format): Do not use the format caching facility if the current
	unit is an internal unit or if it is not safe to save parsed format
	data.

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

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index dda90a6..7ea4129 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,22 @@
+2009-07-08  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/40330
+       PR libfortran/40662
+       * io/io.h (st_parameter_dt): Define format_not_saved bit used to signal
+       whether the parsed format data was previously saved. Used to determine
+       if the current format data should be freed or not.
+       * io/transfer.c (st_read_done): Use the format_not_saved bit.
+       (st_write_done): Likewise.
+       * io/format.c (parse_format_list): Add boolean pointer to arg list. This
+       pointer is used to return status to the caller regarding whether it is
+       safe to cache the parsed format data.  Currently, if a FMT_STRING token
+       is encounetered, it is not safe to cache. Also, added a local boolean
+       variable to hold this information as recursive calls to
+       parse_format_list are made.  Remove previous save_format logic.
+       (parse_format): Do not use the format caching facility if the current
+       unit is an internal unit or if it is not safe to save parsed format
+       data.
+       
 2009-06-29  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR libfortran/40576

diff --git a/libgfortran/io/format.c b/libgfortran/io/format.c
index 401cd82..e40adb9 100644 (file)
--- a/libgfortran/io/format.c
+++ b/libgfortran/io/format.c
@@ -578,16 +578,16 @@ format_lex (format_data *fmt)
  * parenthesis node which contains the rest of the list. */
 
 static fnode *
-parse_format_list (st_parameter_dt *dtp)
+parse_format_list (st_parameter_dt *dtp, bool *save_ok)
 {
   fnode *head, *tail;
   format_token t, u, t2;
   int repeat;
   format_data *fmt = dtp->u.p.fmt;
-  bool save_format;
+  bool saveit;
 
   head = tail = NULL;
-  save_format = !is_internal_unit (dtp);
+  saveit = *save_ok;
 
   /* Get the next format item */
  format_item:
@@ -604,7 +604,7 @@ parse_format_list (st_parameter_dt *dtp)
        case FMT_LPAREN:
          get_fnode (fmt, &head, &tail, FMT_LPAREN);
          tail->repeat = repeat;
-         tail->u.child = parse_format_list (dtp);
+         tail->u.child = parse_format_list (dtp, &saveit);
          if (fmt->error != NULL)
            goto finished;
 
@@ -631,7 +631,7 @@ parse_format_list (st_parameter_dt *dtp)
     case FMT_LPAREN:
       get_fnode (fmt, &head, &tail, FMT_LPAREN);
       tail->repeat = 1;
-      tail->u.child = parse_format_list (dtp);
+      tail->u.child = parse_format_list (dtp, &saveit);
       if (fmt->error != NULL)
        goto finished;
 
@@ -687,8 +687,9 @@ parse_format_list (st_parameter_dt *dtp)
       goto between_desc;
 
     case FMT_STRING:
+      /* TODO: Find out why is is necessary to turn off format caching.  */
+      saveit = false;
       get_fnode (fmt, &head, &tail, FMT_STRING);
-
       tail->u.string.p = fmt->string;
       tail->u.string.length = fmt->value;
       tail->repeat = 1;
@@ -698,7 +699,6 @@ parse_format_list (st_parameter_dt *dtp)
     case FMT_DP:
       notify_std (&dtp->common, GFC_STD_F2003, "Fortran 2003: DC or DP "
                  "descriptor not allowed");
-      save_format = true;
     /* Fall through.  */
     case FMT_S:
     case FMT_SS:
@@ -724,10 +724,8 @@ parse_format_list (st_parameter_dt *dtp)
       get_fnode (fmt, &head, &tail, FMT_DOLLAR);
       tail->repeat = 1;
       notify_std (&dtp->common, GFC_STD_GNU, "Extension: $ descriptor");
-      save_format = false;
       goto between_desc;
 
-
     case FMT_T:
     case FMT_TL:
     case FMT_TR:
@@ -759,7 +757,6 @@ parse_format_list (st_parameter_dt *dtp)
 
     case FMT_H:
       get_fnode (fmt, &head, &tail, FMT_STRING);
-
       if (fmt->format_string_len < 1)
        {
          fmt->error = bad_hollerith;
@@ -822,7 +819,6 @@ parse_format_list (st_parameter_dt *dtp)
              fmt->saved_token = t;
              fmt->value = 1;   /* Default width */
              notify_std (&dtp->common, GFC_STD_GNU, posint_required);
-             save_format = false;
            }
        }
 
@@ -959,7 +955,6 @@ parse_format_list (st_parameter_dt *dtp)
        }
 
       get_fnode (fmt, &head, &tail, FMT_STRING);
-
       tail->u.string.p = fmt->format_string;
       tail->u.string.length = repeat;
       tail->repeat = 1;
@@ -1074,6 +1069,9 @@ parse_format_list (st_parameter_dt *dtp)
   goto format_item;
 
  finished:
+
+  *save_ok = saveit;
+  
   return head;
 }
 
@@ -1166,18 +1164,23 @@ void
 parse_format (st_parameter_dt *dtp)
 {
   format_data *fmt;
+  bool format_cache_ok;
 
-  /* Lookup format string to see if it has already been parsed.  */
-
-  dtp->u.p.fmt = find_parsed_format (dtp);
+  format_cache_ok = !is_internal_unit (dtp);
 
-  if (dtp->u.p.fmt != NULL)
+  /* Lookup format string to see if it has already been parsed.  */
+  if (format_cache_ok)
     {
-      dtp->u.p.fmt->reversion_ok = 0;
-      dtp->u.p.fmt->saved_token = FMT_NONE;
-      dtp->u.p.fmt->saved_format = NULL;
-      reset_fnode_counters (dtp);
-      return;
+      dtp->u.p.fmt = find_parsed_format (dtp);
+
+      if (dtp->u.p.fmt != NULL)
+       {
+         dtp->u.p.fmt->reversion_ok = 0;
+         dtp->u.p.fmt->saved_token = FMT_NONE;
+         dtp->u.p.fmt->saved_format = NULL;
+         reset_fnode_counters (dtp);
+         return;
+       }
     }
 
   /* Not found so proceed as follows.  */
@@ -1191,12 +1194,12 @@ parse_format (st_parameter_dt *dtp)
   fmt->error = NULL;
   fmt->value = 0;
 
-  /* Initialize variables used during traversal of the tree */
+  /* Initialize variables used during traversal of the tree.  */
 
   fmt->reversion_ok = 0;
   fmt->saved_format = NULL;
 
-  /* Allocate the first format node as the root of the tree */
+  /* Allocate the first format node as the root of the tree.  */
 
   fmt->last = &fmt->array;
   fmt->last->next = NULL;
@@ -1208,7 +1211,7 @@ parse_format (st_parameter_dt *dtp)
   fmt->avail++;
 
   if (format_lex (fmt) == FMT_LPAREN)
-    fmt->array.array[0].u.child = parse_format_list (dtp);
+    fmt->array.array[0].u.child = parse_format_list (dtp, &format_cache_ok);
   else
     fmt->error = "Missing initial left parenthesis in format";
 
@@ -1219,9 +1222,10 @@ parse_format (st_parameter_dt *dtp)
       return;
     }
 
-  /* TODO: Interim fix for PR40508. Revise this for PR40330.  */
-  if (!is_internal_unit(dtp))
+  if (format_cache_ok)
     save_parsed_format (dtp);
+  else
+    dtp->u.p.format_not_saved = 1;
 }
 
 

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 9e1e45e..088969a 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -481,7 +481,9 @@ typedef struct st_parameter_dt
          unsigned at_eof : 1;
          /* Used for g0 floating point output.  */
          unsigned g0_no_blanks : 1;
-         /* 15 unused bits.  */
+         /* Used to signal use of free_format_data.  */
+         unsigned format_not_saved : 1;
+         /* 14 unused bits.  */
 
          char last_char;
          char nml_delim;

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 4ad1cf0..7d833b7 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -3251,7 +3251,7 @@ void
 st_read_done (st_parameter_dt *dtp)
 {
   finalize_transfer (dtp);
-  if (is_internal_unit (dtp))
+  if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
     free_format_data (dtp->u.p.fmt);
   free_ionml (dtp);
   if (dtp->u.p.current_unit != NULL)
@@ -3303,7 +3303,7 @@ st_write_done (st_parameter_dt *dtp)
        break;
       }
 
-  if (is_internal_unit (dtp))
+  if (is_internal_unit (dtp) || dtp->u.p.format_not_saved)
     free_format_data (dtp->u.p.fmt);
   free_ionml (dtp);
   if (dtp->u.p.current_unit != NULL)