view gcc/testsuite/gfortran.dg/namelist_69.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
line wrap: on
line source

! { dg-do run }
!
! PR fortran/47339
! PR fortran/43062
!
! Run-time test for Fortran 2003 NAMELISTS
! Version for non-strings
!
program nml_test
  implicit none

  character(len=1000) :: str

  integer, allocatable :: a(:)
  integer, allocatable :: b
  integer, pointer :: ap(:)
  integer, pointer :: bp
  integer :: c
  integer :: d(3)

  type t
    integer :: c1
    integer :: c2(3)
  end type t
  type(t) :: e,f(2)
  type(t),allocatable :: g,h(:)
  type(t),pointer :: i,j(:)

  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j

  a = [1,2]
  allocate(b,ap(2),bp)
  ap = [98, 99]
  b = 7
  bp = 101
  c = 8
  d = [-1, -2, -3]

  e%c1 = -701
  e%c2 = [-702,-703,-704]
  f(1)%c1 = 33001
  f(2)%c1 = 33002
  f(1)%c2 = [44001,44002,44003]
  f(2)%c2 = [44011,44012,44013]

  allocate(g,h(2),i,j(2))

  g%c1 = -601
  g%c2 = [-602,6703,-604]
  h(1)%c1 = 35001
  h(2)%c1 = 35002
  h(1)%c2 = [45001,45002,45003]
  h(2)%c2 = [45011,45012,45013]

  i%c1 = -501
  i%c2 = [-502,-503,-504]
  j(1)%c1 = 36001
  j(2)%c1 = 36002
  j(1)%c2 = [46001,46002,46003]
  j(2)%c2 = [46011,46012,46013]

  ! SAVE NAMELIST
  str = repeat('X', len(str))
  write(str,nml=nml)

  ! RESET NAMELIST
  a = [-1,-1]
  ap = [-1, -1]
  b = -1
  bp = -1
  c = -1
  d = [-1, -1, -1]

  e%c1 = -1
  e%c2 = [-1,-1,-1]
  f(1)%c1 = -1
  f(2)%c1 = -1
  f(1)%c2 = [-1,-1,-1]
  f(2)%c2 = [-1,-1,-1]

  g%c1 = -1
  g%c2 = [-1,-1,-1]
  h(1)%c1 = -1
  h(2)%c1 = -1
  h(1)%c2 = [-1,-1,-1]
  h(2)%c2 = [-1,-1,-1]

  i%c1 = -1
  i%c2 = [-1,-1,-1]
  j(1)%c1 = -1
  j(2)%c1 = -1
  j(1)%c2 = [-1,-1,-1]
  j(2)%c2 = [-1,-1,-1]

  ! Read back
  read(str,nml=nml)

  ! Check result
  if (any (a /= [1,2])) STOP 1
  if (any (ap /= [98, 99])) STOP 2
  if (b /= 7) STOP 3
  if (bp /= 101) STOP 4
  if (c /= 8) STOP 5
  if (any (d /= [-1, -2, -3])) STOP 6

  if (e%c1 /= -701) STOP 7
  if (any (e%c2 /= [-702,-703,-704])) STOP 8
  if (f(1)%c1 /= 33001) STOP 9
  if (f(2)%c1 /= 33002) STOP 10
  if (any (f(1)%c2 /= [44001,44002,44003])) STOP 11
  if (any (f(2)%c2 /= [44011,44012,44013])) STOP 12

  if (g%c1 /= -601) STOP 13
  if (any(g%c2 /= [-602,6703,-604])) STOP 14
  if (h(1)%c1 /= 35001) STOP 15
  if (h(2)%c1 /= 35002) STOP 16
  if (any (h(1)%c2 /= [45001,45002,45003])) STOP 17
  if (any (h(2)%c2 /= [45011,45012,45013])) STOP 18

  if (i%c1 /= -501) STOP 19
  if (any (i%c2 /= [-502,-503,-504])) STOP 20
  if (j(1)%c1 /= 36001) STOP 21
  if (j(2)%c1 /= 36002) STOP 22
  if (any (j(1)%c2 /= [46001,46002,46003])) STOP 23
  if (any (j(2)%c2 /= [46011,46012,46013])) STOP 24

  ! Check argument passing (dummy processing)
  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2) 

