1! PR 101319
2! { dg-do compile }
3!
4! TS 29113
5! 6.3 Argument association
6!
7! An assumed-type dummy argument shall not correspond to an actual argument
8! that is of a derived type that has type parameters, type-bound procedures,
9! or final subroutines.
10!
11! In the 2018 Fortran standard, this requirement appears as:
12!
13! 15.5.2.4 Ordinary dummy variables
14!
15! If the actual argument is of a derived type that has type parameters,
16! type-bound procedures, or final subroutines, the dummy argument shall
17! not be assumed-type.
18!
19! This file contains code that is expected to produce errors.
20
21module m
22
23  ! basic derived type
24  type :: t1
25    real*8 :: xyz (3)
26  end type
27
28  ! derived type with type parameters
29  type t2 (k, l)
30    integer, kind :: k
31    integer, len :: l
32    real(k) :: a(l)
33  end type
34
35  ! derived type with a type-bound procedure
36  type :: t3
37    integer :: xyz(3)
38    contains
39      procedure, pass :: frob => frob_t3
40  end type
41
42  ! derived type with a final subroutine
43  type :: t4
44    integer :: xyz(3)
45    contains
46      final :: final_t4
47  end type
48
49contains
50
51  ! implementation of the type-bound procedure for t3 above
52  subroutine frob_t3 (a)
53    class (t3) :: a
54    a%xyz = 0
55  end subroutine
56
57  ! implementation of the final subroutine for t4 above
58  subroutine final_t4 (a)
59    type (t4) :: a
60    a%xyz = 0
61  end subroutine
62
63  ! useless subroutine with an assumed-type dummy.
64  subroutine s1 (a)
65    type(*) :: a
66  end subroutine
67
68  ! test procedure
69  subroutine testit
70    type(t1) :: a1
71    type(t2(8,20)) :: a2
72    type(t3) :: a3
73    type(t4) :: a4
74
75    call s1 (a1)  ! OK
76    call s1 (a2)  ! { dg-error "assumed-type dummy" }
77    call s1 (a3)  ! { dg-error "assumed-type dummy" }
78    call s1 (a4)  ! { dg-error "assumed-type dummy" }
79  end subroutine
80
81end module
82
83
84
85