https://gcc.gnu.org/bugzilla/show_bug.cgi?id=128033
Bug ID: 128033
Summary: Array allocation from polymorphic pointer source
ignores dynamic type
Product: gcc
Version: 17.0
Status: UNCONFIRMED
Keywords: wrong-code
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: mikael at gcc dot gnu.org
Target Milestone: ---
Testcase:
program prog
implicit none
integer, parameter :: n = 5
type :: t1
integer :: c1, c2
end type
type, extends(t1) :: t2
integer :: c3
end type
type(t2), target :: a(n)
integer :: i
a = [ (t2(2*i*i+3, i*i+2, 3*i+5), i=1,n) ]
call sub(a)
contains
subroutine sub(x)
class(t1), pointer, intent(in) :: x(:)
class(t1), allocatable :: a(:)
allocate(a, source=x)
call check_all(x, 1)
call check_all(a, 2)
end subroutine
subroutine check_all(x, e)
class(t1), target, intent(in) :: x(:)
integer, intent(in) :: e
select type(x)
type is (t2)
call check(x%c1, [ 5, 11, 21, 35, 53], e*10+1)
call check(x%c2, [ 3, 6, 11, 18, 27], e*10+2)
call check(x%c3, [ 8, 11, 14, 17, 20], e*10+3)
class default
error stop e*10+7
end select
end subroutine
subroutine check(x, y, e)
integer, target, dimension(:), intent(in) :: x, y
integer, intent(in) :: e
integer :: i
if (size(x) /= size(y)) error stop e*10+8
do i=1,size(x)
print *, e*10+i, (x(i) == y(i) ? "PASS" : "FAIL"), x(i), y(i)
end do
!if (any(x /= y)) error stop e*10+9
end subroutine
end program
When run, the program produces the output:
111 PASS 5 5
112 PASS 11 11
113 PASS 21 21
114 PASS 35 35
115 PASS 53 53
121 PASS 3 3
122 PASS 6 6
123 PASS 11 11
124 PASS 18 18
125 PASS 27 27
131 PASS 8 8
132 PASS 11 11
133 PASS 14 14
134 PASS 17 17
135 PASS 20 20
211 PASS 5 5
212 FAIL 8 11
213 FAIL 6 21
214 FAIL 21 35
215 FAIL 14 53
221 PASS 3 3
222 FAIL 11 6
223 PASS 11 11
224 FAIL 11 18
225 FAIL 35 27
231 PASS 8 8
232 FAIL 6 11
233 FAIL 21 14
234 FAIL 14 17
235 FAIL 18 20
The expected output would have PASS everywhere as second column and the same
values in columns 3 and 4.
In the generated code, a first temporary is made to hold the source content,
and in the copy from the temporary to the allocatable variable, the span used
to access the temporary is that of the declared type, not that of the dynamic
type:
D.5069 = (struct t1[0:] *) source.30.data;
(...)
{
integer(kind=8) S.34;
integer(kind=8) D.5078;
D.5078 = source.30.dim[0].stride;
S.34 = D.5071;
while (1)
{
if (S.34 > D.5072) goto L.8;
{
struct __vtype_prog_T1 * {ref-all} D.5079;
a._vptr = ctmp.28._vptr;
D.5079 = a._vptr;
a._vptr->_copy ((struct t1 *) D.5069 + (sizetype) ((S.34 *
D.5078 + D.5070) * 8), (struct t1 *) a._data.data + (sizetype) (((S.34 +
D.5076) + D.5073) * a._vptr->_size));
}
S.34 = S.34 + 1;
}
L.8:;
}
The problem comes from the base array passed to build_class_array_ref, which is
a pointer dereference from which the class container reference can't be
guessed. The allocate code goes into great complexity to transform
non-variables into temporary variables and produces this pointer dereference in
the end. Here the original source is a variable, but it is forced to pass
through the code converting to a temporary variable:
6730 /* When expr3 is a variable, i.e., a very simple expression, then
6731 convert it once here. If one has a source expression that has
6732 substring references, part-refs, or %re/%im inquiries, wrap
the
6733 entity in parentheses to force evaluation of the expression.
*/
6734 if (code->expr3->expr_type == EXPR_VARIABLE
6735 && is_subref_array (code->expr3))
6736 code->expr3 = gfc_get_parentheses (code->expr3);
As the source is a pointer, is_subref_array returns true and everything goes
downhill from that.
