re PR fortran/60148 (strings in NAMELIST do not honor DELIM= in open statement)

2014-03-03  Jerry DeLisle  <jvdelisle@gcc.gnu>

	PR libfortran/60148
	* io/inquire.c (inquire_via_unit): In the case of
	DELIM_UNSPECIFIED set inquire return string to "NONE".
	* io/list_read.c (read_character): In the case of DELIM_NONE and
	namelists, complete the character read using the namelist
	variable length.
	* io/open.c (new_unit): Don't set delim status to none if not
	specified so that DELIM_UNSPECIFIED can be used later.
	* io/transfer.c (data_transfer_init): For namelist I/O, if the
	unit delim status is unspecified set the current status to quote.
	Otherwise, set current status to the unit status.
	* io/unit.c (get_internel_unit, init_unit): Remember to set
	flags_delim initially to DELIM_UNSPECIFIED so defaults come out
	correctly.
	* io/write.c (write_character): Add a new function argument
	"mode" to signify that raw output is to be used vs output with
	delimiters. If the mode is set to DELIM (1) proceed with
	delimiters. (list_formatted_write_scalar): Write the separator
	only if a delimiter was previously specified. Update the call to
	write_character with the mode argument given.
	(namelist_write_newline): Use the mode argument. (nml_write_obj):
	Use the mode argument. Remove use of tmp_delim. Write the
	semi-colon or comma correctly only when needed with using
	delimiters. Cleanup whitespace.
	(namelist_write): If delim is not specified in namelist I/O,
	default	to using quotes. Get rid of the tmp_delim variable and
	use the new mode argument in write_character.

From-SVN: r208302

7 files changed, 129 insertions, 68 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index e39607e5673..0cf04d2a2b0 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,33 @@
+2014-03-03  Jerry DeLisle  <jvdelisle@gcc.gnu>
+
+	PR libfortran/60148
+	* io/inquire.c (inquire_via_unit): In the case of
+	DELIM_UNSPECIFIED set inquire return string to "NONE".
+	* io/list_read.c (read_character): In the case of DELIM_NONE and
+	namelists, complete the character read using the namelist
+	variable length.
+	* io/open.c (new_unit): Don't set delim status to none if not
+	specified so that DELIM_UNSPECIFIED can be used later.
+	* io/transfer.c (data_transfer_init): For namelist I/O, if the
+	unit delim status is unspecified set the current status to quote.
+	Otherwise, set current status to the unit status.
+	* io/unit.c (get_internel_unit, init_unit): Remember to set
+	flags_delim initially to DELIM_UNSPECIFIED so defaults come out
+	correctly.
+	* io/write.c (write_character): Add a new function argument
+	"mode" to signify that raw output is to be used vs output with
+	delimiters. If the mode is set to DELIM (1) proceed with
+	delimiters. (list_formatted_write_scalar): Write the separator
+	only if a delimiter was previously specified. Update the call to
+	write_character with the mode argument given.
+	(namelist_write_newline): Use the mode argument. (nml_write_obj):
+	Use the mode argument. Remove use of tmp_delim. Write the
+	semi-colon or comma correctly only when needed with using
+	delimiters. Cleanup whitespace.
+	(namelist_write): If delim is not specified in namelist I/O,
+	default	to using quotes. Get rid of the tmp_delim variable and
+	use the new mode argument in write_character.
+
 2014-02-21  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/60286
diff --git a/libgfortran/io/inquire.c b/libgfortran/io/inquire.c
index 6801d01b084..c41237c3ec7 100644
--- a/libgfortran/io/inquire.c
+++ b/libgfortran/io/inquire.c
@@ -523,6 +523,7 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
 	switch (u->flags.delim)
 	  {
 	  case DELIM_NONE:
+	  case DELIM_UNSPECIFIED:
 	    p = "NONE";
 	    break;
 	  case DELIM_QUOTE:
diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 942f311410f..d1d09b5fe7d 100644
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -971,10 +971,24 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
     default:
       if (dtp->u.p.namelist_mode)
 	{
+	  if (dtp->u.p.current_unit->delim_status == DELIM_NONE)
+	    {
+	      /* No delimiters so finish reading the string now.  */
+	      int i;
+	      push_char (dtp, c);
+	      for (i = dtp->u.p.ionml->string_length; i > 1; i--)
+		{
+		  if ((c = next_char (dtp)) == EOF)
+		    goto done_eof;
+		  push_char (dtp, c);
+		}
+	      dtp->u.p.saved_type = BT_CHARACTER;
+	      free_line (dtp);
+	      return;
+	    }
 	  unget_char (dtp, c);
 	  return;
 	}
-
       push_char (dtp, c);
       goto get_string;
     }
