summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
diff options
context:
space:
mode:
authorupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
committerupstream source tree <ports@midipix.org>2015-03-15 20:14:05 -0400
commit554fd8c5195424bdbcabf5de30fdc183aba391bd (patch)
tree976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
downloadcbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2
cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream tarball. downloading a git-generated archive based on the 'upstream' tag should provide you with a source tree that is binary identical to the one extracted from the above tarball. if you have obtained the source via the command 'git clone', however, do note that line-endings of files in your working directory might differ from line-endings of the respective files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90')
-rw-r--r--gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f9087
1 files changed, 87 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
new file mode 100644
index 000000000..d180bc931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_scalar_args_1.f90
@@ -0,0 +1,87 @@
+! { dg-do compile }
+! Test the fix for PR43843, in which the temporary for b(1) in
+! test_member was an indirect reference, rather then the value.
+!
+! Contributed by Kyle Horne <horne.kyle@gmail.com>
+! Reported by Tobias Burnus <burnus@gcc.gno.org>
+! Reported by Harald Anlauf <anlauf@gmx.de> (PR43841)
+!
+module polar_mod
+ implicit none
+ complex, parameter :: i = (0.0,1.0)
+ real, parameter :: pi = 3.14159265359
+ real, parameter :: e = exp (1.0)
+ type :: polar_t
+ real :: l, th
+ end type
+ type(polar_t) :: one = polar_t (1.0, 0)
+ interface operator(/)
+ module procedure div_pp
+ end interface
+ interface operator(.ne.)
+ module procedure ne_pp
+ end interface
+contains
+ elemental function div_pp(u,v) result(o)
+ type(polar_t), intent(in) :: u, v
+ type(polar_t) :: o
+ complex :: a, b, c
+ a = u%l*exp (i*u%th*pi)
+ b = v%l*exp (i*v%th*pi)
+ c = a/b
+ o%l = abs (c)
+ o%th = atan2 (imag (c), real (c))/pi
+ end function div_pp
+ elemental function ne_pp(u,v) result(o)
+ type(polar_t), intent(in) :: u, v
+ LOGICAL :: o
+ if (u%l .ne. v%l) then
+ o = .true.
+ else if (u%th .ne. v%th) then
+ o = .true.
+ else
+ o = .false.
+ end if
+ end function ne_pp
+end module polar_mod
+
+program main
+ use polar_mod
+ implicit none
+ call test_member
+ call test_other
+ call test_scalar
+ call test_real
+contains
+ subroutine test_member
+ type(polar_t), dimension(3) :: b
+ b = polar_t (2.0,0.5)
+ b(:) = b(:)/b(1)
+ if (any (b .ne. one)) call abort
+ end subroutine test_member
+ subroutine test_other
+ type(polar_t), dimension(3) :: b
+ type(polar_t), dimension(3) :: c
+ b = polar_t (3.0,1.0)
+ c = polar_t (3.0,1.0)
+ b(:) = b(:)/c(1)
+ if (any (b .ne. one)) call abort
+ end subroutine test_other
+ subroutine test_scalar
+ type(polar_t), dimension(3) :: b
+ type(polar_t) :: c
+ b = polar_t (4.0,1.5)
+ c = b(1)
+ b(:) = b(:)/c
+ if (any (b .ne. one)) call abort
+ end subroutine test_scalar
+ subroutine test_real
+ real,dimension(3) :: b
+ real :: real_one
+ b = 2.0
+ real_one = b(2)/b(1)
+ b(:) = b(:)/b(1)
+ if (any (b .ne. real_one)) call abort
+ end subroutine test_real
+end program main
+! { dg-final { cleanup-modules "polar_mod" } }