This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

gfortran patch for pr19314 - segfault on INQUIRE(POSITION=)


POSITION= was not implemented, correctly.


tested with no additional testsuite failures on 
AMD-64 / linux-gnu and i686/ linux-gnu.

no change to the NIST F77 tests.

a test suite file is provided that fails prior 
and passes after this patch is applied. The test
checks all of the possible outcomes of INQUIRE(POSITION=.

this is not a g77 regression, but IMHO is the kind of bug
fix that should still go in prior to gcc-4.0 (small change,
corrects a segfault at runtime)


--bud


2005-01-17  Bud Davis  <bdavis9659@comcast.net>

	PR fortran/19314
	* io/inquire.c(inquire_via_unit): implement POSITION=.
	* io/transfer.c(next_record): update position for
	INQUIRE.
	* io/rewind.c(st_rewind): update position for
	INQUIRE.

Index: gcc/libgfortran/io/inquire.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/inquire.c,v
retrieving revision 1.7
diff -c -3 -p -r1.7 inquire.c
*** gcc/libgfortran/io/inquire.c	12 Jan 2005 21:27:31 -0000	1.7
--- gcc/libgfortran/io/inquire.c	17 Jan 2005 04:02:11 -0000
*************** inquire_via_unit (gfc_unit * u)
*** 166,178 ****
    if (ioparm.position != NULL)
      {
        if (u == NULL || u->flags.access == ACCESS_DIRECT)
! 	p = undefined;
        else
! 	{
! 	  p = NULL;		/* TODO: Try to decode what the standard says... */
! 	}
! 
!       cf_strcpy (ioparm.blank, ioparm.blank_len, p);
      }
  
    if (ioparm.action != NULL)
--- 166,192 ----
    if (ioparm.position != NULL)
      {
        if (u == NULL || u->flags.access == ACCESS_DIRECT)
!         p = undefined;
        else
!         switch (u->flags.position)
!           {
!              case POSITION_REWIND:
!                p = "REWIND";
!                break;
!              case POSITION_APPEND:
!                p = "APPEND";
!                break;
!              case POSITION_ASIS:
!                p = "ASIS";
!                break;
!              default:
!                /* if not direct access, it must be
!                   either REWIND, APPEND, or ASIS.
!                   ASIS seems to be the best default */
!                p = "ASIS";
!                break;
!           }
!       cf_strcpy (ioparm.position, ioparm.position_len, p);
      }
  
    if (ioparm.action != NULL)
Index: gcc/libgfortran/io/rewind.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/rewind.c,v
retrieving revision 1.8
diff -c -3 -p -r1.8 rewind.c
*** gcc/libgfortran/io/rewind.c	12 Jan 2005 21:27:31 -0000	1.8
--- gcc/libgfortran/io/rewind.c	17 Jan 2005 04:02:11 -0000
*************** st_rewind (void)
*** 66,71 ****
--- 66,73 ----
  	  u->current_record = 0;
  	  test_endfile (u);
  	}
+       /* update position for INQUIRE */
+       u->flags.position = POSITION_REWIND;
      }
  
    library_end ();
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.27
diff -c -3 -p -r1.27 transfer.c
*** gcc/libgfortran/io/transfer.c	16 Jan 2005 20:44:01 -0000	1.27
--- gcc/libgfortran/io/transfer.c	17 Jan 2005 04:02:12 -0000
*************** next_record (int done)
*** 1363,1368 ****
--- 1363,1371 ----
    else
      next_record_w (done);
  
+   /* keep position up to date for INQUIRE */
+   current_unit->flags.position = POSITION_ASIS;
+ 
    current_unit->current_record = 0;
    if (current_unit->flags.access == ACCESS_DIRECT)
     {



! pr19314 inquire(..position=..) segfaults
! test by Thomas.Koenig@online.de
!         bdavis9659@comcast.net
      implicit none
      character*20 chr
      logical debug
      data debug /.FALSE./
      open(7,STATUS='SCRATCH')
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'ASIS') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'ASIS') CALL ABORT
      endif
      close(7)
      open(7,STATUS='SCRATCH',ACCESS='DIRECT',RECL=100)
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'UNDEFINED') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'UNDEFINED') CALL ABORT
      endif
      close(7)
      open(7,STATUS='SCRATCH',POSITION='REWIND')
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'REWIND') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'REWIND') CALL ABORT
      endif
      close(7)
      open(7,STATUS='SCRATCH',POSITION='ASIS')
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'ASIS') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'ASIS') CALL ABORT
      endif
      close(7)
      open(7,STATUS='SCRATCH',POSITION='APPEND')
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'APPEND') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'APPEND') CALL ABORT
      endif
      close(7)
      open(7,STATUS='SCRATCH',POSITION='REWIND')
      write(7,*)'this is a record written to the file'
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'ASIS') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'ASIS') CALL ABORT
      endif
      rewind(7)
      inquire(7,position=chr)
      if (debug) then
         if (chr.EQ.'REWIND') then
           print*,chr,'OK'
         else
           print*,chr,'NOTOK'
         endif
      else
         if (chr.NE.'REWIND') CALL ABORT
      endif
      close(7)
      end






Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]