gcc/testsuite/gfortran.dg/dec_union_4.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fdec-structure" }
   3 !
   4 ! Test nested UNIONs.
   5 !
   6
   7 subroutine aborts (s)
   8   character(*), intent(in) :: s
   9   print *, s
  10   STOP 1
  11 end subroutine
  12
  13 ! Nested unions
  14 structure /s4/
  15   union ! U0                ! rax
  16     map
  17       character(16) rx
  18     end map
  19     map
  20       character(8) rh         ! rah
  21       union ! U1
  22         map
  23           character(8) rl     ! ral
  24         end map
  25         map
  26           character(8) ex     ! eax
  27         end map
  28         map
  29           character(4) eh     ! eah
  30           union ! U2
  31             map
  32               character(4) el ! eal
  33             end map
  34             map
  35               character(4) x  ! ax
  36             end map
  37             map
  38               character(2) h  ! ah
  39               character(2) l  ! al
  40             end map
  41           end union
  42         end map
  43       end union
  44     end map
  45   end union
  46 end structure
  47 record /s4/ r4
  48
  49
  50 ! Nested unions
  51 r4.rx     =     'AAAAAAAA.BBB.C.D'
  52
  53 if ( r4.rx .ne. 'AAAAAAAA.BBB.C.D' ) call aborts ("rax")
  54 if ( r4.rh .ne. 'AAAAAAAA'         ) call aborts ("rah")
  55 if ( r4.rl .ne.         '.BBB.C.D' ) call aborts ("ral")
  56 if ( r4.ex .ne.         '.BBB.C.D' ) call aborts ("eax")
  57 if ( r4.eh .ne.         '.BBB'     ) call aborts ("eah")
  58 if ( r4.el .ne.             '.C.D' ) call aborts ("eal")
  59 if ( r4.x  .ne.             '.C.D' ) call aborts ("ax")
  60 if ( r4.h  .ne.             '.C'   ) call aborts ("ah")
  61 if ( r4.l  .ne.               '.D' ) call aborts ("al")
  62
  63 end