gcc/testsuite/gfortran.dg/dec_structure_1.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Basic STRUCTURE test.
   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/                ! type s1
  15   integer i1
  16   logical l1
  17   real r1
  18   character c1
  19 end structure                 ! end type s1
  20
  21 record /s1/ r1                ! type (s1) r1
  22 record /s1/ r1_a(3)           ! type (s1) r1_a(3)
  23
  24 ! Basic records
  25 r1.i1 = 13579                  ! r1%i1 = ...
  26 r1.l1 = .true.
  27 r1.r1 = 13.579
  28 r1.c1 = 'F'
  29 r1_a(2) = r1
  30 r1_a(3).r1 = 135.79
  31
  32 if (r1.i1 .ne. 13579) then
  33   call aborts("r1.i1")
  34 endif
  35
  36 if (r1.l1 .neqv. .true.) then
  37   call aborts("r1.l1")
  38 endif
  39
  40 if (r1.r1 .ne. 13.579) then
  41   call aborts("r1.r1")
  42 endif
  43
  44 if (r1.c1 .ne. 'F') then
  45   call aborts("r1.c1")
  46 endif
  47
  48 if (r1_a(2).i1 .ne. 13579) then
  49   call aborts("r1_a(2).i1")
  50 endif
  51
  52 if (r1_a(3).r1 .ne. 135.79) then
  53   call aborts("r1_a(3).r1")
  54 endif
  55
  56 end