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