* [Patch, fortran] PR/97045 A wrong column is selected when addressing individual elements of unlimited polymorphic dummy argument
@ 2020-09-27 14:50 dhumieres.dominique
0 siblings, 0 replies; 3+ messages in thread
From: dhumieres.dominique @ 2020-09-27 14:50 UTC (permalink / raw)
To: paul.richard.thomas; +Cc: fortran
Hi Paull,
Your patch works as expected and AFAICT it also fixes the ICEs for the
tests in PR79426.
Thanks for the patch.
Dominique
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Patch, fortran] PR/97045 A wrong column is selected when addressing individual elements of unlimited polymorphic dummy argument
2020-09-25 15:50 Paul Richard Thomas
@ 2020-10-04 10:29 ` Thomas Koenig
0 siblings, 0 replies; 3+ messages in thread
From: Thomas Koenig @ 2020-10-04 10:29 UTC (permalink / raw)
To: Paul Richard Thomas, fortran, gcc-patches; +Cc: Gayday, Igor
Hi Paul,
> Regtests on FC31/x86_64 - OK for master?
OK.
You're quite right that trans-* is chock full of special-case
handling (which I also found out, again, working together
with Nicolas on the shared memory coarrays).
Cleaning that up would be a worthwile job, although probably
quite big :-(
Best regards
Thomas
^ permalink raw reply [flat|nested] 3+ messages in thread
* [Patch, fortran] PR/97045 A wrong column is selected when addressing individual elements of unlimited polymorphic dummy argument
@ 2020-09-25 15:50 Paul Richard Thomas
2020-10-04 10:29 ` Thomas Koenig
0 siblings, 1 reply; 3+ messages in thread
From: Paul Richard Thomas @ 2020-09-25 15:50 UTC (permalink / raw)
To: fortran, gcc-patches; +Cc: Gayday, Igor
[-- Attachment #1: Type: text/plain, Size: 1453 bytes --]
Hi All,
The original testcase turned out to be relatively easy to fix - the chunks
in trans-expr.c and trans-stmt.c do this. However, I tested character
actual arguments to 'write_array' in the testcase and found that the _len
component of the unlimited polymorphic dummy was not being used for the
selector and so the payloads were being treated as if they were
character(len = 1). The fix for this part of the problem further
complicates the building of array references. It looks to me as if
rationalizing this part of the trans-* part of gfortran is quite a
significant TODO, since it is now little more than bandaid on sticking
plaster! I will flag this up in a new PR.
Regtests on FC31/x86_64 - OK for master?
Paul
This patch fixes PR97045 - unlimited polymorphic array element selectors.
2020-25-09 Paul Thomas <pault@gcc.gnu.org>
gcc/fortran
PR fortran/97045
* trans-array.c (gfc_conv_array_ref): Make sure that the class
decl is passed to build_array_ref in the case of unlimited
polymorphic entities.
* trans-expr.c (gfc_conv_derived_to_class): Ensure that array
refs do not preceed the _len component. Free the _len expr.
* trans-stmt.c (trans_associate_var): Reset 'need_len_assign'
for polymorphic scalars.
* trans.c (gfc_build_array_ref): When the vptr size is used for
span, multiply by the _len field of unlimited polymorphic
entities, when non-zero.
gcc/testsuite/
PR fortran/97045
* gfortran.dg/select_type_50.f90 : New test.
[-- Attachment #2: submit.diff --]
[-- Type: text/x-patch, Size: 3171 bytes --]
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 6566c47d4ae..998d4d4ed9b 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3787,7 +3787,20 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
decl = sym->backend_decl;
}
else if (sym->ts.type == BT_CLASS)
- decl = NULL_TREE;
+ {
+ if (UNLIMITED_POLY (sym))
+ {
+ gfc_expr *class_expr = gfc_find_and_cut_at_last_class_ref (expr);
+ gfc_init_se (&tmpse, NULL);
+ gfc_conv_expr (&tmpse, class_expr);
+ if (!se->class_vptr)
+ se->class_vptr = gfc_class_vptr_get (tmpse.expr);
+ gfc_free_expr (class_expr);
+ decl = tmpse.expr;
+ }
+ else
+ decl = NULL_TREE;
+ }
se->expr = build_array_ref (se->expr, offset, decl, se->class_vptr);
}
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index a690839f591..2c31ec9bf01 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -728,7 +728,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
gfc_expr *len;
gfc_se se;
- len = gfc_copy_expr (e);
+ len = gfc_find_and_cut_at_last_class_ref (e);
gfc_add_len_component (len);
gfc_init_se (&se, NULL);
gfc_conv_expr (&se, len);
@@ -739,6 +739,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
integer_zero_node));
else
tmp = se.expr;
+ gfc_free_expr (len);
}
else
tmp = integer_zero_node;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 389fec7227e..adc6b8fefb5 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -2091,6 +2091,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
/* Obtain a temporary class container for the result. */
gfc_conv_derived_to_class (&se, e, sym->ts, tmp, false, false);
se.expr = build_fold_indirect_ref_loc (input_location, se.expr);
+ need_len_assign = false;
}
else
{
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ed054261452..8caa625ab0e 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -429,7 +429,28 @@ gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
/* If decl or vptr are non-null, pointer arithmetic for the array reference
is likely. Generate the 'span' for the array reference. */
if (vptr)
- span = gfc_vptr_size_get (vptr);
+ {
+ span = gfc_vptr_size_get (vptr);
+
+ /* Check if this is an unlimited polymorphic object carrying a character
+ payload. In this case, the 'len' field is non-zero. */
+ if (decl && GFC_CLASS_TYPE_P (TREE_TYPE (decl)))
+ {
+ tmp = gfc_class_len_or_zero_get (decl);
+ if (!integer_zerop (tmp))
+ {
+ tree cond;
+ tree stype = TREE_TYPE (span);
+ tmp = fold_convert (stype, tmp);
+ cond = fold_build2_loc (input_location, EQ_EXPR,
+ logical_type_node, tmp,
+ build_int_cst (stype, 0));
+ tmp = fold_build2 (MULT_EXPR, stype, span, tmp);
+ span = fold_build3_loc (input_location, COND_EXPR, stype,
+ cond, span, tmp);
+ }
+ }
+ }
else if (decl)
span = get_array_span (type, decl);
[-- Attachment #3: select_type_50.f90 --]
[-- Type: text/x-fortran, Size: 1394 bytes --]
! { dg-do run }
!
! Test the fix for PR97045. The report was for the INTEGER version. Testing
! revealed a further bug with the character versions.
!
! Contributed by Igor Gayday <igor.gayday@mu.edu>
!
program test_prg
implicit none
integer :: i
integer, allocatable :: arr(:, :)
character(kind = 1, len = 2), allocatable :: chr(:, :)
character(kind = 4, len = 2), allocatable :: chr4(:, :)
arr = reshape ([(i, i = 1, 9)], [3, 3])
do i = 1, 3
call write_array(arr(1:2, i), i)
end do
chr = reshape([(char (i)//char (i+1), i = 65, 83, 2)], [3, 3])
do i = 1, 3
call write_array (chr(1:2, i), i)
end do
chr4 = reshape([(char (i, kind = 4)//char (i+1, kind = 4), i = 65, 83, 2)], &
[3, 3])
do i = 1, 3
call write_array (chr4(1:2, i), i)
end do
contains
subroutine write_array(array, j)
class(*), intent(in) :: array(:)
integer :: i = 2
integer :: j, k
select type (elem => array(i))
type is (integer)
k = 3*(j-1)+i
if (elem .ne. k) stop 1
type is (character(kind = 1, len = *))
k = 63 + 2*(3*(j-1)+i)
if (elem .ne. char (k)//char (k+1)) print *, elem, " ", char (k)//char (k+1)
type is (character(kind = 4, len = *))
k = 63 + 2*(3*(j-1)+i)
if (elem .ne. char (k, kind = 4)//char (k+1, kind = 4)) stop 3
end select
end subroutine
end program
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2020-10-04 10:30 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-09-27 14:50 [Patch, fortran] PR/97045 A wrong column is selected when addressing individual elements of unlimited polymorphic dummy argument dhumieres.dominique
-- strict thread matches above, loose matches on Subject: below --
2020-09-25 15:50 Paul Richard Thomas
2020-10-04 10:29 ` Thomas Koenig
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).