gcc/testsuite/gfortran.dg/pr88688.f90

   1 ! { dg-do run }
   2 !
   3 ! Contributed by Thomas Fanning <thfanning@gmail.com>
   4 !
   5 !
   6 module mod
   7
   8     type test
   9         class(*), pointer :: ptr
  10     contains
  11         procedure :: setref
  12     end type
  13
  14 contains
  15
  16     subroutine setref(my,ip)
  17     implicit none
  18         class(test) :: my
  19         integer, pointer :: ip
  20         my%ptr => ip
  21     end subroutine
  22
  23     subroutine set7(ptr)
  24     implicit none
  25         class(*), pointer :: ptr
  26         select type (ptr)
  27             type is (integer)
  28                 ptr = 7
  29         end select
  30     end subroutine
  31
  32 end module
  33 !---------------------------------------
  34
  35 !---------------------------------------
  36 program bug
  37 use mod
  38 implicit none
  39
  40     integer, pointer :: i, j
  41     type(test) :: tp
  42     class(*), pointer :: lp
  43
  44     allocate(i,j)
  45     i = 3; j = 4
  46
  47     call tp%setref(i)
  48     select type (ap => tp%ptr)
  49         class default
  50             call tp%setref(j)
  51             lp => ap
  52             call set7(lp)
  53     end select
  54
  55 ! gfortran used to give i=3 and j=7 because the associate name was not pointing
  56 ! to the target of tp%ptr as required by F2018:19.5.1.6 but, rather, to the
  57 ! selector itself.
  58     if (i .ne. 7) stop 1
  59     if (j .ne. 4) stop 2
  60
  61 end program
  62 !---------------------------------------