gcc/testsuite/gfortran.dg/dec_structure_3.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test nested STRUCTURE definitions.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   call abort()
  11 end subroutine
  12
  13 structure /s3/
  14   real p
  15   structure /s4/ recrd, recrd_a(3)
  16     integer i, j
  17   end structure
  18   real q
  19 end structure
  20
  21 record /s3/ r3
  22 record /s4/ r4
  23
  24 r3.p = 1.3579
  25 r4.i = 0
  26 r4.j = 1
  27 r3.recrd = r4
  28 r3.recrd_a(1) = r3.recrd
  29 r3.recrd_a(2).i = 1
  30 r3.recrd_a(2).j = 0
  31
  32 if (r3.p .ne. 1.3579) then
  33   call aborts("r3.p")
  34 endif
  35
  36 if (r4.i .ne. 0) then
  37   call aborts("r4.i")
  38 endif
  39
  40 if (r4.j .ne. 1) then
  41   call aborts("r4.j")
  42 endif
  43
  44 if (r3.recrd.i .ne. 0 .or. r3.recrd.j .ne. 1) then
  45   call aborts("r3.recrd")
  46 endif
  47
  48 if (r3.recrd_a(2).i .ne. 1 .or. r3.recrd_a(2).j .ne. 0) then
  49   call aborts("r3.recrd_a(2)")
  50 endif
  51
  52 end