gcc/testsuite/gfortran.dg/dec_structure_6.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test old-style CLIST initializers in STRUCTURE.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   call abort()
  11 end subroutine
  12
  13 integer, parameter :: as = 3
  14 structure /s8/
  15   character*20 c /"HELLO"/  ! ok
  16   integer*2 j /300_4/       ! ok, converted
  17   integer   k /65536_8/     ! ok, implicit
  18   integer*4 l /200000/      ! ok, types match
  19   integer   m(5) /5,4,3,2,1/! ok
  20   integer   n(5) /1,3*2,1/  ! ok, with repeat spec (/1,2,2,2,1/)
  21   integer   o(as) /as*9/    ! ok, parameter array spec
  22   integer   p(2,2) /1,2,3,4/! ok
  23   real      q(3) /1_2,3.5,2.4E-12_8/ ! ok, with some implicit conversions
  24   integer :: canary = z'3D3D3D3D'
  25 end structure
  26
  27 record /s8/ r8
  28
  29 ! Old-style (clist) initializers in structures
  30 if ( r8.c /= "HELLO" ) call aborts ("r8.c")
  31 if ( r8.j /= 300 ) call aborts ("r8.j")
  32 if ( r8.k /= 65536 ) call aborts ("r8.k")
  33 if ( r8.l /= 200000 ) call aborts ("r8.l")
  34 if (     r8.m(1) /= 5 .or. r8.m(2) /= 4 .or. r8.m(3) /= 3 &
  35     .or. r8.m(4) /= 2 .or. r8.m(5) /= 1) &
  36   call aborts ("r8.m")
  37 if (     r8.n(1) /= 1 .or. r8.n(2) /= 2 .or. r8.n(3) /= 2 .or. r8.n(4) /= 2 &
  38     .or. r8.n(5) /= 1) &
  39   call aborts ("r8.n")
  40 if ( r8.o(1) /= 9 .or. r8.o(2) /= 9 .or. r8.o(3) /= 9 ) call aborts ("r8.o")
  41 if (     r8.p(1,1) /= 1 .or. r8.p(2,1) /= 2 .or. r8.p(1,2) /= 3 &
  42     .or. r8.p(2,2) /= 4) &
  43   call aborts ("r8.p")
  44 if ( r8.canary /= z'3D3D3D3D' ) call aborts ("r8.canary")
  45
  46 end