gcc/testsuite/gfortran.dg/dec_structure_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test STRUCTUREs containin other STRUCTUREs.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   call abort()
  11 end subroutine
  12
  13 ! Basic structure
  14 structure /s1/
  15   integer i1
  16   logical l1
  17   real r1
  18   character c1
  19 end structure
  20
  21 structure /s2/
  22   integer i
  23   record /s1/ r1
  24 endstructure
  25
  26 record /s1/ r1
  27 record /s2/ r2, r2_a(10)
  28
  29 ! Nested and array records
  30 r2.r1.r1 = 135.79
  31 r2_a(3).r1.i1 = -13579
  32
  33 if (r2.r1.r1 .ne. 135.79) then
  34   call aborts("r1.r1.r1")
  35 endif
  36
  37 if (r2_a(3).r1.i1 .ne. -13579) then
  38   call aborts("r2_a(3).r1.i1")
  39 endif
  40
  41 end