re PR fortran/68864 (ICE: in gfc_get_descriptor_dimension, at fortran/trans-array...

2016-01-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/68864
	* trans-array.c (evaluate_bound): If deferred, test that 'desc'
	is an array descriptor before using gfc_conv_descriptor_xxx.

2016-01-01  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/68864
	* gfortran.dg/pr68864.f90: New test.

From-SVN: r232026

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 668a04302dbb1a8872cc78b6a758f7b5b06815f5..0e7bf72638bce0cd14f17517ec778f59f5a8d997 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2016-01-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/68864
+       * trans-array.c (evaluate_bound): If deferred, test that 'desc'
+       is an array descriptor before using gfc_conv_descriptor_xxx.
+
 2015-12-29  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/69011

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 71e04822075befecc400aada18fbf1d673b39697..287b4af332738512635887b83f29c99bac11de55 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3821,10 +3821,10 @@ evaluate_bound (stmtblock_t *block, tree *bounds, gfc_expr ** values,
       gfc_add_block_to_block (block, &se.pre);
       *output = se.expr;
     }
-  else if (deferred)
+  else if (deferred && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
     {
       /* The gfc_conv_array_lbound () routine returns a constant zero for
-        deferred length arrays, which in the scalarizer wrecks havoc, when
+        deferred length arrays, which in the scalarizer wreaks havoc, when
         copying to a (newly allocated) one-based array.
         Keep returning the actual result in sync for both bounds.  */
       *output = lbound ? gfc_conv_descriptor_lbound_get (desc,

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index e189d4b838aa83029af730ee499be325f882c0dc..a514461a8051db70aa3a88b9c04681724b2f6062 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-01-01  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/68864
+       * gfortran.dg/pr68864.f90: New test.
+
 2016-01-01  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/69070
@@ -8,7 +13,7 @@
 
        PR target/69015
        * gcc.dg/pr69015.c: New test.
-\f
+
 Copyright (C) 2016 Free Software Foundation, Inc.
 
 Copying and distribution of this file, with or without modification,

diff --git a/gcc/testsuite/gfortran.dg/pr68864.f90 b/gcc/testsuite/gfortran.dg/pr68864.f90
new file mode 100644 (file)
index 0000000..151dfb2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr68864.f90
@@ -0,0 +1,43 @@
+! { dg-do compile }
+!
+! Contributed by Hossein Talebi  <talebi.hossein@gmail.com>
+!
+!
+Module part_base2_class
+
+    implicit none
+
+    type :: ty_moc1
+        integer l
+    end type ty_moc1
+    integer,parameter ::  MAX_NUM_ELEMENT_TYPE=32
+
+    type :: ty_element_index2
+
+        class(ty_moc1),allocatable :: element
+        class(ty_moc1),allocatable :: element_th(:)
+
+    endtype ty_element_index2
+
+    type :: ty_part_base2
+        type(ty_element_index2)::element_index(MAX_NUM_ELEMENT_TYPE)
+    end type ty_part_base2
+
+    class(ty_part_base2),allocatable ::  part_tmp_obj
+
+End Module part_base2_class
+
+    use part_base2_class
+    allocate (part_tmp_obj)
+    allocate (part_tmp_obj%element_index(1)%element, source = ty_moc1(1))
+    allocate (part_tmp_obj%element_index(1)%element_th(1), source = ty_moc1(99))
+    allocate (part_tmp_obj%element_index(32)%element_th(1), source = ty_moc1(999))
+
+    do i = 1, MAX_NUM_ELEMENT_TYPE
+      if (allocated (part_tmp_obj%element_index(i)%element_th)) then
+        print *, i, part_tmp_obj%element_index(i)%element_th(1)%l
+      end if
+    end do
+    deallocate (part_tmp_obj)
+
+end