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/] [der_point.f90] - Blame information for rev 318

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


! Program to test DERIVED type with components point to the DERIVED
! type itself, and two DERIVED type with componets point to each
! other.
program nest_derived
   type record
      integer :: value
      type(record), pointer :: rp
   end type record
 
   type record1
      integer value
      type(record2), pointer :: r1p
   end type
 
   type record2
      integer value
      type(record1), pointer :: r2p
   end type
 
   type(record), target :: e1, e2, e3
   type(record1), target :: r1
   type(record2), target :: r2
   nullify(r1%r1p,r2%r2p,e1%rp,e2%rp,e3%rp)
 
   r1%r1p => r2
   r2%r2p => r1
   e1%rp => e2
   e2%rp => e3
 
   r1%value = 11
   r2%value = 22
 
   e1%value = 33
   e1%rp%value = 44
   e1%rp%rp%value = 55
 
   if (r1%r1p%value .ne. 22) call abort
   if (r2%r2p%value .ne. 11) call abort
   if (e1%value .ne. 33) call abort
   if (e2%value .ne. 44) call abort
   if (e3%value .ne. 55) call abort
   if (r1%value .ne. 11) call abort
   if (r2%value .ne. 22) call abort
 
end

Line No.	Rev	Author	Line
1	303	jeremybenn	`! Program to test DERIVED type with components point to the DERIVED`
2			`! type itself, and two DERIVED type with componets point to each`
3			`! other.`
4			`program nest_derived`
5			`type record`
6			`integer :: value`
7			`type(record), pointer :: rp`
8			`end type record`
9
10			`type record1`
11			`integer value`
12			`type(record2), pointer :: r1p`
13			`end type`
14
15			`type record2`
16			`integer value`
17			`type(record1), pointer :: r2p`
18			`end type`
19
20			`type(record), target :: e1, e2, e3`
21			`type(record1), target :: r1`
22			`type(record2), target :: r2`
23			`nullify(r1%r1p,r2%r2p,e1%rp,e2%rp,e3%rp)`
24
25			`r1%r1p => r2`
26			`r2%r2p => r1`
27			`e1%rp => e2`
28			`e2%rp => e3`
29
30			`r1%value = 11`
31			`r2%value = 22`
32
33			`e1%value = 33`
34			`e1%rp%value = 44`
35			`e1%rp%rp%value = 55`
36
37			`if (r1%r1p%value .ne. 22) call abort`
38			`if (r2%r2p%value .ne. 11) call abort`
39			`if (e1%value .ne. 33) call abort`
40			`if (e2%value .ne. 44) call abort`
41			`if (e3%value .ne. 55) call abort`
42			`if (r1%value .ne. 11) call abort`
43			`if (r2%value .ne. 22) call abort`
44
45			`end`

Browse

Tools

Subversion Repositories openrisc_me

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