diff --git a/libgfortran/io/open.c b/libgfortran/io/open.c
index 02c3f5a165d..06fd59415fe 100644
--- a/libgfortran/io/open.c
+++ b/libgfortran/io/open.c
@@ -332,17 +332,13 @@ new_unit (st_parameter_open *opp, gfc_unit *u, unit_flags * flags)
 
   /* Checks.  */
 
-  if (flags->delim == DELIM_UNSPECIFIED)
-    flags->delim = DELIM_NONE;
-  else
+  if (flags->delim != DELIM_UNSPECIFIED
+      && flags->form == FORM_UNFORMATTED)
     {
-      if (flags->form == FORM_UNFORMATTED)
-	{
-	  generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
-			  "DELIM parameter conflicts with UNFORMATTED form in "
-			  "OPEN statement");
-	  goto fail;
-	}
+      generate_error (&opp->common, LIBERROR_OPTION_CONFLICT,
+		      "DELIM parameter conflicts with UNFORMATTED form in "
+		      "OPEN statement");
+      goto fail;
     }
 
   if (flags->blank == BLANK_UNSPECIFIED)
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 87415d5cc7c..cadbcabeda4 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2670,16 +2670,21 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 	= !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
 	  find_option (&dtp->common, dtp->delim, dtp->delim_len,
 	  delim_opt, "Bad DELIM parameter in data transfer statement");
-  
+
   if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED)
-    dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim;
+    {
+      if (ionml && dtp->u.p.current_unit->flags.delim == DELIM_UNSPECIFIED)
+	dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
+      else
+	dtp->u.p.current_unit->delim_status = dtp->u.p.current_unit->flags.delim;
+    }
 
   /* Check the pad mode.  */
   dtp->u.p.current_unit->pad_status
 	= !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
 	  find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt,
 			"Bad PAD parameter in data transfer statement");
-  
+
   if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
 	dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
 
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index f9b594d0ce3..901d66fa0c1 100644
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -464,6 +464,7 @@ get_internal_unit (st_parameter_dt *dtp)
   iunit->flags.status = STATUS_UNSPECIFIED;
   iunit->flags.sign = SIGN_SUPPRESS;
   iunit->flags.decimal = DECIMAL_POINT;
+  iunit->flags.delim = DELIM_UNSPECIFIED;
   iunit->flags.encoding = ENCODING_DEFAULT;
   iunit->flags.async = ASYNC_NO;
   iunit->flags.round = ROUND_UNSPECIFIED;
@@ -584,6 +585,7 @@ init_units (void)
       u->flags.position = POSITION_ASIS;
       u->flags.sign = SIGN_SUPPRESS;
       u->flags.decimal = DECIMAL_POINT;
+      u->flags.delim = DELIM_UNSPECIFIED;
       u->flags.encoding = ENCODING_DEFAULT;
       u->flags.async = ASYNC_NO;
       u->flags.round = ROUND_UNSPECIFIED;
diff --git a/libgfortran/io/write.c b/libgfortran/io/write.c
index 61b5691d619..eccbe7e2a20 100644
--- a/libgfortran/io/write.c
+++ b/libgfortran/io/write.c
@@ -1312,24 +1312,32 @@ write_integer (st_parameter_dt *dtp, const char *source, int length)
 /* Write a list-directed string.  We have to worry about delimiting
    the strings if the file has been opened in that mode.  */
 
+#define DELIM 1
+#define NODELIM 0
+
 static void
