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]

[Patch, libgfortran] PR16435 and NIST fm908.for


This patch fixes two patches that were sufficiently interwoven as to warrant fixing together.

The first is that described in PR16435 for which there is already an XFAIL testcase, f77-edit-x-out.f. Here the problem was that trailing spaces were output if a formatted write terminated with X or T-editting.

The bug triggered by fm908.for, which is awaiting the fix for internal io to arrays to be 100% successful, is due to spaces being written over already output data if a left tab was followed by a right tab. The enclosed testcase illustrates what I mean.

The patches, ChangeLog entries and the testcase are attached.

Whitespace differences have been suppressed because I took the opportunity to clean up transfer.c a bit.

(Tobi, Before you point out the potential use of MAX, I need to find out why MIN does not work in the previous patch. Do these macros have side-effects? Take it as read, that if I figure out the problem, I will use both!)

Regtested on RH9/Athlon

=== gfortran Summary ===

# of expected passes            8036
# of unexpected successes       8    << g77/f77-edit-x-out.f
# of expected failures          9
# of unsupported tests          8

OK for 4.1 and 4.1?

Paul T


2005-07-12 Paul Thomas  <pault@gcc.gnu.org>

	* transfer.c (formatted_transfer): Correct the problems
	with X- and T-editting that caused TLs followed by TRs
	to overwrite data, which caused NIST FM908.FOR to fail
	on many tests.
	(st_read, st_write) Zero X- and T-editting counters at
	the strat of formatted IO.
	* write.c (write_x) Write specified number of skips with
	specified number of spaces at the end.

2005-07-12  Paul Thomas  <pault@gcc.gnu.org>

	* gfortran.dg/tl_editting.f90: New.


Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.47
diff -w -c -3 -p -r1.47 transfer.c
*** gcc/libgfortran/io/transfer.c	7 Jul 2005 07:54:57 -0000	1.47
--- gcc/libgfortran/io/transfer.c	12 Jul 2005 15:43:15 -0000
*************** gfc_unit *current_unit = NULL;
*** 82,87 ****
--- 82,94 ----
  static int sf_seen_eor = 0;
  static int eor_condition = 0;
  
+ /* Maximum righthand column written to.  */
+ static int max_pos;
+ /* Number of skips + spaces to be done for T and X-editting.  */
+ static int skips;
+ /* Number of spaces to be done for T and X-editting.  */
+ static int pending_spaces;
+ 
  char scratch[SCRATCH_SIZE];
  static char *line_buffer = NULL;
  
