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

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_associated_2.f90] - Blame information for rev 308

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

Line No. Rev Author Line
1 303 jeremybenn 
! Program to test the ASSOCIATED intrinsic with cross-kinds
2 
program intrinsic_associated_2
3 
   logical*4 :: t4, L44, L48
4 
   logical*8 :: t8, L84, L88
5 
   real*4, pointer :: a4p(:, :)
6 
   real*8, pointer :: a8p(:, :)
7 
   real*4, target  :: a4(10, 10)
8 
   real*8, target  :: a8(10, 10)
9 
 
10 
   t4 = .true.
11 
   t8 = .true.
12 
   t8 = t4
13 
   a4p => a4
14 
   a8p => a8
15 
   L44 = t4 .and. associated (a4p, a4)
16 
   L84 = t8 .and. associated (a4p, a4)
17 
   L48 = t4 .and. associated (a8p, a8)
18 
   L88 = t8 .and. associated (a8p, a8)
19 
   if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort ()
20 
 
21 
   nullify (a4p, a8p)
22 
   L44 = t4 .and. associated (a4p, a4)
23 
   L84 = t8 .and. associated (a4p, a4)
24 
   L48 = t4 .and. associated (a8p, a8)
25 
   L88 = t8 .and. associated (a8p, a8)
26 
   if (L44 .and. L84 .and. L48 .and. L88) call abort ()
27 
 
28 
   a4p => a4(1:10:2, 1:10:2)
29 
   a8p => a8(1:4, 1:4)
30 
   L44 = t4 .and. associated (a4p, a4(1:10:2, 1:10:2))
31 
   L84 = t8 .and. associated (a4p, a4(1:10:2, 1:10:2))
32 
   L48 = t4 .and. associated (a8p, a8(1:4, 1:4))
33 
   L88 = t8 .and. associated (a8p, a8(1:4, 1:4))
34 
   if (.not. (L44 .and. L84 .and. L48 .and. L88)) call abort ()
35 
end
36 
 

powered by: WebSVN 2.1.0

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