gcc/testsuite/gfortran.dg/elemental_assignment_1.f90

   1 ! { dg-do run }
   2 ! PR 67539 - this used to give a segfault at runtime.
   3 ! Test case by "mrestelli".
   4
   5 module m
   6  implicit none
   7
   8  type :: t_a
   9   real, allocatable :: x
  10  end type t_a
  11
  12  interface assignment(=)
  13   module procedure copy_t_a
  14  end interface
  15
  16 contains
  17
  18  elemental subroutine copy_t_a(y,x)
  19   type(t_a), intent(in)  :: x
  20   type(t_a), intent(out) :: y
  21    allocate( y%x , source=x%x )
  22  end subroutine copy_t_a
  23
  24  elemental function new_t_a(x) result(res)
  25   real, intent(in) :: x
  26   type(t_a) :: res
  27    allocate( res%x )
  28    res%x = x
  29  end function new_t_a
  30
  31 end module m
  32
  33
  34 program p
  35  use m
  36  implicit none
  37
  38  integer :: i
  39  type(t_a) :: tmp
  40  type(t_a), allocatable :: v(:)
  41
  42  allocate( v(2) )
  43
  44  v = new_t_a(1.5)   ! -> segmentation fault
  45
  46  !tmp = new_t_a(1.5) ! -> OK
  47  !v = tmp
  48
  49  !do i=1,size(v)     ! -> also OK
  50  !  v(i) = new_t_a(1.5)
  51  !enddo
  52
  53  do i=1,size(v)
  54    write(*,*) " i = ",i
  55    write(*,*) allocated(v(i)%x)
  56    write(*,*) v(i)%x
  57  enddo
  58
  59 end program p