c { dg-do run { target fd_truncate } } c { dg-options "-std=legacy" } c 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