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