-write_character (st_parameter_dt *dtp, const char *source, int kind, int length)
+write_character (st_parameter_dt *dtp, const char *source, int kind, int length, int mode)
 {
   int i, extra;
   char *p, d;
 
-  switch (dtp->u.p.current_unit->delim_status)
+  if (mode == DELIM)
     {
-    case DELIM_APOSTROPHE:
-      d = '\'';
-      break;
-    case DELIM_QUOTE:
-      d = '"';
-      break;
-    default:
-      d = ' ';
-      break;
+      switch (dtp->u.p.current_unit->delim_status)
+	{
+	case DELIM_APOSTROPHE:
+	  d = '\'';
+	  break;
+	case DELIM_QUOTE:
+	  d = '"';
+	  break;
+	default:
+	  d = ' ';
+	  break;
+	}
     }
+  else
+    d = ' ';
 
   if (kind == 1)
     {
@@ -1551,7 +1559,8 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
   else
     {
       if (type != BT_CHARACTER || !dtp->u.p.char_flag ||
-	dtp->u.p.current_unit->delim_status != DELIM_NONE)
+	  (dtp->u.p.current_unit->delim_status != DELIM_NONE
+	   && dtp->u.p.current_unit->delim_status != DELIM_UNSPECIFIED))
       write_separator (dtp);
     }
 
@@ -1564,7 +1573,7 @@ list_formatted_write_scalar (st_parameter_dt *dtp, bt type, void *p, int kind,
       write_logical (dtp, p, kind);
       break;
     case BT_CHARACTER:
-      write_character (dtp, p, kind, size);
+      write_character (dtp, p, kind, size, DELIM);
       break;
     case BT_REAL:
       write_real (dtp, p, kind);
@@ -1628,9 +1637,9 @@ namelist_write_newline (st_parameter_dt *dtp)
   if (!is_internal_unit (dtp))
     {
 #ifdef HAVE_CRLF
-      write_character (dtp, "\r\n", 1, 2);
+      write_character (dtp, "\r\n", 1, 2, NODELIM);
 #else
-      write_character (dtp, "\n", 1, 1);
+      write_character (dtp, "\n", 1, 1, NODELIM);
 #endif
       return;
     }
@@ -1675,7 +1684,7 @@ namelist_write_newline (st_parameter_dt *dtp)
 	}
     }
   else
-    write_character (dtp, " ", 1, 1);
+    write_character (dtp, " ", 1, 1, NODELIM);
 }
 
 
@@ -1704,7 +1713,6 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
   size_t base_name_len;
   size_t base_var_name_len;
   size_t tot_len;
-  unit_delim tmp_delim;
   
   /* Set the character to be used to separate values
      to a comma or semi-colon.  */
@@ -1718,7 +1726,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
   if (obj->type != BT_DERIVED)
     {
       namelist_write_newline (dtp);
-      write_character (dtp, " ", 1, 1);
+      write_character (dtp, " ", 1, 1, NODELIM);
 
       len = 0;
       if (base)
@@ -1728,16 +1736,16 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 	  for (dim_i = 0; dim_i < base_name_len; dim_i++)
             {
 	      cup = toupper ((int) base_name[dim_i]);
-	      write_character (dtp, &cup, 1, 1);
+	      write_character (dtp, &cup, 1, 1, NODELIM);
             }
 	}
       clen = strlen (obj->var_name);
       for (dim_i = len; dim_i < clen; dim_i++)
 	{
 	  cup = toupper ((int) obj->var_name[dim_i]);
-	  write_character (dtp, &cup, 1, 1);
+	  write_character (dtp, &cup, 1, 1, NODELIM);
 	}
-      write_character (dtp, "=", 1, 1);
+      write_character (dtp, "=", 1, 1, NODELIM);
     }
 
   /* Counts the number of data output on a line, including names.  */
@@ -1807,7 +1815,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 	  if (rep_ctr > 1)
 	    {
 	      snprintf(rep_buff, NML_DIGITS, " %d*", rep_ctr);
-	      write_character (dtp, rep_buff, 1, strlen (rep_buff));
+	      write_character (dtp, rep_buff, 1, strlen (rep_buff), NODELIM);
 	      dtp->u.p.no_leading_blank = 1;
 	    }
 	  num++;
@@ -1827,13 +1835,7 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
               break;
 
 	    case BT_CHARACTER:
-	      tmp_delim = dtp->u.p.current_unit->delim_status;
-	      if (dtp->u.p.nml_delim == '"')
-		dtp->u.p.current_unit->delim_status = DELIM_QUOTE;
-	      if (dtp->u.p.nml_delim == '\'')
-		dtp->u.p.current_unit->delim_status = DELIM_APOSTROPHE;
-	      write_character (dtp, p, 1, obj->string_length);
-		dtp->u.p.current_unit->delim_status = tmp_delim;
+	      write_character (dtp, p, 1, obj->string_length, DELIM);
               break;
 
 	    case BT_REAL:
