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