Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/pointer_array_component_2.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! ! Test the fix for PR34640. In the first version of the fix, the first ! testcase in PR51218 failed with a segfault. This test extracts the ! failing part and checks that all is well. ! type t_info_block integer :: n = 0 ! number of elements end type t_info_block ! type t_dec_info integer :: n = 0 ! number of elements integer :: n_b = 0 ! number of blocks type (t_info_block) ,pointer :: b (:) => NULL() ! info blocks end type t_dec_info ! type t_vector_segm integer :: n = 0 ! number of elements real ,pointer :: x(:) => NULL() ! coefficients end type t_vector_segm ! type t_vector type (t_dec_info) ,pointer :: info => NULL() ! decomposition info integer :: n = 0 ! number of elements integer :: n_s = 0 ! number of segments integer :: alloc_l = 0 ! allocation level type (t_vector_segm) ,pointer :: s (:) => NULL() ! vector blocks end type t_vector type(t_vector) :: z type(t_vector_segm), pointer :: ss allocate (z%s(2)) do i = 1, 2 ss => z%s(i) allocate (ss%x(2), source = [1.0, 2.0]*real(i)) end do ! These lines would segfault. if (int (sum (z%s(1)%x)) .ne. 3) STOP 1 if (int (sum (z%s(1)%x * z%s(2)%x)) .ne. 10) STOP 2 end