contains
  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
    integer, allocatable :: x1(:)
    integer, allocatable :: x2
    integer, pointer :: x1p(:)
    integer, pointer :: x2p
    integer :: x3
    integer :: x4(3)
    integer :: n
    integer :: x5(n)
    type(t) :: x6,x7(2)
    type(t),allocatable :: x8,x9(:)
    type(t),pointer :: x10,x11(:)
    type(t) :: x12(n)

    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12

    x5 = [ 42, 53 ]

    x12(1)%c1 = 37001
    x12(2)%c1 = 37002
    x12(1)%c2 = [47001,47002,47003]
    x12(2)%c2 = [47011,47012,47013]

    ! SAVE NAMELIST
    str = repeat('X', len(str))
    write(str,nml=nml2)

    ! RESET NAMELIST
    x1 = [-1,-1]
    x1p = [-1, -1]
    x2 = -1
    x2p = -1
    x3 = -1
    x4 = [-1, -1, -1]

    x6%c1 = -1
    x6%c2 = [-1,-1,-1]
    x7(1)%c1 = -1
    x7(2)%c1 = -1
    x7(1)%c2 = [-1,-1,-1]
    x7(2)%c2 = [-1,-1,-1]

    x8%c1 = -1
    x8%c2 = [-1,-1,-1]
    x9(1)%c1 = -1
    x9(2)%c1 = -1
    x9(1)%c2 = [-1,-1,-1]
    x9(2)%c2 = [-1,-1,-1]

    x10%c1 = -1
    x10%c2 = [-1,-1,-1]
    x11(1)%c1 = -1
    x11(2)%c1 = -1
    x11(1)%c2 = [-1,-1,-1]
    x11(2)%c2 = [-1,-1,-1]

    x5 = [ -1, -1 ]

    x12(1)%c1 = -1
    x12(2)%c1 = -1
    x12(1)%c2 = [-1,-1,-1]
    x12(2)%c2 = [-1,-1,-1]

    ! Read back
    read(str,nml=nml2)

    ! Check result
    if (any (x1 /= [1,2])) STOP 25
    if (any (x1p /= [98, 99])) STOP 26
    if (x2 /= 7) STOP 27
    if (x2p /= 101) STOP 28
    if (x3 /= 8) STOP 29
    if (any (x4 /= [-1, -2, -3])) STOP 30

    if (x6%c1 /= -701) STOP 31
    if (any (x6%c2 /= [-702,-703,-704])) STOP 32
    if (x7(1)%c1 /= 33001) STOP 33
    if (x7(2)%c1 /= 33002) STOP 34
    if (any (x7(1)%c2 /= [44001,44002,44003])) STOP 35
    if (any (x7(2)%c2 /= [44011,44012,44013])) STOP 36

    if (x8%c1 /= -601) STOP 37
    if (any(x8%c2 /= [-602,6703,-604])) STOP 38
    if (x9(1)%c1 /= 35001) STOP 39
    if (x9(2)%c1 /= 35002) STOP 40
    if (any (x9(1)%c2 /= [45001,45002,45003])) STOP 41
    if (any (x9(2)%c2 /= [45011,45012,45013])) STOP 42

    if (x10%c1 /= -501) STOP 43
    if (any (x10%c2 /= [-502,-503,-504])) STOP 44
    if (x11(1)%c1 /= 36001) STOP 45
    if (x11(2)%c1 /= 36002) STOP 46
    if (any (x11(1)%c2 /= [46001,46002,46003])) STOP 47
    if (any (x11(2)%c2 /= [46011,46012,46013])) STOP 48

    if (any (x5 /= [ 42, 53 ])) STOP 49

    if (x12(1)%c1 /= 37001) STOP 50
    if (x12(2)%c1 /= 37002) STOP 51
    if (any (x12(1)%c2 /= [47001,47002,47003])) STOP 52
    if (any (x12(2)%c2 /= [47011,47012,47013])) STOP 53
  end subroutine test2
end program nml_test