gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90

   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 !
   9 module 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
  24 contains
  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
  46 end module polar_mod
  47
  48 program main
  49   use polar_mod
  50   implicit none
  51   call test_member
  52   call test_other
  53   call test_scalar
  54   call test_real
  55 contains
  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
  86 end program main
  87 ! { dg-final { cleanup-modules "polar_mod" } }