OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [namelist_15.f90] - Rev 801

Go to most recent revision | Compare with Previous | Blame | View Log

!{ dg-do run }
! Tests arrays of derived types containing derived type arrays whose
! components are character arrays - exercises object name parser in
! list_read.c. Checks that namelist output can be reread. 
! provided by Paul Thomas - pault@gcc.gnu.org

module global
  type             ::  mt
    character(len=2) ::  ch(2) = (/"aa","bb"/)
  end type mt
  type             ::  bt
    integer        ::  i(2) = (/1,2/)
    type(mt)       ::  m(2)
  end type bt
end module global

program namelist_15
  use global
  type(bt)         ::  x(2)

  namelist /mynml/ x

  open (10, status = "scratch", delim='apostrophe')
  write (10, '(A)') "&MYNML"
  write (10, '(A)') " x = 3, 4, 'dd', 'ee', 'ff', 'gg',"
  write (10, '(A)') "     4, 5, 'hh', 'ii', 'jj', 'kk',"
  write (10, '(A)') " x(1)%i = , ,"
  write (10, '(A)') " x(2)%i = -3, -4"
  write (10, '(A)') " x(2)%m(1)%ch(2)(1:1) ='q',"
  write (10, '(A)') " x(2)%m(2)%ch(1)(1:1) ='w',"
  write (10, '(A)') " x(1)%m(1)%ch(1:2)(2:2) = 'z','z',"
  write (10, '(A)') " x(2)%m(1)%ch(1:2)(2:2) = 'z','z',"
  write (10, '(A)') " x(1)%m(2)%ch(1:2)(2:2) = 'z','z',"
  write (10, '(A)') " x(2)%m(2)%ch(1:2)(2:2) = 'z','z',"
  write (10, '(A)') "/"
   
  rewind (10)
  read (10, nml = mynml, iostat = ier)
  if (ier .ne. 0) call abort () 
  close (10)

  open (10, status = "scratch", delim='apostrophe')
  write (10, nml = mynml)
  rewind (10)

  read (10, nml = mynml, iostat = ier)
  if (ier .ne. 0) call abort () 
  close(10)

  if (.not. ((x(1)%i(1) == 3)          .and. &
             (x(1)%i(2) == 4)          .and. &
             (x(1)%m(1)%ch(1) == "dz") .and. &
             (x(1)%m(1)%ch(2) == "ez") .and. &
             (x(1)%m(2)%ch(1) == "fz") .and. &
             (x(1)%m(2)%ch(2) == "gz") .and. &
             (x(2)%i(1) == -3)         .and. &
             (x(2)%i(2) == -4)         .and. &
             (x(2)%m(1)%ch(1) == "hz") .and. &
             (x(2)%m(1)%ch(2) == "qz") .and. &
             (x(2)%m(2)%ch(1) == "wz") .and. &
             (x(2)%m(2)%ch(2) == "kz"))) call abort ()

end program namelist_15

! { dg-final { cleanup-modules "global" } }

Go to most recent revision | Compare with Previous | Blame | View Log

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.