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

Subversion Repositories scarts

[/] [scarts/] [trunk/] [toolchain/] [scarts-gcc/] [gcc-4.1.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_present.f90] - Blame information for rev 12

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 12 jlechner 
! Program to test the PRESENT intrinsic
2 
program intrinsic_present
3 
   implicit none
4 
   integer a
5 
   integer, pointer :: b
6 
   integer, dimension(10) :: c
7 
   integer, pointer, dimension(:) :: d
8 
 
9 
   if (testvar()) call abort ()
10 
   if (.not. testvar(a)) call abort ()
11 
   if (testptr()) call abort ()
12 
   if (.not. testptr(b)) call abort ()
13 
   if (testarray()) call abort ()
14 
   if (.not. testarray(c)) call abort ()
15 
   if (testparray()) call abort ()
16 
   if (.not. testparray(d)) call abort ()
17 
 
18 
contains
19 
logical function testvar (p)
20 
   integer, optional :: p
21 
   testvar = present(p)
22 
end function
23 
 
24 
logical function testptr (p)
25 
   integer, pointer, optional :: p
26 
   testptr = present(p)
27 
end function
28 
 
29 
logical function testarray (p)
30 
   integer, dimension (10), optional :: p
31 
   testarray = present(p)
32 
end function
33 
 
34 
logical function testparray (p)
35 
   integer, pointer, dimension(:), optional :: p
36 
   testparray = present(p)
37 
end function
38 
 
39 
end program
40 
 

powered by: WebSVN 2.1.0

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