diff mbox

[libgfortran] PR60148 Strings in NAMELIST do not honor DELIM= in open statement

Message ID 53124CB4.1070708@charter.net
State New
Headers show

Commit Message

Jerry DeLisle March 1, 2014, 9:10 p.m. UTC 
Hi all,

The attached patch fixes this by actually implementing it.  I cleaned up some of
the code by getting rid of the tmp_delim variables and adding a "mode" to
write_character which is used to ignore delimiters when writing out variable
names and other namelist parts.

I will prepare a test case.

Regression tested on x86_64.

OK for trunk or hold for next stage?

Regards,

Jerry

2014-03-01  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 if write_character.

Comments

Tobias Burnus March 2, 2014, 8:50 p.m. UTC | #1 
Dear Jerry, hi all,

Jerry DeLisle wrote:
> The attached patch fixes this by actually implementing it.  I cleaned up some of
> the code by getting rid of the tmp_delim variables and adding a "mode" to
> write_character which is used to ignore delimiters when writing out variable
> names and other namelist parts.

gfortran seems to be special as it defaults to printing the " (quote) 
delimiter by default while other compilers seem to default to "none".

With the patch, gfortran distinguishes between "none" (i.e. no quote 
character) and not set. When unset, gfortran continues to use the double 
quote character for quotation and only with "none" is uses no quote 
character.

I think gfortran's new behaviour is not not standard conform as the 
standard states that DELIM= defaults to NONE. On
the other hand, the standard explicitly requires that on input the quote 
characters have to be present.

Given that the current behaviour permits to read-back the namelist, I 
think it is invalid but acceptable to default to DELIM=QUOTE. However, I 
wonder whether we should document it at 
gcc.gnu.org/onlinedocs/gfortran/Extensions-implemented-in-GNU-Fortran.html

> I will prepare a test case.

Thanks!


I think a side-effect of the patch is that the two cases below behave 
now differently: The first returns "tue", the other causes an error. 
Before, both caused errors - which matches the result with Cray ftn and 
PGI pgf90. ifort on the other hand reads the string successfully (at 
least when the string var is shorter than trailing white spaces at the 
end of the string.)


program namelistout
    implicit none
    character :: mystring*3 = 'tue'
    namelist /mylist/ mystring

    open(unit=10, file='junk.dat')
    write(10, '(A)') ' &mylist mystring=tue              /'
    close(10)

    mystring = repeat('X', 10)
    open(unit=10,file='junk.dat',delim='none')
    read(10, mylist)
    write(*, mylist)
    close(10)

    mystring = repeat('X', 10)
    open(unit=10,file='junk.dat')
    read(10, mylist)
    write(*, mylist)
    close(10)
end program


> Regression tested on x86_64.
> OK for trunk or hold for next stage?

The patch looks good to me with a test case. I think we should/could 
document the special (nonstandard conforming) behaviour in the 
documentation. Actually, we could also mention the extended array 
support - i.e. "&nml array(1) =1,2,3,4 /" to read "array(1:4)" - but 
also make clear that this is an extension and that it should be avoided.

 From my side, I think it can still go into the trunk.

> +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)

I think it would be clearer to use "mode == DELIM"


Tobias

> 2014-03-01  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 if write_character.
Jerry DeLisle March 2, 2014, 10:49 p.m. UTC | #2 
On 03/02/2014 12:50 PM, Tobias Burnus wrote:
--- snip ---
> 
> gfortran seems to be special as it defaults to printing the " (quote) delimiter
> by default while other compilers seem to default to "none".
> 

Looking back at the draft F95 standard that I have I am amazed.  As you stated
in your note the standard calls for no quotes on namelist write if no DELIM= has
been specified. And yet, right after that, there is a note stating that the
result of such a namelist write may not be correctly readable.

That was a few years ago when we discussed this issue.  IIRC the consensus was
to make what is written as readable for default behavior.  I think what we do
now is the reasonable approach

For this patch I chose to stay consistent with what we currently do.  I can
change it to standard conforming.  Anyone else have any comments on this?

Regards,

Jerry
Steve Kargl March 2, 2014, 11:38 p.m. UTC | #3 
On Sun, Mar 02, 2014 at 02:49:20PM -0800, Jerry DeLisle wrote:
> 
> For this patch I chose to stay consistent with what we currently do.  I can
> change it to standard conforming.  Anyone else have any comments on this?
> 

I would prefer standard conformance, but I'm not the one doing the
work (so it's your call).
diff mbox

Patch

Index: inquire.c
===================================================================
--- inquire.c	(revision 208246)
+++ inquire.c	(working copy)
@@ -523,6 +523,7 @@  inquire_via_unit (st_parameter_inquire *iqp, gfc_u
 	switch (u->flags.delim)
 	  {
 	  case DELIM_NONE:
+	  case DELIM_UNSPECIFIED:
 	    p = "NONE";
 	    break;
 	  case DELIM_QUOTE:
Index: list_read.c
===================================================================
--- list_read.c	(revision 208246)
+++ list_read.c	(working copy)
@@ -971,10 +971,24 @@  read_character (st_parameter_dt *dtp, int length _
     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;
     }
Index: open.c
===================================================================
--- open.c	(revision 208246)
+++ open.c	(working copy)
@@ -332,17 +332,13 @@  new_unit (st_parameter_open *opp, gfc_unit *u, uni
 
   /* 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)
Index: transfer.c
===================================================================
--- transfer.c	(revision 208246)
+++ transfer.c	(working copy)
@@ -2670,16 +2670,21 @@  data_transfer_init (st_parameter_dt *dtp, int read
 	= !(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;
 
Index: unit.c
===================================================================
--- unit.c	(revision 208246)
+++ unit.c	(working copy)
@@ -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;
Index: write.c
===================================================================
--- write.c	(revision 208246)
+++ write.c	(working copy)
@@ -1312,24 +1312,32 @@  write_integer (st_parameter_dt *dtp, const char *s
 /* 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)
     {
-    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,
   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,
       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
   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
   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
 	  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
 	  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
               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
 	     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_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;
+  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';
+    }
 
-  dtp->u.p.nml_delim = tmp_delim == DELIM_APOSTROPHE ? '\'' : '"';
+  write_character (dtp, "&", 1, 1, NODELIM);
 
-  /* Temporarily disable namelist delimters.  */
-  dtp->u.p.current_unit->delim_status = DELIM_NONE;
-
-  write_character (dtp, "&", 1, 1);
-
   /* 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