OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [mapping_1.f90] - Blame information for rev 694

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Tests the fix for PR31213, which exposed rather a lot of
3
! bugs - see the PR and the ChangeLog.
4
!
5
! Contributed by Joost VandeVondele 
6
!
7
module mykinds
8
  implicit none
9
  integer, parameter :: ik1 = selected_int_kind (2)
10
  integer, parameter :: ik2 = selected_int_kind (4)
11
  integer, parameter :: dp = selected_real_kind (15,300)
12
end module mykinds
13
 
14
module spec_xpr
15
  use mykinds
16
  implicit none
17
  integer(ik2) c_size
18
contains
19
  pure function tricky (str,ugly)
20
    character(*), intent(in) :: str
21
    integer(ik1) :: ia_ik1(len(str))
22
    interface yoagly
23
      pure function ugly(n)
24
        use mykinds
25
        implicit none
26
        integer, intent(in) :: n
27
        complex(dp) :: ugly(3*n+2)
28
      end function ugly
29
    end interface yoagly
30
    logical :: la(size (yoagly (size (ia_ik1))))
31
    integer :: i
32
    character(tricky_helper ((/(.TRUE., i=1, size (la))/)) + c_size) :: tricky
33
 
34
    tricky = transfer (yoagly (1), tricky)
35
  end function tricky
36
 
37
  pure function tricky_helper (lb)
38
    logical, intent(in) :: lb(:)
39
    integer :: tricky_helper
40
    tricky_helper = 2 * size (lb) + 3
41
  end function tricky_helper
42
end module spec_xpr
43
 
44
module xtra_fun
45
  implicit none
46
contains
47
  pure function butt_ugly(n)
48
    use mykinds
49
    implicit none
50
    integer, intent(in) :: n
51
    complex(dp) :: butt_ugly(3*n+2)
52
    real(dp) pi, sq2
53
 
54
    pi = 4 * atan (1.0_dp)
55
    sq2 = sqrt (2.0_dp)
56
    butt_ugly = cmplx (pi, sq2, dp)
57
  end function butt_ugly
58
end module xtra_fun
59
 
60
program spec_test
61
  use mykinds
62
  use spec_xpr
63
  use xtra_fun
64
  implicit none
65
  character(54) :: chr
66
 
67
  c_size = 5
68
  if (tricky ('Help me', butt_ugly) .ne. transfer (butt_ugly (1), chr)) call abort ()
69
end program spec_test
70
! { dg-final { cleanup-modules "mykinds spec_xpr xtra_fun" } }

powered by: WebSVN 2.1.0

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