view gcc/testsuite/gfortran.dg/defined_assignment_11.f90 @ 111:04ced10e8804

gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
line wrap: on
line source

! { dg-do run }
!
! PR fortran/57697
!
! Further test of typebound defined assignment
!
module m0
  implicit none
  type :: component
    integer :: i = 42
    integer, allocatable :: b
  contains
    procedure :: assign0
    generic :: assignment(=) => assign0
  end type
  type, extends(component) :: comp2
    real :: aa
  end type comp2
  type parent
    type(component) :: foo
    real :: cc
  end type
  type p2
    type(parent) :: x
  end type p2
contains
  elemental subroutine assign0(lhs,rhs)
    class(component), intent(INout) :: lhs
    class(component), intent(in) :: rhs
    lhs%i = 20
  end subroutine
end module

program main
  use m0
  implicit none
  type(p2), allocatable :: left
  type(p2) :: right
!  print *, right%x%foo%i
  left = right
!  print *, left%x%foo%i
  if (left%x%foo%i /= 20) call abort()
end