https://gcc.gnu.org/bugzilla/show_bug.cgi?id=127612
Bug ID: 127612
Summary: Rank-remapping pointer assignment can incorrectly set
the span
Product: gcc
Version: 17.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: mikael at gcc dot gnu.org
Target Milestone: ---
The assignment of span in a rank-remapping pointer assignment is implemented
as:
11956 /* Copy the span. */
11957 if (VAR_P (rse.expr)
11958 && GFC_DECL_PTR_ARRAY_P (rse.expr))
11959 span = gfc_conv_descriptor_span_get (rse.expr);
11960 else
11961 {
11962 tmp = TREE_TYPE (rse.expr);
11963 tmp = TYPE_SIZE_UNIT (gfc_get_element_type (tmp));
11964 span = fold_convert (gfc_array_index_type, tmp);
11965 }
11966 gfc_conv_descriptor_span_set (&block, desc, span);
This copies the span from the descriptor if the target is a pointer, and
otherwise uses the type size. This fails to handle the case of non-pointer
polymorphic values.
Here is a testcase:
program prog
implicit none
integer, parameter :: n = 5
type :: t1
integer :: c1, c2
end type
type, extends(t1) :: t2
integer :: c3
end type
class(t1), allocatable, target :: a(:)
class(t1), pointer :: p0(:), p1(:)
integer :: i
a = [t2 :: (t2(7*i+5,3*i+2,i), i=1,n) ]
p0(1:n) => a
p1(1:n) => p0
call sub(a, [ 12, 19, 26, 33, 40 ], [ 5, 8, 11, 14, 17 ], 1)
a = [t2 :: (t2(3*i*i+2,i*i,i), i=1,n) ]
call sub(a, [ 5, 14, 29, 50, 77 ], [ 1, 4, 9, 16, 25 ], 2)
contains
subroutine sub(x, v1, v2, e)
class(t1), target, intent(in) :: x(:)
integer, intent(in) :: v1(:), v2(:), e
class(t1), contiguous, pointer :: q0(:), q1(:)
call check(a , v1, v2, e*10+1)
call check(p0, v1, v2, e*10+2)
call check(p1, v1, v2, e*10+3)
call check(x , v1, v2, e*10+6)
q0(1:n) => x
call check(q0, v1, v2, e*10+7)
q1(1:n) => q0
call check(q1, v1, v2, e*10+8)
end subroutine
subroutine check(a, v1, v2, e)
type(t1), target, intent(in) :: a(:)
integer, intent(in) :: v1(:), v2(:), e
call compare(a%c1, v1, e*10+1)
call compare(a%c2, v2, e*10+2)
end subroutine
subroutine compare(a, r, e)
integer, intent(in) :: a(:), r(:)
integer, intent(in) :: e
if (size(a, dim=1) /= size(r, dim=1)) error stop e*10+9
do i = 1, size(a,dim=1)
print *, e*10+i, (a(i) == r(i) ? "PASS" : "FAIL"), a(i), r(i)
end do
!if (any(a%c1 /= [ 12, 19, 26, 33, 40 ])) error stop e*10+1
end subroutine
end program
When run, it shows the following output:
1111 PASS 12 12
1112 PASS 19 19
1113 PASS 26 26
1114 PASS 33 33
1115 PASS 40 40
1121 PASS 5 5
1122 PASS 8 8
1123 PASS 11 11
1124 PASS 14 14
1125 PASS 17 17
1211 PASS 12 12
1212 FAIL 1 19
1213 FAIL 8 26
1214 FAIL 26 33
1215 FAIL 3 40
1221 PASS 5 5
1222 FAIL 19 8
1223 FAIL 2 11
1224 FAIL 11 14
1225 FAIL 33 17
1311 PASS 12 12
1312 FAIL 1 19
1313 FAIL 8 26
1314 FAIL 26 33
1315 FAIL 3 40
1321 PASS 5 5
1322 FAIL 19 8
1323 FAIL 2 11
1324 FAIL 11 14
1325 FAIL 33 17
1611 PASS 12 12
1612 PASS 19 19
1613 PASS 26 26
1614 PASS 33 33
1615 PASS 40 40
1621 PASS 5 5
1622 PASS 8 8
1623 PASS 11 11
1624 PASS 14 14
1625 PASS 17 17
1711 PASS 12 12
1712 FAIL 1 19
1713 FAIL 8 26
1714 FAIL 26 33
1715 FAIL 3 40
1721 PASS 5 5
1722 FAIL 19 8
1723 FAIL 2 11
1724 FAIL 11 14
1725 FAIL 33 17
1811 PASS 12 12
1812 FAIL 1 19
1813 FAIL 8 26
1814 FAIL 26 33
1815 FAIL 3 40
1821 PASS 5 5
1822 FAIL 19 8
1823 FAIL 2 11
1824 FAIL 11 14
1825 FAIL 33 17
2111 PASS 5 5
2112 PASS 14 14
2113 PASS 29 29
2114 PASS 50 50
2115 PASS 77 77
2121 PASS 1 1
2122 PASS 4 4
2123 PASS 9 9
2124 PASS 16 16
2125 PASS 25 25
2211 PASS 5 5
2212 FAIL 1 14
2213 FAIL 4 29
2214 FAIL 29 50
2215 FAIL 3 77
2221 PASS 1 1
2222 FAIL 14 4
2223 FAIL 2 9
2224 FAIL 9 16
2225 FAIL 50 25
2311 PASS 5 5
2312 FAIL 1 14
2313 FAIL 4 29
2314 FAIL 29 50
2315 FAIL 3 77
2321 PASS 1 1
2322 FAIL 14 4
2323 FAIL 2 9
2324 FAIL 9 16
2325 FAIL 50 25
2611 PASS 5 5
2612 PASS 14 14
2613 PASS 29 29
2614 PASS 50 50
2615 PASS 77 77
2621 PASS 1 1
2622 PASS 4 4
2623 PASS 9 9
2624 PASS 16 16
2625 PASS 25 25
2711 PASS 5 5
2712 FAIL 1 14
2713 FAIL 4 29
2714 FAIL 29 50
2715 FAIL 3 77
2721 PASS 1 1
2722 FAIL 14 4
2723 FAIL 2 9
2724 FAIL 9 16
2725 FAIL 50 25
2811 PASS 5 5
2812 FAIL 1 14
2813 FAIL 4 29
2814 FAIL 29 50
2815 FAIL 3 77
2821 PASS 1 1
2822 FAIL 14 4
2823 FAIL 2 9
2824 FAIL 9 16
2825 FAIL 50 25
The expected output has only PASSes in the second column and equal values in
columns 3 and 4.
