Hi Harald,
The fix was trivial. An updated patch and testcase are attached.
Thanks
Paul
Fortran: Fix some deferred character problems in associate [PR109451]
2023-04-14 Paul Thomas <pa...@gcc.gnu.org>
gcc/fortran
PR fortran/109451
* trans-array.cc (gfc_conv_expr_descriptor): Guard expression
character length backend decl before using it. Suppress the
assignment if lhs equals rhs.
* trans-io.cc (gfc_trans_transfer): Scalarize transfer of
associate variables pointing to a variable. Add comment.
* trans-stmt.cc (trans_associate_var): Remove requirement that
the character length be deferred before assigning the value
returned by gfc_conv_expr_descriptor. Also, guard the backend
decl before testing with VAR_P.
gcc/testsuite/
PR fortran/109451
* gfortran.dg/associate_61.f90 : New test
On Thu, 13 Apr 2023 at 07:18, Paul Richard Thomas <
paul.richard.tho...@gmail.com> wrote:
> Hi Harald,
>
> That's interesting - the string length '.q' is not set for either of the
> associate blocks. I'm onto it.
>
> Thanks
>
> Paul
>
>
> On Wed, 12 Apr 2023 at 20:26, Harald Anlauf <anl...@gmx.de> wrote:
>
>> Hi Paul,
>>
>> On 4/12/23 17:25, Paul Richard Thomas via Gcc-patches wrote:
>> > Hi All,
>> >
>> > I think that the changelog says it all. OK for mainline?
>>
>> this looks almost fine, but still fails if one directly uses the
>> dummy argument as the ASSOCIATE target, as in:
>>
>> program p
>> implicit none
>> character(4) :: c(2) = ["abcd","efgh"]
>> call dcs0 (c)
>> ! call dcs0 (["abcd","efgh"])
>> contains
>> subroutine dcs0(a)
>> character(len=*), intent(in) :: a(:)
>> print *, size(a),len(a)
>> associate (q => a(:))
>> print *, size(q),len(q)
>> end associate
>> associate (q => a(:)(:))
>> print *, size(q),len(q)
>> end associate
>> return
>> end subroutine dcs0
>> end
>>
>> This prints e.g.
>>
>> 2 4
>> 2 0
>> 2 0
>>
>> (sometimes I also get junk values for the character length).
>>
>> Can you please have another look?
>>
>> Thanks,
>> Harald
>>
>>
>> > Paul
>> >
>> > Fortran: Fix some deferred character problems in associate [PR109451]
>> >
>> > 2023-04-07 Paul Thomas <pa...@gcc.gnu.org>
>> >
>> > gcc/fortran
>> > PR fortran/109451
>> > * trans-array.cc (gfc_conv_expr_descriptor): Guard expression
>> > character length backend decl before using it. Suppress the
>> > assignment if lhs equals rhs.
>> > * trans-io.cc (gfc_trans_transfer): Scalarize transfer of
>> > associate variables pointing to a variable. Add comment.
>> >
>> >
>> > gcc/testsuite/
>> > PR fortran/109451
>> > * gfortran.dg/associate_61.f90 : New test
>>
>>
>
> --
> "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
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e1725808033..7c0bcfe5cbb 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7934,8 +7934,12 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
else
tmp = se->string_length;
- if (expr->ts.deferred && VAR_P (expr->ts.u.cl->backend_decl))
- gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
+ if (expr->ts.deferred && expr->ts.u.cl->backend_decl
+ && VAR_P (expr->ts.u.cl->backend_decl))
+ {
+ if (expr->ts.u.cl->backend_decl != tmp)
+ gfc_add_modify (&se->pre, expr->ts.u.cl->backend_decl, tmp);
+ }
else
expr->ts.u.cl->backend_decl = tmp;
}
@@ -7998,7 +8002,13 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
}
}
}
-
+ if (expr->ts.type == BT_CHARACTER
+ && VAR_P (TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm)))))
+ {
+ tree elem_len = TYPE_SIZE_UNIT (gfc_get_element_type (TREE_TYPE (parm)));
+ gfc_add_modify (&loop.pre, elem_len,
+ fold_convert (TREE_TYPE (elem_len), gfc_get_array_span (desc, expr)));
+ }
/* Set the span field. */
tmp = NULL_TREE;
if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)))
diff --git a/gcc/fortran/trans-io.cc b/gcc/fortran/trans-io.cc
index 9b54d2f0d31..67658769b9e 100644
--- a/gcc/fortran/trans-io.cc
+++ b/gcc/fortran/trans-io.cc
@@ -2620,9 +2620,13 @@ gfc_trans_transfer (gfc_code * code)
gcc_assert (ref && ref->type == REF_ARRAY);
}
+ /* These expressions don't always have the dtype element length set
+ correctly, rendering them useless for array transfer. */
if (expr->ts.type != BT_CLASS
&& expr->expr_type == EXPR_VARIABLE
&& ((expr->symtree->n.sym->ts.type == BT_DERIVED && expr->ts.deferred)
+ || (expr->symtree->n.sym->assoc
+ && expr->symtree->n.sym->assoc->variable)
|| gfc_expr_attr (expr).pointer))
goto scalarize;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index f78875455a5..a1d8a26f64f 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -1930,15 +1930,13 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
gfc_conv_expr_descriptor (&se, e);
if (sym->ts.type == BT_CHARACTER
- && sym->ts.deferred
&& !sym->attr.select_type_temporary
+ && sym->ts.u.cl->backend_decl
&& VAR_P (sym->ts.u.cl->backend_decl)
&& se.string_length != sym->ts.u.cl->backend_decl)
- {
- gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
- fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
- se.string_length));
- }
+ gfc_add_modify (&se.pre, sym->ts.u.cl->backend_decl,
+ fold_convert (TREE_TYPE (sym->ts.u.cl->backend_decl),
+ se.string_length));
/* If we didn't already do the pointer assignment, set associate-name
descriptor to the one generated for the temporary. */
! { dg-do run }
! Test fixes for PR109451
! Contributed by Harald Anlauf <anl...@gcc.gnu.org>
!
program p
implicit none
character(4) :: c(2) = ["abcd","efgh"]
call dcs3 (c)
call dcs0 (c)
contains
subroutine dcs3 (a)
character(len=*), intent(in) :: a(:)
character(:), allocatable :: b(:)
b = a(:)
call test (b, a, 1)
associate (q => b(:)) ! no ICE but print repeated first element
call test (q, a, 2)
print *, q
q = q(:)(2:3)
end associate
call test (b, ["bc ","fg "], 4)
b = a(:)
associate (q => b(:)(:)) ! ICE
call test (q, a, 3)
associate (r => q(:)(1:3))
call test (r, a(:)(1:3), 5)
end associate
end associate
associate (q => b(:)(2:3))
call test (q, a(:)(2:3), 6)
end associate
end subroutine dcs3
! The associate vars in dsc0 had string length not set
subroutine dcs0 (a)
character(len=*), intent(in) :: a(:)
associate (q => a)
call test (q, a, 7)
end associate
associate (q => a(:))
call test (q, a, 8)
end associate
associate (q => a(:)(:))
call test (q, a, 9)
end associate
end subroutine dcs0
subroutine test (x, y, i)
character(len=*), intent(in) :: x(:), y(:)
integer, intent(in) :: i
if (any (x .ne. y)) stop i
end subroutine test
end program p
! { dg-output " abcdefgh" }
