code.ossystems Code Review - openembedded-core.git/blob

   1 From 348c7b9400ed5fe0d8c3c077f8223ca359bed036 Mon Sep 17 00:00:00 2001
   2 From: pault <pault@138bc75d-0d04-0410-961f-82ee72b054a4>
   3 Date: Wed, 13 Apr 2011 18:38:17 +0000
   4 Subject: [PATCH 116/200] 2011-04-13  Paul Thomas  <pault@gcc.gnu.org>
   5
   6         PR fortran/48360
   7         PR fortran/48456
   8         * trans-array.c (get_std_lbound): For derived type variables
   9         return array valued component lbound.
  10
  11 2011-04-13  Paul Thomas  <pault@gcc.gnu.org>
  12
  13         PR fortran/48360
  14         PR fortran/48456
  15         * gfortran.dg/realloc_on_assign_6.f03: New test.
  16
  17 git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_6-branch@172390 138bc75d-0d04-0410-961f-82ee72b054a4
  18
  19 index ac08c42..3d4a52a 100644
  20 --- a/gcc/fortran/trans-array.c
  21 +++ b/gcc/fortran/trans-array.c
  22 @@ -6707,6 +6707,8 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
  23    tree stride;
  24    tree cond, cond1, cond3, cond4;
  25    tree tmp;
  26 +  gfc_ref *ref;
  27 +
  28    if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
  29      {
  30        tmp = gfc_rank_cst[dim];
  31 @@ -6740,6 +6742,14 @@ get_std_lbound (gfc_expr *expr, tree desc, int dim, bool assumed_size)
  32    else if (expr->expr_type == EXPR_VARIABLE)
  33      {
  34        tmp = TREE_TYPE (expr->symtree->n.sym->backend_decl);
  35 +      for (ref = expr->ref; ref; ref = ref->next)
  36 +       {
  37 +         if (ref->type == REF_COMPONENT
  38 +               && ref->u.c.component->as
  39 +               && ref->next
  40 +               && ref->next->u.ar.type == AR_FULL)
  41 +           tmp = TREE_TYPE (ref->u.c.component->backend_decl);
  42 +       }
  43        return GFC_TYPE_ARRAY_LBOUND(tmp, dim);
  44      }
  45    else if (expr->expr_type == EXPR_FUNCTION)
  46 new file mode 100644
  47 index 0000000..7c170eb
  48 --- /dev/null
  49 +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_6.f03
  50 @@ -0,0 +1,129 @@
  51 +! { dg-do compile }
  52 +! Test the fix for PR48456 and PR48360 in which the backend
  53 +! declarations for components were not located in the automatic
  54 +! reallocation on assignments, thereby causing ICEs.
  55 +!
  56 +! Contributed by Keith Refson  <krefson@googlemail.com>
  57 +! and Douglas Foulds  <mixnmaster@gmail.com>
  58 +!
  59 +! This is PR48360
  60 +
  61 +module m
  62 +  type mm
  63 +     real, dimension(3,3) :: h0
  64 +  end type mm
  65 +end module m
  66 +
  67 +module gf33
  68 +
  69 +  real, allocatable, save, dimension(:,:) :: hmat
  70 +
  71 +contains
  72 +  subroutine assignit
  73 +
  74 +    use m
  75 +    implicit none
  76 +
  77 +    type(mm) :: mmv
  78 +
  79 +    hmat = mmv%h0
  80 +  end subroutine assignit
  81 +end module gf33
  82 +
  83 +! This is PR48456
  84 +
  85 +module custom_type
  86 +
  87 +integer, parameter :: dp = kind(0.d0)
  88 +
  89 +type :: my_type_sub
  90 +    real(dp), dimension(5) :: some_vector
  91 +end type my_type_sub
  92 +
  93 +type :: my_type
  94 +  type(my_type_sub) :: some_element
  95 +end type my_type
  96 +
  97 +end module custom_type
  98 +
  99 +module custom_interfaces
 100 +
 101 +interface
 102 +  subroutine store_data_subroutine(vec_size)
 103 +  implicit none
 104 +  integer, intent(in) :: vec_size
 105 +  integer :: k
 106 +  end subroutine store_data_subroutine
 107 +end interface
 108 +
 109 +end module custom_interfaces
 110 +
 111 +module store_data_test
 112 +
 113 +use custom_type
 114 +
 115 +save
 116 +type(my_type), dimension(:), allocatable :: some_type_to_save
 117 +
 118 +end module store_data_test
 119 +
 120 +program test
 121 +
 122 +use store_data_test
 123 +
 124 +integer :: vec_size
 125 +
 126 +vec_size = 2
 127 +
 128 +call store_data_subroutine(vec_size)
 129 +call print_after_transfer()
 130 +
 131 +end program test
 132 +
 133 +subroutine store_data_subroutine(vec_size)
 134 +
 135 +use custom_type
 136 +use store_data_test
 137 +
 138 +implicit none
 139 +
 140 +integer, intent(in) :: vec_size
 141 +integer :: k
 142 +
 143 +allocate(some_type_to_save(vec_size))
 144 +
 145 +do k = 1,vec_size
 146 +
 147 +  some_type_to_save(k)%some_element%some_vector(1) = 1.0_dp
 148 +  some_type_to_save(k)%some_element%some_vector(2) = 2.0_dp
 149 +  some_type_to_save(k)%some_element%some_vector(3) = 3.0_dp
 150 +  some_type_to_save(k)%some_element%some_vector(4) = 4.0_dp
 151 +  some_type_to_save(k)%some_element%some_vector(5) = 5.0_dp
 152 +
 153 +end do
 154 +
 155 +end subroutine store_data_subroutine
 156 +
 157 +subroutine print_after_transfer()
 158 +
 159 +use custom_type
 160 +use store_data_test
 161 +
 162 +implicit none
 163 +
 164 +real(dp), dimension(:), allocatable :: C_vec
 165 +integer :: k
 166 +
 167 +allocate(C_vec(5))
 168 +
 169 +do k = 1,size(some_type_to_save)
 170 +
 171 +  C_vec = some_type_to_save(k)%some_element%some_vector
 172 +  print *, "C_vec", C_vec
 173 +
 174 +end do
 175 +
 176 +end subroutine print_after_transfer
 177 +! { dg-final { cleanup-modules "m gf33" } }
 178 +! { dg-final { cleanup-modules "custom_type custom_interfaces" } }
 179 +! { dg-final { cleanup-modules "store_data_test" } }
 180 --
 181 1.7.0.4
 182