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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [x_slash_1.f] - Blame information for rev 149

Go to most recent revision | Details | Compare with Previous | View Log


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
 

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

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [x_slash_1.f] - Blame information for rev 149