From 950ab3f1419619d6e4bec7d2f029b9aff00813e9 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sat, 10 Feb 2018 18:16:14 +0000 Subject: [PATCH] re PR fortran/84141 (Internal error: type_name(): Bad type) 2018-02-10 Paul Thomas PR fortran/84141 PR fortran/84155 * trans-array.c (gfc_array_init_size): Revert the change made in revision 257356 setting the dtype. * trans-types.c (gfc_get_dtype): Do not use the cached dtype. Call gfc_get_dtype_rank_type every time. PR fortran/56691 * trans-array.c (gfc_conv_expr_descriptor): If the source array is a descriptor type, use its offset, removing the condition that is be a class expression. 2018-02-10 Paul Thomas PR fortran/56691 * gfortran.dg/type_to_class_4.f03: New test. From-SVN: r257550 --- gcc/fortran/ChangeLog | 14 ++++++++ gcc/fortran/trans-array.c | 10 +++--- gcc/fortran/trans-types.c | 3 -- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/type_to_class_4.f03 | 35 +++++++++++++++++++ 5 files changed, 59 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/type_to_class_4.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a87c48a3ff8..b0bd14f1839 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2018-02-10 Paul Thomas + + PR fortran/84141 + PR fortran/84155 + * trans-array.c (gfc_array_init_size): Revert the change made + in revision 257356 setting the dtype. + * trans-types.c (gfc_get_dtype): Do not use the cached dtype. + Call gfc_get_dtype_rank_type every time. + + PR fortran/56691 + * trans-array.c (gfc_conv_expr_descriptor): If the source array + is a descriptor type, use its offset, removing the condition + that is be a class expression. + 2018-02-07 Steven G. Kargl PR fortran/82994 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index c845befb5d0..d8b4381251e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5354,8 +5354,8 @@ gfc_array_init_size (tree descriptor, int rank, int corank, tree * poffset, } else { - tmp = gfc_get_dtype_rank_type (rank, gfc_get_element_type (type)); - gfc_add_modify (pblock, gfc_conv_descriptor_dtype (descriptor), tmp); + tmp = gfc_conv_descriptor_dtype (descriptor); + gfc_add_modify (pblock, tmp, gfc_get_dtype (type)); } or_expr = logical_false_node; @@ -7529,9 +7529,9 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr) : base; gfc_conv_descriptor_offset_set (&loop.pre, parm, tmp); } - else if (IS_CLASS_ARRAY (expr) && !se->data_not_needed - && (!rank_remap || se->use_offset) - && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc))) + else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)) + && !se->data_not_needed + && (!rank_remap || se->use_offset)) { gfc_conv_descriptor_offset_set (&loop.pre, parm, gfc_conv_descriptor_offset_get (desc)); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index b15a4b25952..697b7354e1b 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1593,9 +1593,6 @@ gfc_get_dtype (tree type) gcc_assert (GFC_DESCRIPTOR_TYPE_P (type) || GFC_ARRAY_TYPE_P (type)); - if (GFC_TYPE_ARRAY_DTYPE (type)) - return GFC_TYPE_ARRAY_DTYPE (type); - rank = GFC_TYPE_ARRAY_RANK (type); etype = gfc_get_element_type (type); dtype = gfc_get_dtype_rank_type (rank, etype); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index e899f5653f4..a14db69e416 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-02-10 Paul Thomas + + PR fortran/56691 + * gfortran.dg/type_to_class_4.f03: New test. + 2018-02-10 Alan Modra PR target/84300 diff --git a/gcc/testsuite/gfortran.dg/type_to_class_4.f03 b/gcc/testsuite/gfortran.dg/type_to_class_4.f03 new file mode 100644 index 00000000000..196e4481de4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/type_to_class_4.f03 @@ -0,0 +1,35 @@ +! { dg-do run } +! +! Test the fix for PR56691 comment #7 (and comment #0). +! +! Reduced from the original of Marco Restelli +! by Janus Weil +! +module m2 + implicit none + type :: t_stv + real :: f1 + end type +contains + subroutine lcb(y) + class(t_stv), intent(in) :: y(:) + integer :: k + do k=1,size(y) + if (int(y(k)%f1) .ne. k) call abort + enddo + end subroutine +end module + +program test + use m2 + implicit none + + type(t_stv), allocatable :: work(:) + + allocate(work(4)) + work(:)%f1 = (/ 1.,2.,3.,4./) + + call lcb(work) + call lcb(work(:4)) ! Indexing used to be offset by 1. + +end program -- 2.30.2