gcc/testsuite/gfortran.dg/pointer_array_3.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR40737 comment 17 as part of the overall fix for PR34640.
   4 !
   5 ! Contributed by Josh Hykes  <joshuahykes@yahoo.com>
   6 !
   7    module test_mod
   8 !
   9    type t1
  10       character(8)  :: string
  11    end type t1
  12 !
  13    type t2
  14      integer :: tab
  15      type(t1), pointer :: fp(:)
  16    end type t2
  17 !
  18    type t3
  19       integer :: tab
  20       type(t2), pointer :: as
  21    end type t3
  22 !
  23    type(t3), pointer :: as_typ(:) => null()
  24 !
  25    character(8),  pointer, public :: p(:)
  26 !
  27    contains
  28 !
  29    subroutine as_set_alias (i)
  30 !
  31    implicit none
  32 !
  33    integer, intent(in)    :: i
  34 !
  35      allocate (as_typ(2))
  36      allocate (as_typ(1)%as)
  37      allocate (as_typ(1)%as%fp(2), source = [t1("abcdefgh"),t1("ijklmnop")])
  38      p => as_typ(i)%as%fp(:)%string
  39 !
  40    end subroutine as_set_alias
  41 !
  42    end module test_mod
  43
  44    program test_prog
  45    use test_mod
  46    call as_set_alias(1)
  47    if (any (p .ne. ["abcdefgh","ijklmnop"])) call abort
  48    deallocate (as_typ(1)%as%fp)
  49    deallocate (as_typ(1)%as)
  50    deallocate (as_typ)
  51    end program test_prog