! { dg-do run }
|
! { dg-do run }
|
! This tests a few reshape PRs.
|
! This tests a few reshape PRs.
|
program resh
|
program resh
|
implicit none
|
implicit none
|
real, dimension (2,3) :: a,c
|
real, dimension (2,3) :: a,c
|
real, dimension (12) :: b
|
real, dimension (12) :: b
|
type foo
|
type foo
|
real :: r
|
real :: r
|
end type foo
|
end type foo
|
type(foo), dimension (2,3) :: ar
|
type(foo), dimension (2,3) :: ar
|
type(foo), dimension (12) :: br
|
type(foo), dimension (12) :: br
|
|
|
character (len=80) line1, line2, line3
|
character (len=80) line1, line2, line3
|
integer :: i
|
integer :: i
|
|
|
! PR 21108: This used to give undefined results.
|
! PR 21108: This used to give undefined results.
|
b = (/(i,i=1,12)/)
|
b = (/(i,i=1,12)/)
|
a = reshape(b(1:12:2),shape(a),order=(/2,1/))
|
a = reshape(b(1:12:2),shape(a),order=(/2,1/))
|
c = reshape(b(1:12:2),shape(a),order=(/2,1/))
|
c = reshape(b(1:12:2),shape(a),order=(/2,1/))
|
if (any (a /= c)) call abort
|
if (any (a /= c)) call abort
|
|
|
! Test generic reshape
|
! Test generic reshape
|
br%r = b
|
br%r = b
|
ar = reshape(br(1:12:2),shape(a),order=(/2,1/))
|
ar = reshape(br(1:12:2),shape(a),order=(/2,1/))
|
if (any (ar%r /= a)) call abort
|
if (any (ar%r /= a)) call abort
|
|
|
! Test callee-allocated memory with a write statement
|
! Test callee-allocated memory with a write statement
|
write (line1,'(6F8.3)') reshape(b(1:12:2),shape(a),order=(/2,1/))
|
write (line1,'(6F8.3)') reshape(b(1:12:2),shape(a),order=(/2,1/))
|
write (line2,'(6F8.3)') a
|
write (line2,'(6F8.3)') a
|
if (line1 /= line2 ) call abort
|
if (line1 /= line2 ) call abort
|
write (line3,'(6F8.3)') reshape(br(1:12:2),shape(ar),order=(/2,1/))
|
write (line3,'(6F8.3)') reshape(br(1:12:2),shape(ar),order=(/2,1/))
|
if (line1 /= line3 ) call abort
|
if (line1 /= line3 ) call abort
|
end
|
end
|
|
|
