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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log


!{ dg-do run }
!{ dg-options "-std=legacy" }
!
! Test namelist error trapping.
! provided by Paul Thomas - pault@gcc.gnu.org
 
program namelist_19
  character*80 wrong, right
 
! "=" before any object name
  wrong = "&z = i = 1,2 /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! &* instead of &end for termination
  wrong = "&z i = 1,2 &xxx"
  right = "&z i = 1,2 &end"
  call test_err(wrong, right)
 
! bad data
  wrong = "&z i = 1,q /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! object name not matched
  wrong = "&z j = 1,2 /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! derived type component for intrinsic type
  wrong = "&z i%j = 1,2 /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! step other than 1 for substring qualifier
  wrong = "&z ch(1:2:2) = 'a'/"
  right = "&z ch(1:2) = 'ab' /"
  call test_err(wrong, right)
 
! qualifier for scalar
  wrong = "&z k(2) = 1 /"
  right = "&z k    = 1 /"
  call test_err(wrong, right)
 
! no '=' after object name
  wrong = "&z i   1,2 /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! repeat count too large
  wrong = "&z i = 3*2 /"
  right = "&z i = 2*2 /"
  call test_err(wrong, right)
 
! too much data
  wrong = "&z i = 1 2 3 /"
  right = "&z i = 1 2 /"
  call test_err(wrong, right)
 
! no '=' after object name
  wrong = "&z i   1,2 /"
  right = "&z i = 1,2 /"
  call test_err(wrong, right)
 
! bad number of index fields
  wrong = "&z i(1,2) = 1 /"
  right = "&z i(1)   = 1 /"
  call test_err(wrong, right)
 
! bad character in index field
  wrong = "&z i(x) = 1 /"
  right = "&z i(1) = 1 /"
  call test_err(wrong, right)
 
! null index field
  wrong = "&z i( ) = 1 /"
  right = "&z i(1) = 1 /"
  call test_err(wrong, right)
 
! null index field
  wrong = "&z i(1::)   = 1 2/"
  right = "&z i(1:2:1) = 1 2 /"
  call test_err(wrong, right)
 
! null index field
  wrong = "&z i(1:2:)  = 1 2/"
  right = "&z i(1:2:1) = 1 2 /"
  call test_err(wrong, right)
 
! index out of range
  wrong = "&z i(10) = 1 /"
  right = "&z i(1)  = 1 /"
  call test_err(wrong, right)
 
! index out of range
  wrong = "&z i(0:1) = 1 /"
  right = "&z i(1:1) = 1 /"
  call test_err(wrong, right)
 
! bad range
  wrong = "&z i(1:2:-1) = 1 2 /"
  right = "&z i(1:2: 1) = 1 2 /"
  call test_err(wrong, right)
 
! bad range
  wrong = "&z i(2:1: 1) = 1 2 /"
  right = "&z i(2:1:-1) = 1 2 /"
  call test_err(wrong, right)
 
contains
  subroutine test_err(wrong, right)
    character*80 wrong, right
    integer            :: i(2) = (/0, 0/)
    integer            :: k =0
    character*2        :: ch = "  "
    namelist /z/ i, k, ch
 
! Check that wrong namelist input gives an error
 
    open (10, status = "scratch")
    write (10, '(A)') wrong
    rewind (10)
    read (10, z, iostat = ier)
    close(10)
    if (ier == 0) call abort ()
 
! Check that right namelist input gives no error
 
    open (10, status = "scratch")
    write (10, '(A)') right
    rewind (10)
    read (10, z, iostat = ier)
    close(10)
    if (ier /= 0) call abort ()
  end subroutine test_err
 
end program namelist_19

