xref: /llvm-project/flang/test/Semantics/final01.f90 (revision 6c1ac141d3c98af9738bc77fcb55602cbff7751f)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Test FINAL subroutine constraints C786-C789
3module m1
4  external :: external
5  intrinsic :: sin
6  real :: object
7  procedure(valid), pointer :: pointer
8  type :: parent(kind1, len1)
9    integer, kind :: kind1 = 1
10    integer, len :: len1 = 1
11  end type
12  type, extends(parent) :: child(kind2, len2)
13    integer, kind :: kind2 = 2
14    integer, len :: len2 = 2
15   contains
16    final :: valid
17!ERROR: FINAL subroutine 'external' of derived type 'child' must be a module procedure
18!ERROR: FINAL subroutine 'sin' of derived type 'child' must be a module procedure
19!ERROR: FINAL subroutine 'object' of derived type 'child' must be a module procedure
20!ERROR: FINAL subroutine 'pointer' of derived type 'child' must be a module procedure
21!ERROR: FINAL subroutine 'func' of derived type 'child' must be a subroutine
22    final :: external, sin, object, pointer, func
23!ERROR: FINAL subroutine 's01' of derived type 'child' must have a single dummy argument that is a data object
24!ERROR: FINAL subroutine 's02' of derived type 'child' must have a single dummy argument that is a data object
25!ERROR: FINAL subroutine 's03' of derived type 'child' must not have a dummy argument with INTENT(OUT)
26!ERROR: FINAL subroutine 's04' of derived type 'child' must not have a dummy argument with the VALUE attribute
27!ERROR: FINAL subroutine 's05' of derived type 'child' must not have a POINTER dummy argument
28!ERROR: FINAL subroutine 's06' of derived type 'child' must not have an ALLOCATABLE dummy argument
29!ERROR: FINAL subroutine 's07' of derived type 'child' must not have a coarray dummy argument
30!ERROR: FINAL subroutine 's08' of derived type 'child' must not have a polymorphic dummy argument
31!ERROR: FINAL subroutine 's09' of derived type 'child' must not have a polymorphic dummy argument
32!ERROR: FINAL subroutine 's10' of derived type 'child' must not have an OPTIONAL dummy argument
33    final :: s01, s02, s03, s04, s05, s06, s07, s08, s09, s10
34!ERROR: FINAL subroutine 's11' of derived type 'child' must have a single dummy argument
35!ERROR: FINAL subroutine 's12' of derived type 'child' must have a single dummy argument
36!ERROR: FINAL subroutine 's13' of derived type 'child' must have a dummy argument with an assumed LEN type parameter 'len1=*'
37!ERROR: FINAL subroutine 's13' of derived type 'child' must have a dummy argument with an assumed LEN type parameter 'len2=*'
38!ERROR: FINAL subroutine 's14' of derived type 'child' must have a dummy argument with an assumed LEN type parameter 'len2=*'
39!ERROR: FINAL subroutine 's15' of derived type 'child' must have a dummy argument with an assumed LEN type parameter 'len1=*'
40!ERROR: FINAL subroutine 's16' of derived type 'child' must not have a polymorphic dummy argument
41!ERROR: FINAL subroutine 's17' of derived type 'child' must have a TYPE(child) dummy argument
42    final :: s11, s12, s13, s14, s15, s16, s17
43!ERROR: FINAL subroutine 'valid' already appeared in this derived type
44    final :: valid
45!ERROR: FINAL subroutines 'valid2' and 'valid' of derived type 'child' cannot be distinguished by rank or KIND type parameter value
46    final :: valid2
47  end type
48 contains
49  subroutine valid(x)
50    type(child(len1=*, len2=*)), intent(inout) :: x
51  end subroutine
52  subroutine valid2(x)
53    type(child(len1=*, len2=*)), intent(inout) :: x
54  end subroutine
55  real function func(x)
56    type(child(len1=*, len2=*)), intent(inout) :: x
57    func = 0.
58  end function
59  subroutine s01(*)
60  end subroutine
61  subroutine s02(x)
62    external :: x
63  end subroutine
64  subroutine s03(x)
65    type(child(kind1=3, len1=*, len2=*)), intent(out) :: x
66  end subroutine
67  subroutine s04(x)
68    type(child(kind1=4, len1=*, len2=*)), value :: x
69  end subroutine
70  subroutine s05(x)
71    type(child(kind1=5, len1=*, len2=*)), pointer :: x
72  end subroutine
73  subroutine s06(x)
74    type(child(kind1=6, len1=*, len2=*)), allocatable :: x
75  end subroutine
76  subroutine s07(x)
77    type(child(kind1=7, len1=*, len2=*)) :: x[*]
78  end subroutine
79  subroutine s08(x)
80    class(child(kind1=8, len1=*, len2=*)) :: x
81  end subroutine
82  subroutine s09(x)
83    class(*) :: x
84  end subroutine
85  subroutine s10(x)
86    type(child(kind1=10, len1=*, len2=*)), optional :: x
87  end subroutine
88  subroutine s11(x, y)
89    type(child(kind1=11, len1=*, len2=*)) :: x, y
90  end subroutine
91  subroutine s12
92  end subroutine
93  subroutine s13(x)
94    type(child(kind1=13)) :: x
95  end subroutine
96  subroutine s14(x)
97    type(child(kind1=14, len1=*,len2=2)) :: x
98  end subroutine
99  subroutine s15(x)
100    type(child(kind1=15, len2=*)) :: x
101  end subroutine
102  subroutine s16(x)
103    type(*) :: x
104  end subroutine
105  subroutine s17(x)
106    type(parent(kind1=17, len1=*)) :: x
107  end subroutine
108  subroutine nested
109    type :: t
110     contains
111!ERROR: FINAL subroutine 'internal' of derived type 't' must be a module procedure
112      final :: internal
113    end type
114   contains
115    subroutine internal(x)
116      type(t), intent(inout) :: x
117    end subroutine
118  end subroutine
119end module
120