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

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc3/] [gcc/] [testsuite/] [gfortran.dg/] [extends_type_of_1.f03] - Blame information for rev 581

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

Line No. Rev Author Line
1 302 jeremybenn 
! { dg-do run }
2 
!
3 
! Verifying the runtime behavior of the intrinsic function EXTENDS_TYPE_OF.
4 
!
5 
! Contributed by Janus Weil
6 
 
7 
 implicit none
8 
 
9 
 intrinsic :: extends_type_of
10 
 
11 
 type :: t1
12 
   integer :: i = 42
13 
 end type
14 
 
15 
 type, extends(t1) :: t2
16 
   integer :: j = 43
17 
 end type
18 
 
19 
 type, extends(t2) :: t3
20 
   class(t1),pointer :: cc
21 
 end type
22 
 
23 
 class(t1), pointer :: c1,c2
24 
 type(t1), target :: x
25 
 type(t2), target :: y
26 
 type(t3), target :: z
27 
 
28 
 c1 => x
29 
 c2 => y
30 
 z%cc => y
31 
 
32 
 if (.not. extends_type_of (c1, c1)) call abort()
33 
 if (      extends_type_of (c1, c2)) call abort()
34 
 if (.not. extends_type_of (c2, c1)) call abort()
35 
 
36 
 if (.not. extends_type_of (x, x)) call abort()
37 
 if (      extends_type_of (x, y)) call abort()
38 
 if (.not. extends_type_of (y, x)) call abort()
39 
 
40 
 if (.not. extends_type_of (c1, x)) call abort()
41 
 if (      extends_type_of (c1, y)) call abort()
42 
 if (.not. extends_type_of (x, c1)) call abort()
43 
 if (.not. extends_type_of (y, c1)) call abort()
44 
 
45 
 if (.not. extends_type_of (z,   c1)) call abort()
46 
 if (      extends_type_of (z%cc, z)) call abort()
47 
 
48 
end

powered by: WebSVN 2.1.0

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