1c { dg-do run { target fd_truncate } } 2c { dg-options "-std=legacy" } 3c 4c This program tests the fixes to PR22570. 5c 6c Provided by Paul Thomas - pault@gcc.gnu.org 7c 8 program x_slash 9 character*60 a 10 character*1 b, c 11 12 open (10, status = "scratch") 13 14c Check that lines with only x-editing followed by a slash generate 15c spaces and that subsequent lines have spaces where they should. 16c Line 1 we ignore. 17c Line 2 has nothing but x editing, followed by a slash. 18c Line 3 has x editing finished off by a 1h* 19 20 write (10, 100) 21 100 format (1h1,58x,1h!,/,60x,/,59x,1h*,/) 22 rewind (10) 23 24 read (10, 200) a 25 read (10, 200) a 26 do i = 1,60 27 if (ichar(a(i:i)).ne.32) STOP 1 28 end do 29 read (10, 200) a 30 200 format (a60) 31 do i = 1,59 32 if (ichar(a(i:i)).ne.32) STOP 2 33 end do 34 if (a(60:60).ne."*") STOP 3 35 rewind (10) 36 37c Check that sequences of t- and x-editing generate the correct 38c number of spaces. 39c Line 1 we ignore. 40c Line 2 has tabs to the right of present position. 41c Line 3 has tabs to the left of present position. 42 43 write (10, 101) 44 101 format (1h1,58x,1h#,/,t38,2x,1h ,tr10,9x,1h$,/, 45 > 6habcdef,tl4,2x,6hghijkl,t1,59x,1h*) 46 rewind (10) 47 48 read (10, 200) a 49 read (10, 200) a 50 do i = 1,59 51 if (ichar(a(i:i)).ne.32) STOP 4 52 end do 53 if (a(60:60).ne."$") STOP 5 54 read (10, 200) a 55 if (a(1:10).ne."abcdghijkl") STOP 6 56 do i = 11,59 57 if (ichar(a(i:i)).ne.32) STOP 7 58 end do 59 if (a(60:60).ne."*") STOP 8 60 rewind (10) 61 62c Now repeat the first test, with the write broken up into three 63c separate statements. This checks that the position counters are 64c correctly reset for each statement. 65 66 write (10,102) "#" 67 write (10,103) 68 write (10,102) "$" 69 102 format(59x,a1) 70 103 format(60x) 71 rewind (10) 72 read (10, 200) a 73 read (10, 200) a 74 read (10, 200) a 75 do i = 11,59 76 if (ichar(a(i:i)).ne.32) STOP 9 77 end do 78 if (a(60:60).ne."$") STOP 10 79 rewind (10) 80 81c Next we check multiple read x- and t-editing. 82c First, tab to the right. 83 84 read (10, 201) b, c 85201 format (tr10,49x,a1,/,/,2x,t60,a1) 86 if ((b.ne."#").or.(c.ne."$")) STOP 11 87 rewind (10) 88 89c Now break it up into three reads and use left tabs. 90 91 read (10, 202) b 92202 format (10x,tl10,59x,a1) 93 read (10, 203) 94203 format () 95 read (10, 204) c 96204 format (10x,t5,55x,a1) 97 if ((b.ne."#").or.(c.ne."$")) STOP 12 98 close (10) 99 100c Now, check that trailing spaces are not transmitted when we have 101c run out of data (Thanks to Jack Howarth for finding this one: 102c http://gcc.gnu.org/ml/fortran/2005-07/msg00395.html). 103 104 open (10, pad = "no", status = "scratch") 105 b = achar (0) 106 write (10, 105) 42 107 105 format (i10,1x,i10) 108 write (10, 106) 109 106 format ("============================") 110 rewind (10) 111 read (10, 205, iostat = ier) i, b 112 205 format (i10,a1) 113 if ((ier.eq.0).or.(ichar(b).ne.0)) STOP 13 114 115c That's all for now, folks! 116 117 end 118 119