gcc/testsuite/gfortran.dg/namelist_15.f90

   1 !{ dg-do run }
   2 ! Tests arrays of derived types containing derived type arrays whose
   3 ! components are character arrays - exercises object name parser in
   4 ! list_read.c. Checks that namelist output can be reread.
   5 ! provided by Paul Thomas - pault@gcc.gnu.org
   6
   7 module global
   8   type             ::  mt
   9     character(len=2) ::  ch(2) = (/"aa","bb"/)
  10   end type mt
  11   type             ::  bt
  12     integer        ::  i(2) = (/1,2/)
  13     type(mt)       ::  m(2)
  14   end type bt
  15 end module global
  16
  17 program namelist_15
  18   use global
  19   type(bt)         ::  x(2)
  20
  21   namelist /mynml/ x
  22
  23   open (10, status = "scratch", delim='apostrophe')
  24   write (10, '(A)') "&MYNML"
  25   write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg',"
  26   write (10, '(A)') "     4, 5, 'hh', 'ii', 'jj', 'kk',"
  27   write (10, '(A)') " x(1)%i = , ,"
  28   write (10, '(A)') " x(2)%i = -3, -4"
  29   write (10, '(A)') " x(2)%m(1)%ch(2)(1:1) ='q',"
  30   write (10, '(A)') " x(2)%m(2)%ch(1)(1:1) ='w',"
  31   write (10, '(A)') " x(1)%m(1)%ch(1:2)(2:2) = 'z','z',"
  32   write (10, '(A)') " x(2)%m(1)%ch(1:2)(2:2) = 'z','z',"
  33   write (10, '(A)') " x(1)%m(2)%ch(1:2)(2:2) = 'z','z',"
  34   write (10, '(A)') " x(2)%m(2)%ch(1:2)(2:2) = 'z','z',"
  35   write (10, '(A)') "/"
  36
  37   rewind (10)
  38   read (10, nml = mynml, iostat = ier)
  39   if (ier .ne. 0) call abort ()
  40   close (10)
  41
  42   open (10, status = "scratch", delim='apostrophe')
  43   write (10, nml = mynml)
  44   rewind (10)
  45
  46   read (10, nml = mynml, iostat = ier)
  47   if (ier .ne. 0) call abort ()
  48   close(10)
  49
  50   if (.not. ((x(1)%i(1) == 3)          .and. &
  51              (x(1)%i(2) == 4)          .and. &
  52              (x(1)%m(1)%ch(1) == "dz") .and. &
  53              (x(1)%m(1)%ch(2) == "ez") .and. &
  54              (x(1)%m(2)%ch(1) == "fz") .and. &
  55              (x(1)%m(2)%ch(2) == "gz") .and. &
  56              (x(2)%i(1) == -3)         .and. &
  57              (x(2)%i(2) == -4)         .and. &
  58              (x(2)%m(1)%ch(1) == "hz") .and. &
  59              (x(2)%m(1)%ch(2) == "qz") .and. &
  60              (x(2)%m(2)%ch(1) == "wz") .and. &
  61              (x(2)%m(2)%ch(2) == "kz"))) call abort ()
  62
  63 end program namelist_15