1! { dg-do run }
2! { dg-options "-std=legacy" }
3!
4! This tests the fix for PR22010, where namelists were not being written to
5! and read back from modules.  It checks that namelists from modules that are
6! selected by an ONLY declaration work correctly, even when the variables in
7! the namelist are not host associated. Note that renaming a namelist by USE
8! association is not allowed by the standard and this is trapped in module.c.
9!
10! Contributed by Paul Thomas  pault@gcc.gnu.org
11!
12module global
13  character*4 :: aa, aaa
14  integer :: ii, iii
15  real    :: rr, rrr
16  namelist /nml1/ aa, ii, rr
17  namelist /nml2/ aaa, iii, rrr
18contains
19  logical function foo()
20    foo = (aaa.ne."pqrs").or.(iii.ne.2).or.(rrr.ne.3.5)
21  end function foo
22end module global
23program namelist_use_only
24  use global, only : nml1, aa, ii, rr
25  use global, only : nml2, rrrr=>rrr, foo
26  open (10, status="scratch")
27  write (10,'(a)') "&NML1 aa='lmno' ii=1 rr=2.5 /"
28  write (10,'(a)') "&NML2 aaa='pqrs' iii=2 rrr=3.5 /"
29  rewind (10)
30  read (10,nml=nml1,iostat=i)
31  if ((i.ne.0).or.(aa.ne."lmno").or.(ii.ne.1).or.(rr.ne.2.5)) call abort ()
32
33  read (10,nml=nml2,iostat=i)
34  if ((i.ne.0).or.(rrrr.ne.3.5).or.foo()) call abort ()
35  close (10)
36end program namelist_use_only
37