public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
* [patch, libfortran] PR33253 namelist: reading back a string with  apostrophe
@ 2007-09-03 19:01 Jerry DeLisle
  2007-09-03 19:12 ` Steve Kargl
  2007-09-04  9:43 ` Tobias Burnus
  0 siblings, 2 replies; 10+ messages in thread
From: Jerry DeLisle @ 2007-09-03 19:01 UTC (permalink / raw)
  To: Fortran List; +Cc: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 879 bytes --]

:ADDPATCH fortran:

Hi all,

The title of this PR is a bit misleading.  The failure occurs with a string 
without the apostrophe as well.  The problem here is that when reading a string, 
we look at the first character and see if it is a delimiter ' or " .  If not we 
would skip out and not read the rest of the string.

This patch fixes this by not doing this bail out unless a specific delimiter was 
specified in the OPEN statement, otherwise, read_character proceeds to read the 
string until it finds a valid separator.

Minor tweaks to namelist_15.f90 and namelist_24.f90 are required. New test case 
attached.

Regression tested on x86-64-gnu-linux.

OK for trunk?

Regards,

Jerry

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

	PR libfortran/33253
	* io/list_read.c (read_character): Use DELIM_APOSTROPHE and DELIM_QUOTE
	in check of first character in string.



[-- Attachment #2: pr33253.diff --]
[-- Type: text/x-patch, Size: 1665 bytes --]

Index: libgfortran/io/list_read.c
===================================================================
--- libgfortran/io/list_read.c	(revision 128052)
+++ libgfortran/io/list_read.c	(working copy)
@@ -887,7 +887,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;
Index: gcc/testsuite/gfortran.dg/namelist_15.f90
===================================================================
--- gcc/testsuite/gfortran.dg/namelist_15.f90	(revision 128052)
+++ gcc/testsuite/gfortran.dg/namelist_15.f90	(working copy)
@@ -20,7 +20,7 @@ program namelist_15
 
   namelist /mynml/ x
 
-  open (10, status = "scratch")
+  open (10, status = "scratch", delim='apostrophe')
   write (10, '(A)') "&MYNML"
   write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg',"
   write (10, '(A)') "     4, 5, 'hh', 'ii', 'jj', 'kk',"
Index: gcc/testsuite/gfortran.dg/namelist_24.f90
===================================================================
--- gcc/testsuite/gfortran.dg/namelist_24.f90	(revision 128052)
+++ gcc/testsuite/gfortran.dg/namelist_24.f90	(working copy)
@@ -11,7 +11,7 @@
       character*(8) names2(nd,nd)
       character*(8) names3(nd,nd)
       namelist / mynml /  names, names2, names3
-      open(unit=20,status='scratch')
+      open(unit=20,status='scratch', delim='apostrophe')
       write (20, '(a)') "&MYNML"
       write (20, '(a)') "NAMES = 25*'0'"
       write (20, '(a)') "NAMES2 = 25*'0'"

[-- Attachment #3: namelist_38.f90 --]
[-- Type: text/x-fortran, Size: 415 bytes --]

! { dg-do run }
! PR33253 namelist: reading back a string
! Test case modified from that of the PR by
! Jerry DeLisle  <jvdelisle@gcc.gnu.org>
program main
  implicit none
  character(len=8) :: a
  namelist /foo/ a
  open(10, status="scratch")
  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)
end program main

^ permalink raw reply	[flat|nested] 10+ messages in thread
* [patch, libfortran] PR33253 namelist: reading back a string with  apostrophe
@ 2007-10-01  5:12 Jerry DeLisle
  2007-10-01  6:59 ` FX Coudert
  0 siblings, 1 reply; 10+ messages in thread
From: Jerry DeLisle @ 2007-10-01  5:12 UTC (permalink / raw)
  To: Fortran List; +Cc: gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1302 bytes --]

: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.

[-- Attachment #2: pr33253.diff --]
[-- Type: text/x-patch, Size: 1066 bytes --]

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;

[-- Attachment #3: namelist_38.f90 --]
[-- Type: text/x-fortran, Size: 778 bytes --]

! { 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

[-- Attachment #4: namelist_39.f90 --]
[-- Type: text/x-fortran, Size: 705 bytes --]

! { 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


[-- Attachment #5: namelist_24.f90 --]
[-- Type: text/x-fortran, Size: 1748 bytes --]

!{ 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

^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2007-10-03  0:21 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-09-03 19:01 [patch, libfortran] PR33253 namelist: reading back a string with apostrophe Jerry DeLisle
2007-09-03 19:12 ` Steve Kargl
2007-09-04  9:43 ` Tobias Burnus
2007-09-05  0:35   ` Jerry DeLisle
2007-09-05  5:32   ` Jerry DeLisle
2007-09-05  8:30     ` Tobias Burnus
2007-10-01  5:12 Jerry DeLisle
2007-10-01  6:59 ` FX Coudert
     [not found]   ` <47010739.9060204@verizon.net>
2007-10-02 23:31     ` Jerry DeLisle
2007-10-03  0:21       ` Jerry DeLisle

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).