Dear Dominique and Janne,
Putting the problem right turned out to be trivial. In the part of the
patch in gfc_conv_array_ref, what was being passed as 'decl' , in the
failing test from PR82617 was indeed an indirect reference. Applying
one dollop of indirection fixed it. The original testcase from PR82617
has been added to make sure that this does not break again. I also,
did the fold_convert, as recommended by Janne.
Committed as revision 264724 after regtesting.
Paul
2018-09-30 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/70752
PR fortran/72709
* trans-array.c (gfc_conv_scalarized_array_ref): If this is a
deferred type and the info->descriptor is present, use the
info->descriptor
(gfc_conv_array_ref): Is the se expr is a descriptor type, pass
it as 'decl' rather than the symbol backend_decl.
(gfc_array_allocate): If the se string_length is a component
reference, fix it and use it for the expression string length
if the latter is not a variable type. If it is a variable do
an assignment. Make use of component ref string lengths to set
the descriptor 'span'.
(gfc_conv_expr_descriptor): For pointer assignment, do not set
the span field if gfc_get_array_span returns zero.
* trans.c (get_array_span): If the upper bound a character type
is zero, use the descriptor span if available.
2018-09-30 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/70752
PR fortran/72709
* gfortran.dg/deferred_character_25.f90 : New test.
* gfortran.dg/deferred_character_26.f90 : New test.
* gfortran.dg/deferred_character_27.f90 : New test to verify
that PR82617 remains fixed.
On Sun, 30 Sep 2018 at 09:02, Paul Richard Thomas
<paul.richard.tho...@gmail.com> wrote:
>
> Hi Dominique,
>
> It's the patch for pr70752 that causes the trouble, which I had
> guessed from the point in trans.c where the ICE occurs. I am onto it.
>
> Thanks again
>
> Paul
>
> On Wed, 26 Sep 2018 at 16:52, Dominique d'Humières <domi...@lps.ens.fr> wrote:
> >
> > > Is se->string_length guaranteed to be of type gfc_array_index_type_here?
> > > If so, why? And if not, maybe a fold_convert is in order?
> >
> > I don’t know if this related, but if I build gfortran with the patches for
> > PRs 70752 and 72709, 70149, and 65677 with --enable-checking=yes, compiling
> > the test in pr82617 gives an ICE:
> >
> > pr82617.f90:68:0:
> >
> > 68 | items(i_item) = str(i0:i1-1)
> > |
> > internal compiler error: tree check: expected tree that contains 'decl
> > minimal' structure, have 'indirect_ref' in get_array_span, at
> > fortran/trans.c:301
> >
> > Cheers,
> >
> > Dominique
> >
>
>
> --
> "If you can't explain it simply, you don't understand it well enough"
> - Albert Einstein
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 264720)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_scalarized_array_ref (gfc_se *
*** 3423,3429 ****
/* A pointer array component can be detected from its field decl. Fix
the descriptor, mark the resulting variable decl and pass it to
gfc_build_array_ref. */
! if (is_pointer_array (info->descriptor))
{
if (TREE_CODE (info->descriptor) == COMPONENT_REF)
decl = info->descriptor;
--- 3423,3431 ----
/* A pointer array component can be detected from its field decl. Fix
the descriptor, mark the resulting variable decl and pass it to
gfc_build_array_ref. */
! if (is_pointer_array (info->descriptor)
! || (expr && expr->ts.deferred && info->descriptor
! && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (info->descriptor))))
{
if (TREE_CODE (info->descriptor) == COMPONENT_REF)
decl = info->descriptor;
*************** gfc_conv_array_ref (gfc_se * se, gfc_arr
*** 3676,3682 ****
else if (expr->ts.deferred
|| (sym->ts.type == BT_CHARACTER
&& sym->attr.select_type_temporary))
! decl = sym->backend_decl;
else if (sym->ts.type == BT_CLASS)
decl = NULL_TREE;
--- 3678,3693 ----
else if (expr->ts.deferred
|| (sym->ts.type == BT_CHARACTER
&& sym->attr.select_type_temporary))
! {
! if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se->expr)))
! {
! decl = se->expr;
! if (TREE_CODE (decl) == INDIRECT_REF)
! decl = TREE_OPERAND (decl, 0);
! }
! else
! decl = sym->backend_decl;
! }
else if (sym->ts.type == BT_CLASS)
decl = NULL_TREE;
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5761,5766 ****
--- 5772,5790 ----
overflow = integer_zero_node;
+ if (expr->ts.type == BT_CHARACTER
+ && TREE_CODE (se->string_length) == COMPONENT_REF
+ && expr->ts.u.cl->backend_decl != se->string_length)
+ {
+ if (VAR_P (expr->ts.u.cl->backend_decl))
+ gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl,
+ fold_convert (TREE_TYPE (expr->ts.u.cl->backend_decl),
+ se->string_length));
+ else
+ expr->ts.u.cl->backend_decl = gfc_evaluate_now (se->string_length,
+ &se->pre);
+ }
+
gfc_init_block (&set_descriptor_block);
/* Take the corank only from the actual ref and not from the coref. The
later will mislead the generation of the array dimensions for allocatable/
*************** gfc_array_allocate (gfc_se * se, gfc_exp
*** 5850,5859 ****
/* Pointer arrays need the span field to be set. */
if (is_pointer_array (se->expr)
|| (expr->ts.type == BT_CLASS
! && CLASS_DATA (expr)->attr.class_pointer))
{
if (expr3 && expr3_elem_size != NULL_TREE)
tmp = expr3_elem_size;
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (se->expr)));
tmp = fold_convert (gfc_array_index_type, tmp);
--- 5874,5899 ----
/* Pointer arrays need the span field to be set. */
if (is_pointer_array (se->expr)
|| (expr->ts.type == BT_CLASS
! && CLASS_DATA (expr)->attr.class_pointer)
! || (expr->ts.type == BT_CHARACTER
! && TREE_CODE (se->string_length) == COMPONENT_REF))
{
if (expr3 && expr3_elem_size != NULL_TREE)
tmp = expr3_elem_size;
+ else if (se->string_length
+ && TREE_CODE (se->string_length) == COMPONENT_REF)
+ {
+ if (expr->ts.kind != 1)
+ {
+ tmp = build_int_cst (gfc_array_index_type, expr->ts.kind);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, tmp,
+ fold_convert (gfc_array_index_type,
+ se->string_length));
+ }
+ else
+ tmp = se->string_length;
+ }
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (se->expr)));
tmp = fold_convert (gfc_array_index_type, tmp);
*************** gfc_conv_expr_descriptor (gfc_se *se, gf
*** 7086,7092 ****
/* ....and set the span field. */
tmp = gfc_get_array_span (desc, expr);
! if (tmp != NULL_TREE)
gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
}
else if (se->want_pointer)
--- 7126,7132 ----
/* ....and set the span field. */
tmp = gfc_get_array_span (desc, expr);
! if (tmp != NULL_TREE && !integer_zerop (tmp))
gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
}
else if (se->want_pointer)
Index: gcc/fortran/trans.c
===================================================================
*** gcc/fortran/trans.c (revision 264720)
--- gcc/fortran/trans.c (working copy)
*************** get_array_span (tree type, tree decl)
*** 307,312 ****
--- 307,321 ----
TYPE_SIZE_UNIT (TREE_TYPE (type))),
span);
}
+ else if (type && TREE_CODE (type) == ARRAY_TYPE
+ && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE
+ && integer_zerop (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+ {
+ if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl)))
+ span = gfc_conv_descriptor_span_get (decl);
+ else
+ span = NULL_TREE;
+ }
/* Likewise for class array or pointer array references. */
else if (TREE_CODE (decl) == FIELD_DECL
|| VAR_OR_FUNCTION_DECL_P (decl)
Index: gcc/testsuite/gfortran.dg/deferred_character_25.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_25.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/deferred_character_25.f90 (working copy)
***************
*** 0 ****
--- 1,34 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR70752 in which the type of the component 'c' is cast
+ ! as character[1:0], which makes it slightly more difficult than usual to
+ ! obtain the element length. This is one and the same bug as PR72709.
+ !
+ ! Contributed by Gilbert Scott <gilbert.sc...@easynet.co.uk>
+ !
+ PROGRAM TEST
+ IMPLICIT NONE
+ INTEGER, PARAMETER :: I = 3
+ character (len = i), parameter :: str(5) = ['abc','cde','fgh','ijk','lmn']
+
+ TYPE T
+ CHARACTER(LEN=:), ALLOCATABLE :: C(:)
+ END TYPE T
+ TYPE(T), TARGET :: S
+ CHARACTER (LEN=I), POINTER :: P(:)
+
+ ALLOCATE ( CHARACTER(LEN=I) :: S%C(5) )
+ s%c = str
+
+ ! This PR uncovered several problems associated with determining the
+ ! element length and indexing. Test fairly thoroughly!
+ if (SIZE(S%C, 1) .ne. 5) stop 1
+ if (LEN(S%C) .ne. 3) stop 2
+ if (any (s%c .ne. str)) stop 3
+ if (s%c(3) .ne. str(3)) stop 4
+ P => S%C
+ if (SIZE(p, 1) .ne. 5) stop 5
+ if (LEN(p) .ne. 3) stop 6
+ if (any (p .ne. str)) stop 7
+ if (p(5) .ne. str(5)) stop 8
+ END PROGRAM TEST
Index: gcc/testsuite/gfortran.dg/deferred_character_26.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_26.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/deferred_character_26.f90 (working copy)
***************
*** 0 ****
--- 1,42 ----
+ ! { dg-do run }
+ !
+ ! Test the fix for PR72709 in which the type of the component 'header' is cast
+ ! as character[1:0], which makes it slightly more difficult than usual to
+ ! obtain the element length. This is one and the same bug as PR70752.
+ !
+ ! Contributed by 'zmi' <zmi...@gmail.com>
+ !
+ program read_exp_data
+ implicit none
+
+ type experimental_data_t
+ integer :: nh = 0
+ character(len=:), dimension(:), allocatable :: header
+
+ end type experimental_data_t
+
+ character(*), parameter :: str(3) = ["#Generated by X ", &
+ "#from file 'Y' ", &
+ "# Experimental 4 mg/g"]
+ type(experimental_data_t) :: ex
+ integer :: nh_len
+ integer :: i
+
+
+ nh_len = 255
+ ex % nh = 3
+ allocate(character(len=nh_len) :: ex % header(ex % nh))
+
+ ex % header(1) = str(1)
+ ex % header(2) = str(2)
+ ex % header(3) = str(3)
+
+ ! Test that the string length is OK
+ if (len (ex%header) .ne. nh_len) stop 1
+
+ ! Test the array indexing
+ do i = 1, ex % nh
+ if (trim (ex%header(i)) .ne. trim (str(i))) stop i + 1
+ enddo
+
+ end program read_exp_data
Index: gcc/testsuite/gfortran.dg/deferred_character_27.f90
===================================================================
*** gcc/testsuite/gfortran.dg/deferred_character_27.f90 (nonexistent)
--- gcc/testsuite/gfortran.dg/deferred_character_27.f90 (working copy)
***************
*** 0 ****
--- 1,87 ----
+ ! { dg-do compile }
+ !
+ ! Make sure that PR82617 remains fixed. The first attempt at a
+ ! fix for PR70752 cause this to ICE at the point indicated below.
+ !
+ ! Contributed by Ogmundur Petersson <uberprugelkn...@hotmail.com>
+ !
+ MODULE test
+
+ IMPLICIT NONE
+
+ PRIVATE
+ PUBLIC str_words
+
+ !> Characters that are considered whitespace.
+ CHARACTER(len=*), PARAMETER :: strwhitespace = &
+ char(32)//& ! space
+ char(10)//& ! new line
+ char(13)//& ! carriage return
+ char( 9)//& ! horizontal tab
+ char(11)//& ! vertical tab
+ char(12) ! form feed (new page)
+
+ CONTAINS
+
+ ! -------------------------------------------------------------------
+ !> Split string into words separated by arbitrary strings of whitespace
+ !> characters (space, tab, newline, return, formfeed).
+ FUNCTION str_words(str,white) RESULT(items)
+ CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: items
+ CHARACTER(len=*), INTENT(in) :: str !< String to split.
+ CHARACTER(len=*), INTENT(in) :: white ! Whitespace characters.
+
+ items = strwords_impl(str,white)
+
+ END FUNCTION str_words
+
+ ! -------------------------------------------------------------------
+ !>Implementation of str_words
+ !> characters (space, tab, newline, return, formfeed).
+ FUNCTION strwords_impl(str,white) RESULT(items)
+ CHARACTER(len=:), DIMENSION(:), ALLOCATABLE :: items
+ CHARACTER(len=*), INTENT(in) :: str !< String to split.
+ CHARACTER(len=*), INTENT(in) :: white ! Whitespace characters.
+
+ INTEGER :: i0,i1,n
+ INTEGER :: l_item,i_item,n_item
+
+ n = verify(str,white,.TRUE.)
+ IF (n>0) THEN
+ n_item = 0
+ l_item = 0
+ i1 = 0
+ DO
+ i0 = verify(str(i1+1:n),white)+i1
+ i1 = scan(str(i0+1:n),white)
+ n_item = n_item+1
+ IF (i1>0) THEN
+ l_item = max(l_item,i1)
+ i1 = i0+i1
+ ELSE
+ l_item = max(l_item,n-i0+1)
+ EXIT
+ END IF
+ END DO
+ ALLOCATE(CHARACTER(len=l_item)::items(n_item))
+ i_item = 0
+ i1 = 0
+ DO
+ i0 = verify(str(i1+1:n),white)+i1
+ i1 = scan(str(i0+1:n),white)
+ i_item = i_item+1
+ IF (i1>0) THEN
+ i1 = i0+i1
+ items(i_item) = str(i0:i1-1)
+ ELSE
+ items(i_item) = str(i0:n)
+ EXIT
+ END IF
+ END DO
+ ELSE
+ ALLOCATE(CHARACTER(len=0)::items(0))
+ END IF
+
+ END FUNCTION strwords_impl
+
+ END MODULE test
