gcc/testsuite/gfortran.dg/dec_union_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test basic UNION implementation.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   call abort()
  11 end subroutine
  12
  13 ! Empty union
  14 structure /s0/
  15   union ! U0
  16     map ! M0
  17     end map
  18     map ! M1
  19     end map
  20   end union
  21 end structure
  22
  23 ! Basic unions
  24 structure /s1/
  25   union ! U1
  26     map ! M2
  27       integer(4) a
  28     end map
  29     map ! M3
  30       real(4) b
  31     end map
  32   end union
  33 end structure
  34 structure /s2/
  35   union ! U2
  36     map ! M4
  37       integer(2) w1, w2
  38     end map
  39     map ! M5
  40       integer(4) long
  41     end map
  42   end union
  43 end structure
  44
  45 record /s1/ r1
  46 record /s2/ r2
  47
  48 ! Basic unions
  49 r1.a = 0
  50 r1.b = 1.33e7
  51 if ( r1.a .eq. 0 ) call aborts ("basic union 1")
  52
  53 ! Endian-agnostic runtime check
  54 r2.long = z'12345678'
  55 if (.not. (     (r2.w1 .eq. z'1234' .and. r2.w2 .eq. z'5678') &
  56            .or. (r2.w1 .eq. z'5678' .and. r2.w2 .eq. z'1234')) ) then
  57     call aborts ("basic union 2")
  58 endif
  59
  60 end