OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [elemental_scalar_args_1.f90] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn 
! { 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
6 
! Reported by Tobias Burnus
7 
! Reported by Harald Anlauf  (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" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.