gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03

   1 ! { dg-do compile }
   2 ! Test the fix for PR48456 and PR48360 in which the backend
   3 ! declarations for components were not located in the automatic
   4 ! reallocation on assignments, thereby causing ICEs.
   5 !
   6 ! Contributed by Keith Refson  <krefson@googlemail.com>
   7 ! and Douglas Foulds  <mixnmaster@gmail.com>
   8 !
   9 ! This is PR48360
  10
  11 module m
  12   type mm
  13      real, dimension(3,3) :: h0
  14   end type mm
  15 end module m
  16
  17 module gf33
  18
  19   real, allocatable, save, dimension(:,:) :: hmat
  20
  21 contains
  22   subroutine assignit
  23
  24     use m
  25     implicit none
  26
  27     type(mm) :: mmv
  28
  29     hmat = mmv%h0
  30   end subroutine assignit
  31 end module gf33
  32
  33 ! This is PR48456
  34
  35 module custom_type
  36
  37 integer, parameter :: dp = kind(0.d0)
  38
  39 type :: my_type_sub
  40     real(dp), dimension(5) :: some_vector
  41 end type my_type_sub
  42
  43 type :: my_type
  44   type(my_type_sub) :: some_element
  45 end type my_type
  46
  47 end module custom_type
  48
  49 module custom_interfaces
  50
  51 interface
  52   subroutine store_data_subroutine(vec_size)
  53   implicit none
  54   integer, intent(in) :: vec_size
  55   integer :: k
  56   end subroutine store_data_subroutine
  57 end interface
  58
  59 end module custom_interfaces
  60
  61 module store_data_test
  62
  63 use custom_type
  64
  65 save
  66 type(my_type), dimension(:), allocatable :: some_type_to_save
  67
  68 end module store_data_test
  69
  70 program test
  71
  72 use store_data_test
  73
  74 integer :: vec_size
  75
  76 vec_size = 2
  77
  78 call store_data_subroutine(vec_size)
  79 call print_after_transfer()
  80
  81 end program test
  82
  83 subroutine store_data_subroutine(vec_size)
  84
  85 use custom_type
  86 use store_data_test
  87
  88 implicit none
  89
  90 integer, intent(in) :: vec_size
  91 integer :: k
  92
  93 allocate(some_type_to_save(vec_size))
  94
  95 do k = 1,vec_size
  96
  97   some_type_to_save(k)%some_element%some_vector(1) = 1.0_dp
  98   some_type_to_save(k)%some_element%some_vector(2) = 2.0_dp
  99   some_type_to_save(k)%some_element%some_vector(3) = 3.0_dp
 100   some_type_to_save(k)%some_element%some_vector(4) = 4.0_dp
 101   some_type_to_save(k)%some_element%some_vector(5) = 5.0_dp
 102
 103 end do
 104
 105 end subroutine store_data_subroutine
 106
 107 subroutine print_after_transfer()
 108
 109 use custom_type
 110 use store_data_test
 111
 112 implicit none
 113
 114 real(dp), dimension(:), allocatable :: C_vec
 115 integer :: k
 116
 117 allocate(C_vec(5))
 118
 119 do k = 1,size(some_type_to_save)
 120
 121   C_vec = some_type_to_save(k)%some_element%some_vector
 122   print *, "C_vec", C_vec
 123
 124 end do
 125
 126 end subroutine print_after_transfer