gcc/testsuite/gfortran.dg/associate_48.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR90498.
   4 !
   5 ! Contributed by Vladimir Fuka  <vladimir.fuka@gmail.com>
   6 !
   7   type field_names_a
   8     class(*), pointer :: var(:) =>null()
   9   end type
  10
  11   type(field_names_a),pointer :: a(:)
  12   allocate (a(2))
  13
  14   allocate (a(1)%var(2), source = ["hello"," vlad"])
  15   allocate (a(2)%var(2), source = ["HELLO"," VLAD"])
  16   call s(a)
  17   deallocate (a(1)%var)
  18   deallocate (a(2)%var)
  19   deallocate (a)
  20 contains
  21   subroutine s(a)
  22
  23     type(field_names_a) :: a(:)
  24
  25     select type (var => a(1)%var)
  26       type is (character(*))
  27         if (any (var .ne. ["hello"," vlad"])) stop 1
  28       class default
  29         stop
  30     end select
  31
  32     associate (var => a(2)%var)
  33       select type (var)
  34         type is (character(*))
  35           if (any (var .ne. ["HELLO"," VLAD"])) stop 2
  36         class default
  37           stop
  38       end select
  39     end associate
  40   end
  41 end