1! { dg-do compile }
2! Test the fix for PR43843, in which the temporary for b(1) in
3! test_member was an indirect reference, rather then the value.
4!
5! Contributed by Kyle Horne <horne.kyle@gmail.com>
6! Reported by Tobias Burnus <burnus@gcc.gno.org>
7! Reported by Harald Anlauf <anlauf@gmx.de> (PR43841)
8!
9module polar_mod
10  implicit none
11  complex, parameter :: i = (0.0,1.0)
12  real, parameter :: pi = 3.14159265359
13  real, parameter :: e = exp (1.0)
14  type :: polar_t
15    real :: l, th
16  end type
17  type(polar_t) :: one = polar_t (1.0, 0)
18  interface operator(/)
19    module procedure div_pp
20  end interface
21  interface operator(.ne.)
22    module procedure ne_pp
23  end interface
24contains
25  elemental function div_pp(u,v) result(o)
26    type(polar_t), intent(in) :: u, v
27    type(polar_t) :: o
28    complex :: a, b, c
29    a = u%l*exp (i*u%th*pi)
30    b = v%l*exp (i*v%th*pi)
31    c = a/b
32    o%l = abs (c)
33    o%th = atan2 (imag (c), real (c))/pi
34  end function div_pp
35  elemental function ne_pp(u,v) result(o)
36    type(polar_t), intent(in) :: u, v
37    LOGICAL :: o
38    if (u%l .ne. v%l) then
39      o = .true.
40    else if (u%th .ne. v%th) then
41      o = .true.
42    else
43      o = .false.
44    end if
45  end function ne_pp
46end module polar_mod
47
48program main
49  use polar_mod
50  implicit none
51  call test_member
52  call test_other
53  call test_scalar
54  call test_real
55contains
56  subroutine test_member
57    type(polar_t), dimension(3) :: b
58    b = polar_t (2.0,0.5)
59    b(:) = b(:)/b(1)
60    if (any (b .ne. one)) call abort
61  end subroutine test_member
62  subroutine test_other
63    type(polar_t), dimension(3) :: b
64    type(polar_t), dimension(3) :: c
65    b = polar_t (3.0,1.0)
66    c = polar_t (3.0,1.0)
67    b(:) = b(:)/c(1)
68    if (any (b .ne. one)) call abort
69  end subroutine test_other
70  subroutine test_scalar
71    type(polar_t), dimension(3) :: b
72    type(polar_t) :: c
73    b = polar_t (4.0,1.5)
74    c = b(1)
75    b(:) = b(:)/c
76    if (any (b .ne. one)) call abort
77  end subroutine test_scalar
78  subroutine test_real
79    real,dimension(3) :: b
80    real :: real_one
81    b = 2.0
82    real_one = b(2)/b(1)
83    b(:) = b(:)/b(1)
84    if (any (b .ne. real_one)) call abort
85  end subroutine test_real
86end program main
87