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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do run }
2
! Test the fix for PR43291, which was a regression that caused
3
! incorrect type mismatch errors at line 46. In the course of
4
! fixing the PR, it was noted that the dynamic dispatch of the
5
! final typebound call was not occurring - hence the dg-do run.
6
!
7
! Contributed by Janus Weil 
8
!
9
module m1
10
  type :: t1
11
  contains
12
    procedure :: sizeof
13
  end type
14
contains
15
  integer function sizeof(a)
16
    class(t1) :: a
17
    sizeof = 1
18
  end function sizeof
19
end module
20
 
21
module m2
22
  use m1
23
  type, extends(t1) :: t2
24
  contains
25
    procedure :: sizeof => sizeof2
26
  end type
27
contains
28
  integer function sizeof2(a)
29
    class(t2) :: a
30
    sizeof2 = 2
31
  end function
32
end module
33
 
34
module m3
35
  use m2
36
  type :: t3
37
  class(t1), pointer :: a
38
  contains
39
    procedure :: sizeof => sizeof3
40
  end type
41
contains
42
  integer function sizeof3(a)
43
    class(t3) :: a
44
    sizeof3 = a%a%sizeof()
45
  end function
46
end module
47
 
48
  use m1
49
  use m2
50
  use m3
51
  type(t1), target :: x
52
  type(t2), target :: y
53
  type(t3) :: z
54
  z%a => x
55
  if ((z%sizeof() .ne. 1) .or. (z%a%sizeof() .ne. 1)) call abort
56
  z%a => y
57
  if ((z%sizeof() .ne. 2) .or. (z%a%sizeof() .ne. 2)) call abort
58
end
59
 
60
! { dg-final { cleanup-modules "m1 m2 m3" } }
61
 

powered by: WebSVN 2.1.0

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