OSDN Git Service

PR fortran/42769
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / use_26.f90
1 ! { dg-do compile }
2 !
3 ! PR fortran/45836
4 ! The B_TYPE_INSTANCE%SIZERETURN() typebound function used to be rejected on a
5 ! type mismatch because the function was resolved to A's SIZERETURN instead of
6 ! B's because of the ambiguity of the SIZERETURN name in the MAIN namespace.
7 !
8 ! Original testcase by someone <ortp21@gmail.com>
9
10 module A
11 implicit none
12     type :: a_type
13     private
14         integer :: size = 1
15     contains
16         procedure :: sizeReturn
17     end type a_type
18     contains
19         function sizeReturn( a_type_ )
20             implicit none
21             integer :: sizeReturn
22             class(a_type) :: a_type_
23
24             sizeReturn = a_type_%size
25         end function sizeReturn
26 end module A
27
28 module B
29 implicit none
30     type :: b_type
31     private
32         integer :: size = 2
33     contains
34         procedure :: sizeReturn
35     end type b_type
36     contains
37         function sizeReturn( b_type_ )
38             implicit none
39             integer :: sizeReturn
40             class(b_type) :: b_type_
41
42             sizeReturn = b_type_%size
43         end function sizeReturn
44 end module B
45
46 program main
47
48   call test1
49   call test2
50
51 contains
52
53   subroutine test1
54     use A
55     use B
56     implicit none
57     type(a_type) :: a_type_instance
58     type(b_type) :: b_type_instance
59
60     print *, a_type_instance%sizeReturn()
61     print *, b_type_instance%sizeReturn()
62   end subroutine test1
63
64   subroutine test2
65     use B
66     use A
67     implicit none
68     type(a_type) :: a_type_instance
69     type(b_type) :: b_type_instance
70
71     print *, a_type_instance%sizeReturn()
72     print *, b_type_instance%sizeReturn()
73   end subroutine test2
74 end program main
75
76