From 591bb5e4bf6b9a75175b162bcf9d22bcae2b5abf Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 1 Jan 2016 17:02:51 +0000 Subject: [PATCH] re PR fortran/68864 (ICE: in gfc_get_descriptor_dimension, at fortran/trans-array.c:268) 2016-01-01 Paul Thomas 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 PR fortran/68864 * gfortran.dg/pr68864.f90: New test. From-SVN: r232026 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/trans-array.c | 4 +-- gcc/testsuite/ChangeLog | 7 ++++- gcc/testsuite/gfortran.dg/pr68864.f90 | 43 +++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr68864.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 668a04302db..0e7bf72638b 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2016-01-01 Paul Thomas + + 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 PR fortran/69011 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 71e04822075..287b4af3327 100644 --- 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 e189d4b838a..a514461a805 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-01-01 Paul Thomas + + PR fortran/68864 + * gfortran.dg/pr68864.f90: New test. + 2016-01-01 Jakub Jelinek PR tree-optimization/69070 @@ -8,7 +13,7 @@ PR target/69015 * gcc.dg/pr69015.c: New test. - + 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 index 00000000000..151dfb2c2ff --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr68864.f90 @@ -0,0 +1,43 @@ +! { dg-do compile } +! +! Contributed by Hossein Talebi +! +! +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