1! { dg-do run }
2! { dg-add-options ieee }
3!
4! PR fortran/56743
5!
6! Contributed by Kai Gallmeister
7!
8! Note that Fortran 2008 (Section 10.11.3.6) requires that there is
9! a value separator between the value and the "!".  Thus, all examples
10! in this file are invalid; they should either be accepted as vendor
11! extension or lead to a run-time error (iostat /=0).
12!
13! For the c1 and c2 character example, please note that the Fortran
14! standard (F2008, 10.11.3.3) requires delimiters; accepting
15! a single word (in spirit of list-directed I/O) would be possible
16! as vendor extension. But the current run-time failure is fine as well.
17!
18! Note: After fixing this, warning or error is given with -pedantic -std=xxx
19implicit none
20integer :: i = -1
21real :: r1 = -2
22real :: r2 = -3
23real :: r3 = -4
24real :: r4 = -5
25real :: r5 = -6
26complex :: c = (-7,-7)
27logical :: ll = .false.
28character :: c1 = 'X'
29character(3) :: c2 = 'YYY'
30character(3) :: c3 = 'ZZZ'
31namelist /nml/ i, r1,r2,r3,r4,r5,c,ll,c1,c2,c3
32
33open (99, file='nml_87.dat', status="replace")
34write(99,*) "&nml"
35write(99,*) "  i=42!11"         ! Fixed BUG: wrong result: Unmodified, no error
36write(99,*) "  r1=43!11"        ! Fixed BUG: wrong result: Unmodified, no error
37write(99,*) "  r2=43.!11"       ! Fixed BUG: wrong result: Unmodified, no error
38write(99,*) "  r3=inf!11"       ! OK:  run-time error (Cannot match namelist object)
39write(99,*) "  r4=NaN(0x33)!11" ! OK:  run-time error (Cannot match namelist object)
40write(99,*) "  r5=3.e5!11"      ! Fixed BUG: wrong result: Unmodified, no error
41write(99,*) "  c=(4,2)!11"      ! OK:  value accepted as vendor extension
42write(99,*) "  ll=.true.!11"    ! OK:  value accepted as vendor extension
43write(99,*) "  c1='a'!11"       ! OK:  without quotes, run-time error (Cannot match namelist object)
44write(99,*) "  c2='bc'!11"      ! OK:  without quotes, run-time error (Cannot match namelist object)
45write(99,*) "  c3='ax'!11"      ! OK:  without quotes, run-time error (Cannot match namelist object)
46write(99,*) "/"
47
48rewind(99)
49read (99, nml=nml)
50!write (*, nml=nml)
51close (99, status="delete")
52
53  if (r1 /= 43) STOP 1
54  if (r2 /= 43) STOP 2
55  if (r3 /= r3 .or. r3 <= huge(r3)) STOP 3
56  if (r4 == r4) STOP 4
57  if (r5 /= 300000) STOP 5
58  if (c /= cmplx(4,2)) STOP 6
59  if (.not. ll) STOP 7
60  if (c1 /= "a") STOP 8
61  if (c2 /= "bc") STOP 9
62  if (c3 /= "ax") STOP 10
63end
64