*************** require_type (bt expected, bt actual, fn
*** 437,444 ****
  static void
  formatted_transfer (bt type, void *p, int len)
  {
!   int pos ,m ;
    fnode *f;
    int n;
    int consume_data_flag;
  
--- 444,452 ----
  static void
  formatted_transfer (bt type, void *p, int len)
  {
!   int pos;
    fnode *f;
+   format_token t;
    int n;
    int consume_data_flag;
  
*************** formatted_transfer (bt type, void *p, in
*** 471,477 ****
        if (f == NULL)
  	return;		/* No data descriptors left (already raised).  */
  
!       switch (f->format)
  	{
  	case FMT_I:
  	  if (n == 0)
--- 479,499 ----
        if (f == NULL)
  	return;	      /* No data descriptors left (already raised).  */
  
!       /* Now discharge T, TR and X movements to the right.  This is delayed
! 	 until a data producing format to supress trailing spaces.  */
!       t = f->format;
!       if (g.mode == WRITING && skips > 0
! 	&&    (t == FMT_I || t == FMT_B || t == FMT_O || t == FMT_Z
! 	    || t == FMT_F || t == FMT_E || t == FMT_EN || t == FMT_ES
! 	    || t == FMT_G || t == FMT_L || t == FMT_A || t == FMT_D
! 	    || t == FMT_STRING))
! 	{
! 	  write_x (skips, pending_spaces);
! 	  max_pos = current_unit->recl - current_unit->bytes_left;
! 	  skips = pending_spaces = 0;
! 	}
! 
!       switch (t)
  	{
  	case FMT_I:
  	  if (n == 0)
*************** formatted_transfer (bt type, void *p, in
*** 664,673 ****
  	case FMT_X:
  	case FMT_TR:
            consume_data_flag = 0 ;
  	  if (g.mode == READING)
  	    read_x (f);
- 	  else
- 	    write_x (f);
  
  	  break;
  
--- 686,700 ----
  	case FMT_X:
  	case FMT_TR:
  	  consume_data_flag = 0 ;
+ 
+ 	  pos = current_unit->recl - current_unit->bytes_left + f->u.n;
+ 	  skips = f->u.n;
+ 	  pending_spaces = pos - max_pos;
+ 
+ 	  /* Writes occur just before the switch on f->format, above, so that
+ 	     trailing blanks are suppressed.  */
  	  if (g.mode == READING)
  	    read_x (f);
  
  	  break;
  
*************** formatted_transfer (bt type, void *p, in
*** 681,708 ****
                 pos = f->u.n - 1;
               }
  
!            if (pos < 0 || pos >= current_unit->recl )
!              {
!                generate_error (ERROR_EOR, "T or TL edit position error");
!                break ;
!              }
!             m = pos - (current_unit->recl - current_unit->bytes_left);
  
!             if (m == 0)
                 break;
  
!             if (m > 0)
               {
-                f->u.n = m;
                 if (g.mode == READING)
                   read_x (f);
-                else
-                  write_x (f);
               }
!             if (m < 0)
               {
!                move_pos_offset (current_unit->s,m);
! 	       current_unit->bytes_left -= m;
               }
  
  	  break;
--- 708,740 ----
  	      pos = f->u.n - 1;
  	    }
  
! 	  /* Standard 10.6.1.1: excessive left tabbing is reset to the
! 	     left tab limit.  We do not check if the position has gone
! 	     beyond the end of record because a subsequent tab could
! 	     bring us back again.  */
! 	  pos = pos < 0 ? 0 : pos;
! 
! 	  skips = skips + pos - (current_unit->recl - current_unit->bytes_left);
! 	  pending_spaces =  pending_spaces + pos - max_pos;
  
! 	  if (skips == 0)
  	    break;
  
! 	  /* Writes occur just before the switch on f->format, above, so that
! 	     trailing blanks are suppressed.  */
! 	  if (skips > 0)
  	    {
  	      if (g.mode == READING)
+ 		{
+ 		  f->u.n = skips;
  		  read_x (f);
  		}
! 	    }
! 	  if (skips < 0)
  	    {
! 	      move_pos_offset (current_unit->s, skips);
! 	      current_unit->bytes_left -= skips;
! 	      skips = pending_spaces = 0;
  	    }
  
  	  break;
*************** formatted_transfer (bt type, void *p, in
*** 778,783 ****
--- 810,821 ----
  	n--;
  	p = ((char *) p) + len;
        }
+ 
+       if (g.mode == READING)
+ 	skips = 0;
+ 
+       pos = current_unit->recl - current_unit->bytes_left;
+       max_pos = (max_pos > pos) ? max_pos : pos;
      }
  
    return;
*************** export_proto(st_read);
*** 1537,1542 ****
--- 1575,1584 ----
  void
  st_read (void)
  {
+ 
+   /* Reset counters for T and X-editting.  */
+   max_pos = skips = pending_spaces = 0;
+ 
    library_start ();
  
    data_transfer_init (1);
*************** export_proto(st_write);
*** 1582,1587 ****
--- 1624,1633 ----
  void
  st_write (void)
  {
+ 
+   /* Reset counters for T and X-editting.  */
+   max_pos = skips = pending_spaces = 0;
+ 
    library_start ();
    data_transfer_init (0);
  }

Index: gcc/libgfortran/io/write.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/write.c,v
retrieving revision 1.39
diff -w -c -3 -p -r1.39 write.c
*** gcc/libgfortran/io/write.c	23 Jun 2005 18:50:24 -0000	1.39
--- gcc/libgfortran/io/write.c	12 Jul 2005 15:45:08 -0000
*************** write_es (fnode *f, const char *p, int l
*** 1076,1090 ****
  /* Take care of the X/TR descriptor.  */
  
  void
! write_x (fnode * f)
  {
    char *p;
  
!   p = write_block (f->u.n);
    if (p == NULL)
      return;
  
!   memset (p, ' ', f->u.n);
  }
  
  
--- 1076,1091 ----
  /* Take care of the X/TR descriptor.  */
  
  void
! write_x (int m, int nspaces)
  {
    char *p;
  
!   p = write_block (m);
    if (p == NULL)
      return;
  
!   if (nspaces > 0)
!     memset ((char*)(p + m - nspaces), ' ', nspaces);
  }
  
  

====================================================================

Testsuite contribution

! { dg-do run }     
! Test of fix to bug triggered by NIST fm908.for.
! Left tabbing, followed by X or T-tabbing to the right would
! cause spaces to be overwritten on output data.
! Contributed by Paul Thomas  <pault@gcc.gnu.org>
  program tl_editting
    character*10           ::  line
    character*10           ::  aline = "abcdefxyij"
    character*2            ::  bline = "gh"
    character*10           ::  cline = "abcdefghij"
    write (line, '(a10,tl6,2x,a2)') aline, bline
    if (line.ne.cline) call abort ()
  end program tl_editting

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