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/] [namelist_19.f90] - Blame information for rev 237

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


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

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [namelist_19.f90] - Blame information for rev 237