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   STOP 1
  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
  35 structure /s2/
  36   union ! U2
  37     map ! M4
  38       integer(2) w1, w2
  39     end map
  40     map ! M5
  41       integer(4) long
  42     end map
  43   end union
  44 end structure
  45
  46 record /s1/ r1
  47 record /s2/ r2
  48
  49 ! Basic unions
  50 r1.a = 0
  51 r1.b = 1.33e7
  52 if ( r1.a .eq. 0 ) call aborts ("basic union 1")
  53
  54 ! Endian-agnostic runtime check
  55 r2.long = int(z'12345678')
  56 if (.not. (     (r2.w1 .eq. int(z'1234',2) .and. r2.w2 .eq. int(z'5678',2)) &
  57            .or. (r2.w1 .eq. int(z'5678',2) .and. r2.w2 .eq. int(z'1234',2))) ) then
  58     call aborts ("basic union 2")
  59 endif
  60
  61 end