1! { dg-do compile }
2! { dg-options "-std=f95" }
3! Part II of the test  of the IO constraints patch, which fixes PRs:
4! PRs 25053, 25063, 25064, 25066, 25067, 25068, 25069, 25307 and 20862.
5! Modified2006-07-08 to check the patch for PR20844.
6!
7! Contributed by Paul Thomas  <pault@gcc.gnu.org>
8!
9
10module global
11
12  integer :: modvar
13  namelist /NL/ modvar
14
15contains
16
17  subroutine foo (i)
18    integer :: i
19    write (*, 100) i
20 100 format (1h , "i=", i6) ! { dg-warning "H format specifier" }
21  end subroutine foo
22
23end module global
24
25 use global
26 integer :: a,b, c(20)
27 integer(8) :: ierr
28 character(80) :: buffer(3)
29
30
31! Appending to a USE associated namelist is an extension.
32
33 NAMELIST /NL/ a,b                              ! { dg-error "already is USE associated" }
34
35 a=1 ; b=2
36
37 write(*, NML=NL) z                             !  { dg-error "followed by IO-list" }
38!Was correctly picked up before patch.
39 print NL, z                                    !  { dg-error "PRINT namelist at \\(1\\) is an extension" }
40!
41! Not allowed with internal unit
42!Was correctly picked up before patch.
43 write(buffer, NML=NL)                          !  { dg-error "Internal file at \\(1\\) with namelist" }
44!Was correctly picked up before patch.
45 write(buffer, fmt='(i6)', REC=10) a            !  { dg-error "REC tag" }
46 write(buffer, fmt='(i6)', END=10) a            !  { dg-error "END tag" }
47
48! Not allowed with REC= specifier
49!Was correctly picked up before patch.
50 read(10, REC=10, END=100)                      !  { dg-error "END tag is not allowed" }
51 write(*, *, REC=10)                            !  { dg-error "FMT=" }
52
53! Not allowed with an ADVANCE=specifier
54 READ(buffer, fmt='(i6)', advance='YES') a      ! { dg-error "internal file" }
55 READ(1, NML=NL, advance='YES')                 ! { dg-error "NAMELIST IO is not allowed" }
56
57 READ(1, fmt='(i6)', advance='NO', size = ierr) ! { dg-error "requires default INTEGER" }
58
59 READ(1, advance='YES')                         ! { dg-error "must appear with an explicit format" }
60
61 write(1, fmt='(i6)', advance='YES', size = c(1)) a ! { dg-error "output" }
62 write(1, fmt='(i6)', advance='YES', eor = 100) a   ! { dg-error "output" }
63
64 read(1, fmt='(i6)', advance='YES', size = c(1)) a  ! { dg-error "ADVANCE = 'NO'" }
65 read(1, fmt='(i6)', advance='YES', eor = 100) a    ! { dg-error "ADVANCE = 'NO'" }
66
67 READ(1, fmt='(i6)', advance='NO', size = buffer) a ! { dg-error "INTEGER" }
68!Was correctly picked up before patch. -correct syntax error
69 READ(1, fmt='(i6)', advance='YES', size = 10) a    ! { dg-error "Invalid value for SIZE specification" }
70
71 READ(1, fmt='(i6)', advance='MAYBE')               !  { dg-error "YES or NO" }
72
73100 continue
74200 format (2i6)
75 END
76