URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [x_slash_1.f] - Blame information for rev 694

Details | Compare with Previous | View Log


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
 

Line No.	Rev	Author	Line
1	694	jeremybenn	`c { dg-do run { target fd_truncate } }`
2			`c { dg-options "-std=legacy" }`
3			`c`
4			`c This program tests the fixes to PR22570.`
5			`c`
6			`c Provided by Paul Thomas - pault@gcc.gnu.org`
7			`c`
8			`program x_slash`
9			`character*60 a`
10			`character*1 b, c`
11
12			`open (10, status = "scratch")`
13
14			`c Check that lines with only x-editing followed by a slash generate`
15			`c spaces and that subsequent lines have spaces where they should.`
16			`c Line 1 we ignore.`
17			`c Line 2 has nothing but x editing, followed by a slash.`
18			`c 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) call abort ()`
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) call abort ()`
33			`end do`
34			`if (a(60:60).ne."*") call abort ()`
35			`rewind (10)`
36
37			`c Check that sequences of t- and x-editing generate the correct`
38			`c number of spaces.`
39			`c Line 1 we ignore.`
40			`c Line 2 has tabs to the right of present position.`
41			`c 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) call abort ()`
52			`end do`
53			`if (a(60:60).ne."$") call abort ()`
54			`read (10, 200) a`
55			`if (a(1:10).ne."abcdghijkl") call abort ()`
56			`do i = 11,59`
57			`if (ichar(a(i:i)).ne.32) call abort ()`
58			`end do`
59			`if (a(60:60).ne."*") call abort ()`
60			`rewind (10)`
61
62			`c Now repeat the first test, with the write broken up into three`
63			`c separate statements. This checks that the position counters are`
64			`c 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) call abort ()`
77			`end do`
78			`if (a(60:60).ne."$") call abort ()`
79			`rewind (10)`
80
81			`c Next we check multiple read x- and t-editing.`
82			`c First, tab to the right.`
83
84			`read (10, 201) b, c`
85			`201 format (tr10,49x,a1,/,/,2x,t60,a1)`
86			`if ((b.ne."#").or.(c.ne."$")) call abort ()`
87			`rewind (10)`
88
89			`c Now break it up into three reads and use left tabs.`
90
91			`read (10, 202) b`
92			`202 format (10x,tl10,59x,a1)`
93			`read (10, 203)`
94			`203 format ()`
95			`read (10, 204) c`
96			`204 format (10x,t5,55x,a1)`
97			`if ((b.ne."#").or.(c.ne."$")) call abort ()`
98			`close (10)`
99
100			`c Now, check that trailing spaces are not transmitted when we have`
101			`c run out of data (Thanks to Jack Howarth for finding this one:`
102			`c 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)) call abort ()`
114
115			`c That's all for now, folks!`
116
117			`end`
118

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [x_slash_1.f] - Blame information for rev 694