From 6388eda068f22b1e221e0955266f5911520b06e7 Mon Sep 17 00:00:00 2001 From: Dominique d'Humieres Date: Mon, 25 Feb 2019 16:19:45 +0100 Subject: [PATCH] re PR fortran/89282 (Garbage arithmetics results in fortran with -O3 and overloaded operators) 2019-02-25 Dominique d'Humieres PR fortran/89282 * gfortran.dg/overload_3.f90: New test. From-SVN: r269190 --- gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/overload_3.f90 | 84 ++++++++++++++++++++++++ 2 files changed, 89 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/overload_3.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 70abccc4d1a..403be0fd5e5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-02-25 Dominique d'Humieres + + PR fortran/89282 + * gfortran.dg/overload_3.f90: New test. + 2019-02-25 Jakub Jelinek PR c++/89285 diff --git a/gcc/testsuite/gfortran.dg/overload_3.f90 b/gcc/testsuite/gfortran.dg/overload_3.f90 new file mode 100644 index 00000000000..a2fb47effd7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/overload_3.f90 @@ -0,0 +1,84 @@ +! { 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 -- 2.30.2