gcc/testsuite/gfortran.dg/namelist_37.f90

   1 ! { dg-do run }
   2 ! { dg-options "-std=legacy" }
   3 !
   4 ! PR33039 Read NAMELIST:  reads wrong namelist name
   5 ! Test case from PR modified by Jerry DeLisle <jvdelisle@gcc.gnu.org>
   6 PROGRAM namelist
   7 CHARACTER*25 CHAR
   8 NAMELIST /CODE/ CHAR, X
   9 NAMELIST /CODEtwo/ X
  10
  11 OPEN(10, status="scratch")
  12 write(10,'(a)') "File with test NAMELIST inputs"
  13 write(10,'(a)') " &CODVJS  char='VJS-Not a proper nml name', X=-0.5/"
  14 write(10,'(a)') " &CODEone char='CODEone input', X=-1.0 /"
  15 write(10,'(a)') " &CODEtwo char='CODEtwo inputs', X=-2.0/"
  16 write(10,'(a)') " &code    char='Lower case name',X=-3.0/"
  17 write(10,'(a)') " &CODE    char='Desired namelist sel', X=44./"
  18 write(10,'(a)') " &CODEx   char='Should not read CODEx nml', X=-5./"
  19 write(10,'(a)') " $CODE    char='Second desired nml', X=66.0 /"
  20 write(10,'(a)') " $CODE    X=77.0, char='Reordered desired nml'/"
  21 rewind(10)
  22 CHAR = 'Initialize string ***'
  23 X    = -777.
  24 READ(10, nml=CODE, END=999)
  25 if (x.ne.-3.0) call abort
  26 READ(10, nml=CODE, END=999)
  27 if (x.ne.44.0) call abort
  28 READ(10, nml=CODE, END=999)
  29 if (x.ne.66.0) call abort
  30 READ(10, nml=CODE, END=999)
  31  999 if (x.ne.77.0) call abort
  32 END PROGRAM namelist