PR fortran/22570 and related issues.

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

	PR fortran/22570 and related issues.
	* transfer.c (formatted_transfer): Make sure that there
	really is data present before X- or T- editing. Move all
	treatment of tabbing during writes to start of next data
	producing format. Suppress incorrect zeroing of bytes_left
	in slash formating. Insert int cast for assignment of a
	difference of two gfc_offsets.

	PR fortran/22570 an related issues.
	* gfortran.dg/x_slash_1.f: New test.

From-SVN: r102583

gcc/testsuite/ChangeLog

+2005-07-30 Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22570 an related issues.
+	* gfortran.dg/x_slash_1.f: New test.
+
 2005-07-30  Joseph S. Myers  <joseph@codesourcery.com>
 
 	PR c/23143

gcc/testsuite/gfortran.dg/x_slash_1.f

+c { dg-do run }
+c This program tests the fixes to PR22570.
+c
+c Provided by Paul Thomas - pault@gcc.gnu.org
+c
+       program x_slash
+       character*60 a
+       character*1  b, c
+
+       open (10, status = "scratch")
+
+c Check that lines with only x-editing followed by a slash generate
+c spaces and that subsequent lines have spaces where they should.
+c Line 1 we ignore.
+c Line 2 has nothing but x editing, followed by a slash.
+c Line 3 has x editing finished off by a 1h*
+
+       write (10, 100)
+ 100   format (1h1,58x,1h!,/,60x,/,59x,1h*,/)
+       rewind (10)
+
+       read (10, 200) a
+       read (10, 200) a
+       do i = 1,60
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       read (10, 200) a
+ 200   format (a60)
+       do i = 1,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."*") call abort ()
+       rewind (10)
+
+c Check that sequences of t- and x-editing generate the correct 
+c number of spaces.
+c Line 1 we ignore.
+c Line 2 has tabs to the right of present position.
+c Line 3 has tabs to the left of present position.
+
+       write (10, 101)
+ 101   format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/,
+     >         6habcdef,tl4,2x,6hghijkl,t1,59x,1h*)
+       rewind (10)
+
+       read (10, 200) a
+       read (10, 200) a
+       do i = 1,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."$") call abort ()
+       read (10, 200) a
+       if (a(1:10).ne."abcdghijkl") call abort ()
+       do i = 11,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."*") call abort ()
+       rewind (10)
+
+c Now repeat the first test, with the write broken up into three
+c separate statements. This checks that the position counters are
+c correctly reset for each statement.
+
+       write (10,102) "#"
+       write (10,103)
+       write (10,102) "$"
+ 102   format(59x,a1)
+ 103   format(60x)
+       rewind (10)
+       read (10, 200) a
+       read (10, 200) a
+       read (10, 200) a
+       do i = 11,59
+         if (ichar(a(i:i)).ne.32) call abort ()
+       end do
+       if (a(60:60).ne."$") call abort ()
+       rewind (10)
+
+c Next we check multiple read x- and t-editing.
+c First, tab to the right.
+
+       read (10, 201) b, c
+201    format (tr10,49x,a1,/,/,2x,t60,a1)
+       if ((b.ne."#").or.(c.ne."$")) call abort ()
+       rewind (10)
+
+c Now break it up into three reads and use left tabs.
+
+       read (10, 202) b
+202    format (10x,tl10,59x,a1)
+       read (10, 203)
+203    format ()
+       read (10, 204) c
+204    format (10x,t5,55x,a1)
+       if ((b.ne."#").or.(c.ne."$")) call abort ()
+       close (10)
+
+c Now, check that trailing spaces are not transmitted when we have
+c run out of data (Thanks to Jack Howarth for finding this one:
+c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html).
+
+       open (10, pad = "no", status = "scratch")
+       b = achar (0)
+       write (10, 105) 42
+  105  format (i10,1x,i10)
+       write (10, 106)
+  106  format ("============================")
+       rewind (10)
+       read (10, 205, iostat = ier) i, b
+  205  format (i10,a1)
+       if ((ier.eq.0).or.(ichar(b).ne.0)) call abort ()
+
+c That's all for now, folks! 
+
+       end
+

libgfortran/ChangeLog

+2005-07-30 Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/22570 and related issues.
+	* transfer.c (formatted_transfer): Make sure that there
+	really is data present before X- or T- editing. Move all
+	treatment of tabbing during writes to start of next data
+	producing format. Suppress incorrect zeroing of bytes_left
+	in slash formating. Insert int cast for assignment of a
+	difference of two gfc_offsets.
+
 2005-07-23  Jerry DeLisle  <jvdelisle@verizon.net>
 
 	* io/write.c (write_float): Revise output of IEEE exceptional

libgfortran/io/transfer.c

@@ -480,16 +480,25 @@ formatted_transfer (bt type, void *p, int len)
 	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.  */
+	 until a data producing format to suppress 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
+      if (g.mode == WRITING && skips != 0
+	&& ((n>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 = (int)(current_unit->recl - current_unit->bytes_left);
+	  if (skips > 0)
+	    {
+	      write_x (skips, pending_spaces);
+	      max_pos = (int)(current_unit->recl - current_unit->bytes_left);
+	    }
+	  if (skips < 0)
+	    {
+	      move_pos_offset (current_unit->s, skips);
+	      current_unit->bytes_left -= (gfc_offset)skips;
+	    }
 	  skips = pending_spaces = 0;
 	}
 
@@ -724,19 +733,19 @@ formatted_transfer (bt type, void *p, int len)
 
 	  /* Writes occur just before the switch on f->format, above, so that
 	     trailing blanks are suppressed.  */
-	  if (skips > 0)
+	  if (g.mode == READING)
 	    {
-	      if (g.mode == READING)
+	      if (skips > 0)
 		{
 		  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;
+	      if (skips < 0)
+		{
+		  move_pos_offset (current_unit->s, skips);
+		  current_unit->bytes_left -= (gfc_offset)skips;
+		  skips = pending_spaces = 0;
+		}
 	    }
 
 	  break;
@@ -779,7 +788,6 @@ formatted_transfer (bt type, void *p, int len)
 	case FMT_SLASH:
 	  consume_data_flag = 0 ;
 	  skips = pending_spaces = 0;
-	  current_unit->bytes_left = 0;
 	  next_record (0);
 	  break;
 
@@ -818,7 +826,7 @@ formatted_transfer (bt type, void *p, int len)
       if (g.mode == READING)
 	skips = 0;
 
-      pos = current_unit->recl - current_unit->bytes_left;
+      pos = (int)(current_unit->recl - current_unit->bytes_left);
       max_pos = (max_pos > pos) ? max_pos : pos;
 
     }