@@ -1921,12 +1923,20 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 	     to column 2. Reset the repeat counter.  */
 
 	  dtp->u.p.no_leading_blank = 0;
-	  write_character (dtp, &semi_comma, 1, 1);
+	  if (obj->type == BT_CHARACTER)
+	    {
+	      if (dtp->u.p.nml_delim != '\0')
+		write_character (dtp, &semi_comma, 1, 1, NODELIM);
+	    }
+	  else
+	    write_character (dtp, &semi_comma, 1, 1, NODELIM);
 	  if (num > 5)
 	    {
 	      num = 0;
+	      if (dtp->u.p.nml_delim == '\0')
+		write_character (dtp, &semi_comma, 1, 1, NODELIM);
 	      namelist_write_newline (dtp);
-	      write_character (dtp, " ", 1, 1);
+	      write_character (dtp, " ", 1, 1, NODELIM);
 	    }
 	  rep_ctr = 1;
 	}
@@ -1935,17 +1945,17 @@ nml_write_obj (st_parameter_dt *dtp, namelist_info * obj, index_type offset,
 
 obj_loop:
 
-    nml_carry = 1;
-    for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
-      {
-	obj->ls[dim_i].idx += nml_carry ;
-	nml_carry = 0;
- 	if (obj->ls[dim_i].idx  > GFC_DESCRIPTOR_UBOUND(obj,dim_i))
-	  {
- 	    obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
-	    nml_carry = 1;
-	  }
-       }
+      nml_carry = 1;
+      for (dim_i = 0; nml_carry && (dim_i < (size_t) obj->var_rank); dim_i++)
+	{
+	  obj->ls[dim_i].idx += nml_carry ;
+	  nml_carry = 0;
+	  if (obj->ls[dim_i].idx  > GFC_DESCRIPTOR_UBOUND(obj,dim_i))
+	    {
+	      obj->ls[dim_i].idx = GFC_DESCRIPTOR_LBOUND(obj,dim_i);
+	      nml_carry = 1;
+	    }
+	 }
     }
 
   /* Return a pointer beyond the furthest object accessed.  */
@@ -1967,23 +1977,28 @@ namelist_write (st_parameter_dt *dtp)
   index_type dummy_offset = 0;
   char c;
   char * dummy_name = NULL;
-  unit_delim tmp_delim = DELIM_UNSPECIFIED;
 
   /* Set the delimiter for namelist output.  */
-  tmp_delim = dtp->u.p.current_unit->delim_status;
-
-  dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"';
-
-  /* Temporarily disable namelist delimters.  */
-  dtp->u.p.current_unit->delim_status = DELIM_NONE;
+  switch (dtp->u.p.current_unit->delim_status)
+    {
+      case DELIM_APOSTROPHE:
+        dtp->u.p.nml_delim = '\'';
+	break;
+      case DELIM_QUOTE:
+      case DELIM_UNSPECIFIED:
+	dtp->u.p.nml_delim = '"';
+	break;
+      default:
+	dtp->u.p.nml_delim = '\0';
+    }
 
-  write_character (dtp, "&", 1, 1);
+  write_character (dtp, "&", 1, 1, NODELIM);
 
   /* Write namelist name in upper case - f95 std.  */
   for (i = 0 ;i < dtp->namelist_name_len ;i++ )
     {
       c = toupper ((int) dtp->namelist_name[i]);
-      write_character (dtp, &c, 1 ,1);
+      write_character (dtp, &c, 1 ,1, NODELIM);
     }
 
   if (dtp->u.p.ionml != NULL)
@@ -1997,9 +2012,7 @@ namelist_write (st_parameter_dt *dtp)
     }
 
   namelist_write_newline (dtp);
-  write_character (dtp, " /", 1, 2);
-  /* Restore the original delimiter.  */
-  dtp->u.p.current_unit->delim_status = tmp_delim;
+  write_character (dtp, " /", 1, 2, NODELIM);
 }
 
 #undef NML_DIGITS