Line No.	Rev	Author	Line
1	694	jeremybenn	`!{ dg-do run }`
2			`!{ dg-options "-std=legacy" }`
3			`!`
4			`! Test namelist error trapping.`
5			`! provided by Paul Thomas - pault@gcc.gnu.org`
6
7			`program namelist_19`
8			`character*80 wrong, right`
9
10			`! "=" before any object name`
11			`wrong = "&z = i = 1,2 /"`
12			`right = "&z i = 1,2 /"`
13			`call test_err(wrong, right)`
14
15			`! &* instead of &end for termination`
16			`wrong = "&z i = 1,2 &xxx"`
17			`right = "&z i = 1,2 &end"`
18			`call test_err(wrong, right)`
19
20			`! bad data`
21			`wrong = "&z i = 1,q /"`
22			`right = "&z i = 1,2 /"`
23			`call test_err(wrong, right)`
24
25			`! object name not matched`
26			`wrong = "&z j = 1,2 /"`
27			`right = "&z i = 1,2 /"`
28			`call test_err(wrong, right)`
29
30			`! derived type component for intrinsic type`
31			`wrong = "&z i%j = 1,2 /"`
32			`right = "&z i = 1,2 /"`
33			`call test_err(wrong, right)`
34
35			`! step other than 1 for substring qualifier`
36			`wrong = "&z ch(1:2:2) = 'a'/"`
37			`right = "&z ch(1:2) = 'ab' /"`
38			`call test_err(wrong, right)`
39
40			`! qualifier for scalar`
41			`wrong = "&z k(2) = 1 /"`
42			`right = "&z k = 1 /"`
43			`call test_err(wrong, right)`
44
45			`! no '=' after object name`
46			`wrong = "&z i 1,2 /"`
47			`right = "&z i = 1,2 /"`
48			`call test_err(wrong, right)`
49
50			`! repeat count too large`
51			`wrong = "&z i = 3*2 /"`
52			`right = "&z i = 2*2 /"`
53			`call test_err(wrong, right)`
54
55			`! too much data`
56			`wrong = "&z i = 1 2 3 /"`
57			`right = "&z i = 1 2 /"`
58			`call test_err(wrong, right)`
59
60			`! no '=' after object name`
61			`wrong = "&z i 1,2 /"`
62			`right = "&z i = 1,2 /"`
63			`call test_err(wrong, right)`
64
65			`! bad number of index fields`
66			`wrong = "&z i(1,2) = 1 /"`
67			`right = "&z i(1) = 1 /"`
68			`call test_err(wrong, right)`
69
70			`! bad character in index field`
71			`wrong = "&z i(x) = 1 /"`
72			`right = "&z i(1) = 1 /"`
73			`call test_err(wrong, right)`
74
75			`! null index field`
76			`wrong = "&z i( ) = 1 /"`
77			`right = "&z i(1) = 1 /"`
78			`call test_err(wrong, right)`
79
80			`! null index field`
81			`wrong = "&z i(1::) = 1 2/"`
82			`right = "&z i(1:2:1) = 1 2 /"`
83			`call test_err(wrong, right)`
84
85			`! null index field`
86			`wrong = "&z i(1:2:) = 1 2/"`
87			`right = "&z i(1:2:1) = 1 2 /"`
88			`call test_err(wrong, right)`
89
90			`! index out of range`
91			`wrong = "&z i(10) = 1 /"`
92			`right = "&z i(1) = 1 /"`
93			`call test_err(wrong, right)`
94
95			`! index out of range`
96			`wrong = "&z i(0:1) = 1 /"`
97			`right = "&z i(1:1) = 1 /"`
98			`call test_err(wrong, right)`
99
100			`! bad range`
101			`wrong = "&z i(1:2:-1) = 1 2 /"`
102			`right = "&z i(1:2: 1) = 1 2 /"`
103			`call test_err(wrong, right)`
104
105			`! bad range`
106			`wrong = "&z i(2:1: 1) = 1 2 /"`
107			`right = "&z i(2:1:-1) = 1 2 /"`
108			`call test_err(wrong, right)`
109
110			`contains`
111			`subroutine test_err(wrong, right)`
112			`character*80 wrong, right`
113			`integer :: i(2) = (/0, 0/)`
114			`integer :: k =0`
115			`character*2 :: ch = " "`
116			`namelist /z/ i, k, ch`
117
118			`! Check that wrong namelist input gives an error`
119
120			`open (10, status = "scratch")`
121			`write (10, '(A)') wrong`
122			`rewind (10)`
123			`read (10, z, iostat = ier)`
124			`close(10)`
125			`if (ier == 0) call abort ()`
126
127			`! Check that right namelist input gives no error`
128
129			`open (10, status = "scratch")`
130			`write (10, '(A)') right`
131			`rewind (10)`
132			`read (10, z, iostat = ier)`
133			`close(10)`
134			`if (ier /= 0) call abort ()`
135			`end subroutine test_err`
136
137			`end program namelist_19`

Browse

Tools

Subversion Repositories openrisc

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