1! { dg-do run } 2! Tests dynamic dispatch of class functions, spread over 3! different modules. Apart from the location of the derived 4! type declarations, this test is the same as 5! dynamic_dispatch_1.f03 6! 7! Contributed by Paul Thomas <pault@gcc.gnu.org> 8! 9module m1 10 type :: t1 11 integer :: i = 42 12 procedure(make_real), pointer :: ptr 13 contains 14 procedure, pass :: real => make_real 15 procedure, pass :: make_integer 16 procedure, pass :: prod => i_m_j 17 generic, public :: extract => real, make_integer 18 end type t1 19contains 20 real function make_real (arg) 21 class(t1), intent(in) :: arg 22 make_real = real (arg%i) 23 end function make_real 24 25 integer function make_integer (arg, arg2) 26 class(t1), intent(in) :: arg 27 integer :: arg2 28 make_integer = arg%i * arg2 29 end function make_integer 30 31 integer function i_m_j (arg) 32 class(t1), intent(in) :: arg 33 i_m_j = arg%i 34 end function i_m_j 35end module m1 36 37module m2 38 use m1 39 type, extends(t1) :: t2 40 integer :: j = 99 41 contains 42 procedure, pass :: real => make_real2 43 procedure, pass :: make_integer => make_integer_2 44 procedure, pass :: prod => i_m_j_2 45 end type t2 46contains 47 real function make_real2 (arg) 48 class(t2), intent(in) :: arg 49 make_real2 = real (arg%j) 50 end function make_real2 51 52 integer function make_integer_2 (arg, arg2) 53 class(t2), intent(in) :: arg 54 integer :: arg2 55 make_integer_2 = arg%j * arg2 56 end function make_integer_2 57 58 integer function i_m_j_2 (arg) 59 class(t2), intent(in) :: arg 60 i_m_j_2 = arg%j 61 end function i_m_j_2 62end module m2 63 64 use m1 65 use m2 66 type, extends(t1) :: l1 67 character(16) :: chr 68 end type l1 69 class(t1), pointer :: a !=> NULL() 70 type(t1), target :: b 71 type(t2), target :: c 72 type(l1), target :: d 73 a => b ! declared type in module m1 74 if (a%real() .ne. real (42)) call abort 75 if (a%prod() .ne. 42) call abort 76 if (a%extract (2) .ne. 84) call abort 77 a => c ! extension in module m2 78 if (a%real() .ne. real (99)) call abort 79 if (a%prod() .ne. 99) call abort 80 if (a%extract (3) .ne. 297) call abort 81 a => d ! extension in main 82 if (a%real() .ne. real (42)) call abort 83 if (a%prod() .ne. 42) call abort 84 if (a%extract (4) .ne. 168) call abort 85end 86