gcc/testsuite/gfortran.dg/namelist_22.f90

   1 !{ dg-do run { target fd_truncate } }
   2 !{ dg-options "-std=legacy" }
   3 !
   4 ! Tests filling arrays from a namelist read when object list is not complete.
   5 ! This is the same as namelist_21.f90 except using spaces as seperators instead
   6 ! of commas. Developed from a test case provided by Christoph Jacob.
   7 ! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
   8 program pr24794
   9
  10    implicit none
  11    integer, parameter :: maxop=15, iunit=7
  12    character*8 namea(maxop), nameb(maxop)
  13    integer i, ier
  14
  15    namelist/ccsopr/ namea,nameb
  16    namea=""
  17    nameb=""
  18    open (12, status="scratch", delim="apostrophe")
  19    write (12, '(a)') "&ccsopr"
  20    write (12, '(a)') "    namea='spi01h' 'spi02o' 'spi03h' 'spi04o' 'spi05h'"
  21    write (12, '(a)') "          'spi07o' 'spi08h' 'spi09h'"
  22    write (12, '(a)') "    nameb='spi01h' 'spi03h' 'spi05h' 'spi06h' 'spi08h'"
  23    write (12, '(a)') "&end"
  24
  25    rewind (12)
  26    read (12, nml=ccsopr, iostat=ier)
  27    if (ier.ne.0) STOP 1
  28
  29    rewind (12)
  30    write(12,nml=ccsopr)
  31
  32    rewind (12)
  33    read (12, nml=ccsopr, iostat=ier)
  34    if (ier.ne.0) STOP 2
  35    if (namea(2).ne."spi02o  ") STOP 3
  36    if (namea(9).ne."        ") STOP 4
  37    if (namea(15).ne."        ") STOP 5
  38    if (nameb(1).ne."spi01h  ") STOP 6
  39    if (nameb(6).ne."        ") STOP 7
  40    if (nameb(15).ne."        ") STOP 8
  41
  42    close (12)
  43 end program pr24794