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

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