gcc/testsuite/gfortran.dg/namelist_24.f90

   1 !{ dg-do run { target fd_truncate } }
   2 !{ dg-options -std=gnu }
   3 ! Tests namelist read when more data is provided then specified by
   4 ! array qualifier in list.
   5 ! Contributed by Jerry DeLisle  <jvdelisle@gcc.gnu.org>.
   6       program pr24459
   7       implicit none
   8       integer nd, ier, i, j
   9       parameter ( nd = 5 )
  10       character*(8) names(nd,nd)
  11       character*(8) names2(nd,nd)
  12       character*(8) names3(nd,nd)
  13       namelist / mynml /  names, names2, names3
  14       open(unit=20,status='scratch', delim='apostrophe')
  15       write (20, '(a)') "&MYNML"
  16       write (20, '(a)') "NAMES = 25*'0'"
  17       write (20, '(a)') "NAMES2 = 25*'0'"
  18       write (20, '(a)') "NAMES3 = 25*'0'"
  19       write (20, '(a)') "NAMES(2,2) = 'frogger'"
  20       write (20, '(a)') "NAMES(1,1) = 'E123' 'E456' 'D789' 'P135' 'P246'"
  21       write (20, '(a)') "NAMES2(1:5:2,2) = 'abcde' 'fghij' 'klmno'"
  22       write (20, '(a)') "NAMES3 = 'E123' 'E456' 'D789' 'P135' 'P246' '0' 'frogger'"
  23       write (20, '(a)') "/"
  24       rewind(20)
  25       read(20,nml=mynml, iostat=ier)
  26       if (ier.ne.0) call abort()
  27       if (any(names(:,3:5).ne."0")) call abort()
  28       if (names(2,2).ne."frogger") call abort()
  29       if (names(1,1).ne."E123") call abort()
  30       if (names(2,1).ne."E456") call abort()
  31       if (names(3,1).ne."D789") call abort()
  32       if (names(4,1).ne."P135") call abort()
  33       if (names(5,1).ne."P246") call abort()
  34       if (any(names2(:,1).ne."0")) call abort()
  35       if (any(names2(:,3:5).ne."0")) call abort()
  36       if (names2(1,2).ne."abcde") call abort()
  37       if (names2(2,2).ne."0") call abort()
  38       if (names2(3,2).ne."fghij") call abort()
  39       if (names2(4,2).ne."0") call abort()
  40       if (names2(5,2).ne."klmno") call abort()
  41       if (any(names3.ne.names)) call abort()
  42       end