re PR fortran/37735 (Allocatable components in vectors of derived types cause ICE...

2008-11-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/37735
	* trans-array.c (structure_alloc_comps): Do not duplicate the
	descriptor if this is a descriptorless array!

2008-11-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/37735
	* gfortran.dg/alloc_comp_assign_7.f90: New test.

From-SVN: r142142

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 46cec41972a2db4f589de4d828c9814ebc025185..4455365e87875483865bd0cd8e380efa6b149719 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2008-11-23  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/37735
+       * trans-array.c (structure_alloc_comps): Do not duplicate the
+       descriptor if this is a descriptorless array!
+
 2008-11-12  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/38160

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 1385409808e4d64f4c72dcd52aaf6709933de118..85e80c768bc126f3a97a113a6b9a8a93f1e26b51 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5546,10 +5546,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 
       if (purpose == COPY_ALLOC_COMP)
         {
-          tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
-         gfc_add_expr_to_block (&fnblock, tmp);
-
-         tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (dest));
+         if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (dest)))
+           {
+             tmp = gfc_duplicate_allocatable (dest, decl, TREE_TYPE(decl), rank);
+             gfc_add_expr_to_block (&fnblock, tmp);
+           }
+         tmp = build_fold_indirect_ref (gfc_conv_array_data (dest));
          dref = gfc_build_array_ref (tmp, index, NULL);
          tmp = structure_alloc_comps (der_type, vref, dref, rank, purpose);
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5a8e886dedf0a832a2272847c2d493adbd8b11b3..17ed9f1c3d4ea15103836766ebeebaa7b2d301f4 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2008-11-23  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/37735
+       * gfortran.dg/alloc_comp_assign_7.f90: New test.
+
 2008-11-23  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
 
        * g++.dg/ext/tmplattr9.C: Require weak.

diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90
new file mode 100644 (file)
index 0000000..c0f3c76
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_assign_7.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+!
+! Test the fix for PR37735, in which gfc gagged in the assignement to
+! 'p'.  The array component 'r' caused an ICE.
+!
+! Contributed by Steven Winfield <saw44@cam.ac.uk>
+!
+module PrettyPix_module
+  implicit none
+  type Spline
+     real, allocatable, dimension(:) ::y2
+  end type Spline
+  type Path
+     type(Spline) :: r(3)
+  end type Path
+  type Scene
+     type(path) :: look_at_path
+  end type Scene
+contains
+  subroutine scene_set_look_at_path(this,p)
+    type(scene), intent(inout) :: this
+    type(path),  intent(in)    :: p
+    this%look_at_path = p
+  end subroutine scene_set_look_at_path
+end module PrettyPix_module
+
+  use PrettyPix_module
+  implicit none
+  integer :: i
+  real :: x(3) = [1.0, 2.0, 3.0]
+  type(scene) :: this
+  type(path)  :: p
+  p = path ([spline([x(1)]),spline([x(2)]),spline([x(3)])])
+  call scene_set_look_at_path(this,p)
+  do i = 1, 3
+    if (this%look_at_path%r(i)%y2(1) .ne. x(i)) call abort
+  end do
+end
+
+! { dg-final { cleanup-modules "PrettyPix_module" } }