[patch, libfortran] PR33253 namelist: reading back a string with apostrophe

[Jerry DeLisle <jvdelisle at verizon dot net>]

:ADDPATCH fortran:

Hi all,

After a lot of fussing, I think I have sorted this out.

The attached patch includes my original fix to this pr which checked for 
delimiters to decide whether to terminate reading.

In addition, this patch adjusts the conditions that allow extended reads of 
namelists.  This now requires -std=legacy.  The reason is that all these cases 
with non standard namelists such as extra data or no delimiters end up 
conflicting.  The mechanism for handling these is present, its a matter of 
choice when to allow what.

With this patch, non-delimited (no ' or ") strings work by default.  The test 
case namelist_24.f90 is modified to -std=legacy.  Two new test cases are 
provided. The test case namelist_39.f90 is derived from Toon Moene's case in 
pr33421.

I want to mention that according to the F95 standard, character strings in 
namelists are supposed to be delimited.  People should do that. (strong hint to 
anyone reading this :) ).

Regression tested on x86-64.

OK for trunk?

Regards,

Jerry

2007-09-30  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/33252
	* io/list_read.c (read_character): Use DELIM_APOSTROPHE and DELIM_QUOTE
        in check of first character in string.
	(nml_parse_qualifier): Only allow extended reads if -std=legacy
	is given.

Index: list_read.c
===================================================================
--- list_read.c	(revision 128892)
+++ list_read.c	(working copy)
@@ -893,7 +893,9 @@ read_character (st_parameter_dt *dtp, in
       goto get_string;
 
     default:
-      if (dtp->u.p.namelist_mode)
+      if (dtp->u.p.namelist_mode
+	  && (dtp->u.p.current_unit->flags.delim == DELIM_APOSTROPHE
+	      || dtp->u.p.current_unit->flags.delim == DELIM_QUOTE))
 	{
 	  unget_char (dtp,c);
 	  return;
@@ -1797,10 +1799,10 @@ nml_parse_qualifier (st_parameter_dt *dt
 		{
 		  memcpy (&ls[dim].start, dtp->u.p.value, sizeof(ssize_t));
 
-		  /*  If -std=f95/2003 or an array section is specified,
-		      do not allow excess data to be processed.  */
+		  /*  Do not allow excess data to be processed if this is
+		      an array section or not -std=legacy.  */
                   if (is_array_section == 1
-		      || compile_options.allow_std < GFC_STD_GNU)
+		      || compile_options.warn_std)
 		    ls[dim].end = ls[dim].start;
 		  else
 		    dtp->u.p.expanded_read = 1;

! { dg-do run }
! PR33253 namelist: reading back a string, also fixed writing with delimiters.
! Test case modified from that of the PR by
! Jerry DeLisle  <jvdelisle@gcc.gnu.org>
program main
  implicit none
  character(len=3) :: a
  namelist /foo/ a

  open(10, status="scratch", delim="quote")
  a = 'a"a'
  write(10,foo) 
  rewind 10
  a = ""
  read (10,foo) ! This gave a runtime error before the patch.
  if (a.ne.'a"a') call abort
  close (10)

  open(10, status="scratch", delim="apostrophe")
  a = "a'a"
  write(10,foo) 
  rewind 10
  a = ""
  read (10,foo)
  if (a.ne."a'a") call abort
  close (10)

  open(10, status="scratch", delim="none")
  a = "a'a"
  write(10,foo) 
  rewind 10
  a = ""
  read (10,foo)
  if (a.ne."a'a") call abort
  close (10)
end program main

! { dg-do run }
! PR33421 and PR33252 Weird quotation of namelist output of character arrays
! Test case from Toon Moene, adapted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>

program test
implicit none
character(len=45) :: b(3)
namelist /nam/ b
b = 'x'
open(99, status="scratch")
write(99,'(4(a,/),a)') "&NAM", &
      " b(1)=' AAP NOOT MIES WIM ZUS JET',", &
      " b(2)='SURF.PRESSURE',", &
      " b(3)='APEKOOL',", &
      " /"
rewind(99)
read(99,nml=nam)
close(99)

if (b(1).ne." AAP NOOT MIES WIM ZUS JET                   ") call abort
if (b(2).ne."SURF.PRESSURE                                ") call abort
if (b(3).ne."APEKOOL                                      ") call abort

end program test

!{ dg-do run }
!{ dg-options -std=legacy }
! Tests namelist read when more data is provided then specified by 
! array qualifier in list.
! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
      program pr24459
      implicit none
      integer nd, ier, i, j
      parameter ( nd = 5 )
      character*(8) names(nd,nd)
      character*(8) names2(nd,nd)
      character*(8) names3(nd,nd)
      namelist / mynml /  names, names2, names3
      open(unit=20,status='scratch', delim='apostrophe')
      write (20, '(a)') "&MYNML"
      write (20, '(a)') "NAMES = 25*'0'"
      write (20, '(a)') "NAMES2 = 25*'0'"
      write (20, '(a)') "NAMES3 = 25*'0'"
      write (20, '(a)') "NAMES(2,2) = 'frogger'"
      write (20, '(a)') "NAMES(1,1) = 'E123' 'E456' 'D789' 'P135' 'P246'"
      write (20, '(a)') "NAMES2(1:5:2,2) = 'abcde' 'fghij' 'klmno'"
      write (20, '(a)') "NAMES3 = 'E123' 'E456' 'D789' 'P135' 'P246' '0' 'frogger'"
      write (20, '(a)') "/"
      rewind(20)
      read(20,nml=mynml, iostat=ier)
      if (ier.ne.0) call abort()
      if (any(names(:,3:5).ne."0")) call abort()
      if (names(2,2).ne."frogger") call abort()
      if (names(1,1).ne."E123") call abort()
      if (names(2,1).ne."E456") call abort()
      if (names(3,1).ne."D789") call abort()
      if (names(4,1).ne."P135") call abort()
      if (names(5,1).ne."P246") call abort()
      if (any(names2(:,1).ne."0")) call abort()
      if (any(names2(:,3:5).ne."0")) call abort()
      if (names2(1,2).ne."abcde") call abort()
      if (names2(2,2).ne."0") call abort()
      if (names2(3,2).ne."fghij") call abort()
      if (names2(4,2).ne."0") call abort()
      if (names2(5,2).ne."klmno") call abort()
      if (any(names3.ne.names)) call abort()
      end