gcc/testsuite/gfortran.dg/data_pointer_3.f90

   1 ! { dg-do compile }
   2 ! PR fortran/114474 - DATA and derived types with pointer components
   3
   4 program pr114474
   5   implicit none
   6   integer, target     :: ii = 42    ! initial data target
   7
   8   integer, target     :: jj = 24
   9   integer, pointer    :: qq => jj
  10   ! ii and jj resolve slightly differently when the data statement below
  11   ! is reached, as jj is resolved outside the structure constructor first
  12
  13   type t
  14      integer, pointer :: h
  15   end type t
  16
  17   integer, target     :: kk(7) =  23
  18   integer, pointer    :: ll(:) => kk
  19
  20   type t1
  21      integer          :: m(7)
  22   end type t1
  23
  24   type(t)             :: x1, x2, x3, x4, x5
  25   type(t), parameter  :: z1 = t(null())
  26
  27   type(t1), target    :: tt = t1([1,2,3,4,5,6,7])
  28   type(t1), parameter :: vv = t1(22)
  29   type(t1)            :: w1, w2
  30   integer,  pointer   :: p1(:) => tt% m
  31
  32   data x1 / t(null())  /
  33   data x2 / t(ii)      / ! ii is initial data target
  34   data x3 / t(jj)      / ! jj is resolved differently...
  35   data x4 / t(tt%m(3)) / ! pointer association with 3rd element
  36
  37   data w1 / t1(12)     /
  38   data w2 / t1(vv%m)   /
  39
  40   if (      associated (x1% h)) stop 1
  41   if (.not. associated (x2% h)) stop 2
  42   if (.not. associated (x3% h)) stop 3
  43   if (.not. associated (x4% h)) stop 4
  44   if (x2% h /= 42) stop 5
  45   if (x3% h /= 24) stop 6
  46   if (x4% h /=  3) stop 7
  47
  48   if (any (w1%m /= 12  )) stop 8
  49   if (any (w2%m /= vv%m)) stop 9
  50 end
  51
  52
  53 subroutine sub
  54   implicit none
  55
  56   interface
  57      real function myfun (x)
  58        real, intent(in) :: x
  59      end function myfun
  60   end interface
  61
  62   type u
  63      procedure(myfun), pointer, nopass :: p
  64   end type u
  65
  66   type(u)            :: u3 = u(null())
  67   type(u), parameter :: u4 = u(null())
  68   type(u)            :: u1, u2
  69
  70   data u1 / u(null()) /
  71   data u2 / u(myfun)  /
  72 end
  73
  74 real function myfun (x)
  75   real, intent(in) :: x
  76   myfun = x
  77 end function myfun