1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
! { dg-do compile }
! PR fortran/45783
! PR fortran/45795
! This used to fail because of incorrect compile-time typespec on the
! SELECT TYPE selector.
! This is the test-case from PR 45795.
! Contributed by Salvatore Filippone, sfilippone@uniroma2.it.
module base_mod
type :: base
integer :: m, n
end type base
end module base_mod
module s_base_mod
use base_mod
type, extends(base) :: s_base
contains
procedure, pass(a) :: cp_to_foo => s_base_cp_to_foo
end type s_base
type, extends(s_base) :: s_foo
integer :: nnz
integer, allocatable :: ia(:), ja(:)
real, allocatable :: val(:)
contains
procedure, pass(a) :: cp_to_foo => s_cp_foo_to_foo
end type s_foo
interface
subroutine s_base_cp_to_foo(a,b,info)
import :: s_base, s_foo
class(s_base), intent(in) :: a
class(s_foo), intent(inout) :: b
integer, intent(out) :: info
end subroutine s_base_cp_to_foo
end interface
interface
subroutine s_cp_foo_to_foo(a,b,info)
import :: s_foo
class(s_foo), intent(in) :: a
class(s_foo), intent(inout) :: b
integer, intent(out) :: info
end subroutine s_cp_foo_to_foo
end interface
end module s_base_mod
subroutine trans2(a,b)
use s_base_mod
implicit none
class(s_base), intent(out) :: a
class(base), intent(in) :: b
type(s_foo) :: tmp
integer err_act, info
info = 0
select type(b)
class is (s_base)
call b%cp_to_foo(tmp,info)
class default
info = -1
write(*,*) 'Invalid dynamic type'
end select
if (info /= 0) write(*,*) 'Error code ',info
return
end subroutine trans2
|
