gcc/testsuite/gfortran.dg/pr97505.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-Os -fsanitize=signed-integer-overflow" }
   3 !
   4 ! Test the fix for PR35824, in which the interface assignment and
   5 ! negation did not work correctly.
   6 !
   7 ! Contributed by Rolf Roth <everyo@gmx.net>
   8 !
   9 module typemodule
  10   type alltype
  11      double precision :: a
  12      double precision,allocatable :: b(:)
  13   end type
  14   interface assignment(=)
  15     module procedure at_from_at
  16   end interface
  17   interface operator(-)
  18     module procedure  neg_at
  19   end interface
  20 contains
  21   subroutine at_from_at(b,a)
  22     type(alltype), intent(in) :: a
  23     type(alltype), intent(out) :: b
  24     b%a=a%a
  25     allocate(b%b(2))
  26     b%b=a%b
  27   end subroutine at_from_at
  28   function neg_at(a) result(b)
  29     type(alltype), intent(in) :: a
  30     type(alltype) :: b
  31     b%a=-a%a
  32     allocate(b%b(2))
  33     b%b=-a%b
  34   end function neg_at
  35 end module
  36   use typemodule
  37   type(alltype) t1,t2,t3
  38   allocate(t1%b(2))
  39   t1%a=0.5d0
  40   t1%b(1)=1d0
  41   t1%b(2)=2d0
  42   t2=-t1
  43   if (t2%a .ne. -0.5d0) STOP 1
  44   if (any(t2%b .ne. [-1d0, -2d0])) STOP 2
  45
  46   t1=-t1
  47   if (t1%a .ne. -0.5d0) STOP 3
  48   if (any(t1%b .ne. [-1d0, -2d0])) STOP 4
  49 end