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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [select_type_3.f03] - Blame information for rev 749

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


! { dg-do run }
!
! SELECT TYPE with temporaries
!
! Contributed by Janus Weil 
 
  type :: t1
    integer :: i = -1
  end type t1
 
  type, extends(t1) :: t2
    integer :: j = -1
  end type t2
 
  class(t1), pointer :: cp
  type(t2), target :: b
 
  cp => b
 
  select type (cp)
  type is (t1)
    cp%i = 1
  type is (t2)
    cp%j = 2
  end select
 
  print *,b%i,b%j
  if (b%i /= -1) call abort()
  if (b%j /= 2) call abort()
 
  select type (cp)
  type is (t1)
    cp%i = 4
  type is (t2)
    cp%i = 3*cp%j
  end select
 
  print *,b%i,b%j
  if (b%i /= 6) call abort()
  if (b%j /= 2) call abort()
 
end

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { dg-do run }`
2			`!`
3			`! SELECT TYPE with temporaries`
4			`!`
5			`! Contributed by Janus Weil`
6
7			`type :: t1`
8			`integer :: i = -1`
9			`end type t1`
10
11			`type, extends(t1) :: t2`
12			`integer :: j = -1`
13			`end type t2`
14
15			`class(t1), pointer :: cp`
16			`type(t2), target :: b`
17
18			`cp => b`
19
20			`select type (cp)`
21			`type is (t1)`
22			`cp%i = 1`
23			`type is (t2)`
24			`cp%j = 2`
25			`end select`
26
27			`print *,b%i,b%j`
28			`if (b%i /= -1) call abort()`
29			`if (b%j /= 2) call abort()`
30
31			`select type (cp)`
32			`type is (t1)`
33			`cp%i = 4`
34			`type is (t2)`
35			`cp%i = 3*cp%j`
36			`end select`
37
38			`print *,b%i,b%j`
39			`if (b%i /= 6) call abort()`
40			`if (b%j /= 2) call abort()`
41
42			`end`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [select_type_3.f03] - Blame information for rev 749