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.0rc1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [userop.f90] - Blame information for rev 303

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn 
module uops
2 
   implicit none
3 
   interface operator (.foo.)
4 
      module procedure myfoo
5 
   end interface
6 
 
7 
   interface operator (*)
8 
      module procedure boolmul
9 
   end interface
10 
 
11 
   interface assignment (=)
12 
      module procedure int2bool
13 
   end interface
14 
 
15 
contains
16 
function myfoo (lhs, rhs)
17 
   implicit none
18 
   integer myfoo
19 
   integer, intent(in) :: lhs, rhs
20 
 
21 
   myfoo = lhs + rhs
22 
end function
23 
 
24 
! This is deliberately different from integer multiplication
25 
function boolmul (lhs, rhs)
26 
   implicit none
27 
   logical boolmul
28 
   logical, intent(IN) :: lhs, rhs
29 
 
30 
   boolmul = lhs .and. .not. rhs
31 
end function
32 
 
33 
subroutine int2bool (lhs, rhs)
34 
   implicit none
35 
   logical, intent(out) :: lhs
36 
   integer, intent(in) :: rhs
37 
 
38 
   lhs = rhs .ne. 0
39 
end subroutine
40 
end module
41 
 
42 
program me
43 
   use uops
44 
   implicit none
45 
   integer i, j
46 
   logical b, c
47 
 
48 
   b = .true.
49 
   c = .true.
50 
   if (b * c) call abort
51 
   c = .false.
52 
   if (.not. (b * c)) call abort
53 
   if (c * b) call abort
54 
   b = .false.
55 
   if (b * c) call abort
56 
 
57 
   i = 0
58 
   b = i
59 
   if (b) call abort
60 
   i = 2
61 
   b = i
62 
   if (.not. b) call abort
63 
 
64 
   j = 3
65 
   if ((i .foo. j) .ne. 5) call abort
66 
end program
67 
 

powered by: WebSVN 2.1.0

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