gcc/testsuite/gfortran.dg/pointer_array_component_2.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR34640. In the first version of the fix, the first
   4 ! testcase in PR51218 failed with a segfault. This test extracts the
   5 ! failing part and checks that all is well.
   6 !
   7   type t_info_block
   8     integer                      :: n     =  0      ! number of elements
   9   end type t_info_block
  10   !
  11   type t_dec_info
  12     integer                      :: n     =  0      ! number of elements
  13     integer                      :: n_b   =  0      ! number of blocks
  14     type (t_info_block) ,pointer :: b (:) => NULL() ! info blocks
  15   end type t_dec_info
  16   !
  17   type t_vector_segm
  18     integer           :: n    =  0      ! number of elements
  19     real ,pointer :: x(:) => NULL() ! coefficients
  20   end type t_vector_segm
  21   !
  22   type t_vector
  23     type (t_dec_info)    ,pointer :: info    => NULL()  ! decomposition info
  24     integer                       :: n       =  0       ! number of elements
  25     integer                       :: n_s     =  0       ! number of segments
  26     integer                       :: alloc_l =  0       ! allocation level
  27     type (t_vector_segm) ,pointer :: s (:)   => NULL()  ! vector blocks
  28   end type t_vector
  29
  30
  31   type(t_vector) :: z
  32   type(t_vector_segm), pointer :: ss
  33
  34   allocate (z%s(2))
  35   do i = 1, 2
  36     ss => z%s(i)
  37     allocate (ss%x(2), source = [1.0, 2.0]*real(i))
  38   end do
  39
  40 ! These lines would segfault.
  41   if (int (sum (z%s(1)%x)) .ne. 3) STOP 1
  42   if (int (sum (z%s(1)%x * z%s(2)%x)) .ne. 10) STOP 2
  43 end