blob: f6bb53acd427f515b819e7896ddaae273ae347d6 [file] [log] [blame]
! { dg-do run }
! Check the fix for PR38863 comment #1, where defined assignment
! to derived types was not treating components correctly that were
! not set explicitly.
!
! Contributed by Mikael Morin <mikael@gcc.gnu.org>
!
module m
type t
integer :: i,j
end type t
type ti
integer :: i,j = 99
end type ti
interface assignment (=)
module procedure i_to_t, i_to_ti
end interface
contains
elemental subroutine i_to_ti (p, q)
type(ti), intent(out) :: p
integer, intent(in) :: q
p%i = q
end subroutine
elemental subroutine i_to_t (p, q)
type(t), intent(out) :: p
integer, intent(in) :: q
p%i = q
end subroutine
end module
use m
call test_t ! Check original problem
call test_ti ! Default initializers were treated wrongly
contains
subroutine test_t
type(t), target :: a(3)
type(t), target :: b(3)
type(t), dimension(:), pointer :: p
logical :: l(3)
a%i = 1
a%j = [101, 102, 103]
b%i = 3
b%j = 4
p => b
l = .true.
where (l)
a = p%i ! Comment #1 of PR38863 concerned WHERE assignment
end where
if (any (a%j .ne. [101, 102, 103])) STOP 1
a = p%i ! Ordinary assignment was wrong too.
if (any (a%j .ne. [101, 102, 103])) STOP 2
end subroutine
subroutine test_ti
type(ti), target :: a(3)
type(ti), target :: b(3)
type(ti), dimension(:), pointer :: p
logical :: l(3)
a%i = 1
a%j = [101, 102, 103]
b%i = 3
b%j = 4
p => b
l = .true.
where (l)
a = p%i
end where
if (any (a%j .ne. 99)) STOP 3
a = p%i
if (any (a%j .ne. 99)) STOP 4
end subroutine
end