https://gcc.gnu.org/bugzilla/show_bug.cgi?id=128399
Bug ID: 128399
Summary: Allocate with a polymorphic source wrapped in
parenthesis incorrectly initializes the array
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: ---
This is a follow-up to PR128033.
The fix for that PR, r17-5758, removed a forced wrapping in parenthesis which
was causing a temporary array to be generated, which was bogusly handled.
Now the temporary array is no longer generated, but if the wrapping in
parenthesis is present in user code like this:
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90
b/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90
index 38d958fbcca..64dcd7af22b 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_34.f90
@@ -21,7 +21,7 @@ contains
subroutine sub(x)
class(t1), pointer, intent(in) :: x(:)
class(t1), allocatable :: a(:)
- allocate(a, source=x)
+ allocate(a, source=(x))
call check_all(x, 1)
call check_all(a, 2)
end subroutine
then the bogus temporary handling remains.
The testcase is allocate_with_source_34.f90 with the patch above applied:
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
character(4) :: status
integer :: i
if (size(x) /= size(y)) error stop e*10+8
if (any(x /= y)) error stop e*10+9
end subroutine
end program
It produces as output at runtime:
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
