re PR fortran/89282 (Garbage arithmetics results in fortran with -O3 and overloaded...

2019-02-25  Dominique d'Humieres  <dominiq@gcc.gnu.org>

	PR fortran/89282
	* gfortran.dg/overload_3.f90: New test.

From-SVN: r269190

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 70abccc4d1af83bb52e207ea6c530d3cdcf5bae3..403be0fd5e52a2f4a56aa9d2e66655b247a85203 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-02-25  Dominique d'Humieres  <dominiq@gcc.gnu.org>
+
+       PR fortran/89282
+       * gfortran.dg/overload_3.f90: New test. 
+
 2019-02-25  Jakub Jelinek  <jakub@redhat.com>
 
        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 (file)
index 0000000..a2fb47e
--- /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