OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [select_type_5.f03] - Blame information for rev 302

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

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