Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/typebound_operator_21.f03 @ 144:8f4e72ab4e11
fix segmentation fault caused by nothing next cur_op to end
author | Takahiro SHIMIZU <anatofuz@cr.ie.u-ryukyu.ac.jp> |
---|---|
date | Sun, 23 Dec 2018 21:23:56 +0900 |
parents | 04ced10e8804 |
children |
line wrap: on
line source
! { dg-do run } ! ! Test that pr78395 is fixed. ! Contributed by Chris MacMackin and Janus Weil module types_mod implicit none type, public :: t1 integer :: a contains procedure :: get_t2 end type type, public :: t2 integer :: b contains procedure, pass(rhs) :: mul2 procedure :: assign generic :: operator(*) => mul2 generic :: assignment(=) => assign end type contains function get_t2(this) class(t1), intent(in) :: this class(t2), allocatable :: get_t2 type(t2), allocatable :: local allocate(local) local%b = this%a call move_alloc(local, get_t2) end function function mul2(lhs, rhs) class(t2), intent(in) :: rhs integer, intent(in) :: lhs class(t2), allocatable :: mul2 type(t2), allocatable :: local allocate(local) local%b = rhs%b*lhs call move_alloc(local, mul2) end function subroutine assign(this, rhs) class(t2), intent(out) :: this class(t2), intent(in) :: rhs select type(rhs) type is(t2) this%b = rhs%b class default error stop end select end subroutine end module program minimal use types_mod implicit none class(t1), allocatable :: v4 class(t2), allocatable :: v6 allocate(v4, source=t1(4)) allocate(v6) v6 = 3 * v4%get_t2() select type (v6) type is (t2) if (v6%b /= 12) error stop class default error stop end select deallocate(v4, v6) end