! { dg-do run } ! { dg-options "-fno-tree-vrp" } ! PR fortran/89282 ! Contributed by Federico Perini. ! module myclass use iso_fortran_env, only: real64 implicit none ! My generic type type :: t integer :: n=0 real(real64), allocatable :: x(:) contains procedure :: init => t_init procedure :: destroy => t_destroy procedure :: print => t_print procedure, private, pass(this) :: x_minus_t generic :: operator(-) => x_minus_t end type t contains elemental subroutine t_destroy(this) class(t), intent(inout) :: this this%n=0 if (allocated(this%x)) deallocate(this%x) end subroutine t_destroy subroutine t_init(this,n) class(t), intent(out) :: this integer, intent(in) :: n call this%destroy() this%n=n allocate(this%x(n)) end subroutine t_init type(t) function x_minus_t(x,this) result(xmt) real(real64), intent(in) :: x class(t), intent(in) :: this call xmt%init(this%n) xmt%x(:) = x-this%x(:) end function x_minus_t subroutine t_print(this,msg) class(t), intent(in) :: this character(*), intent(in) :: msg integer :: i print "('type(t) object <',a,'>, size=',i0)", msg,this%n do i=1,this%n print "(' x(',i0,') =',1pe12.5)",i,this%x(i) end do end subroutine t_print end module myclass program test_overloaded use myclass implicit none type(t) :: t1,r1 ! Error with result (5) call t1%init(5); t1%x(:) = 1.0_real64; r1 = 3.0_real64 - t1 if (any(r1%x /= 2.0)) stop 1 ! call r1%print('r1') ! No errors call t1%init(6); t1%x(:) = 1.0_real64; r1 = 3.0_real64 - t1 if (any(r1%x /= 2.0)) stop 2 ! call r1%print('r1') return end program test_overloaded