gcc/testsuite/gfortran.dg/associate_13.f90

   1 ! { dg-do run }
   2 !
   3 ! Tests the fix for PR56047.  This is actually a development of
   4 ! the test case of comment #10.
   5 !
   6 ! Reported by Juergen Reuter  <juergen.reuter@desy.de>
   7 !
   8   implicit none
   9   type :: process_variant_def_t
  10     integer :: i
  11   end type
  12   type :: process_component_def_t
  13      class(process_variant_def_t), allocatable :: variant_def
  14   end type
  15   type(process_component_def_t), dimension(1:2) :: initial
  16   allocate (initial(1)%variant_def, source = process_variant_def_t (99))
  17   associate (template => initial(1)%variant_def)
  18     template%i = 77
  19   end associate
  20   if (initial(1)%variant_def%i .ne. 77) call abort
  21 end