120 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Test FINAL subroutine constraints C786-C7893module m14 external :: external5 intrinsic :: sin6 real :: object7 procedure(valid), pointer :: pointer8 type :: parent(kind1, len1)9 integer, kind :: kind1 = 110 integer, len :: len1 = 111 end type12 type, extends(parent) :: child(kind2, len2)13 integer, kind :: kind2 = 214 integer, len :: len2 = 215 contains16 final :: valid17!ERROR: FINAL subroutine 'external' of derived type 'child' must be a module procedure18!ERROR: FINAL subroutine 'sin' of derived type 'child' must be a module procedure19!ERROR: FINAL subroutine 'object' of derived type 'child' must be a module procedure20!ERROR: FINAL subroutine 'pointer' of derived type 'child' must be a module procedure21!ERROR: FINAL subroutine 'func' of derived type 'child' must be a subroutine22 final :: external, sin, object, pointer, func23!ERROR: FINAL subroutine 's01' of derived type 'child' must have a single dummy argument that is a data object24!ERROR: FINAL subroutine 's02' of derived type 'child' must have a single dummy argument that is a data object25!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 attribute27!ERROR: FINAL subroutine 's05' of derived type 'child' must not have a POINTER dummy argument28!ERROR: FINAL subroutine 's06' of derived type 'child' must not have an ALLOCATABLE dummy argument29!ERROR: FINAL subroutine 's07' of derived type 'child' must not have a coarray dummy argument30!ERROR: FINAL subroutine 's08' of derived type 'child' must not have a polymorphic dummy argument31!ERROR: FINAL subroutine 's09' of derived type 'child' must not have a polymorphic dummy argument32!ERROR: FINAL subroutine 's10' of derived type 'child' must not have an OPTIONAL dummy argument33 final :: s01, s02, s03, s04, s05, s06, s07, s08, s09, s1034!ERROR: FINAL subroutine 's11' of derived type 'child' must have a single dummy argument35!ERROR: FINAL subroutine 's12' of derived type 'child' must have a single dummy argument36!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 argument41!ERROR: FINAL subroutine 's17' of derived type 'child' must have a TYPE(child) dummy argument42 final :: s11, s12, s13, s14, s15, s16, s1743!ERROR: FINAL subroutine 'valid' already appeared in this derived type44 final :: valid45!ERROR: FINAL subroutines 'valid2' and 'valid' of derived type 'child' cannot be distinguished by rank or KIND type parameter value46 final :: valid247 end type48 contains49 subroutine valid(x)50 type(child(len1=*, len2=*)), intent(inout) :: x51 end subroutine52 subroutine valid2(x)53 type(child(len1=*, len2=*)), intent(inout) :: x54 end subroutine55 real function func(x)56 type(child(len1=*, len2=*)), intent(inout) :: x57 func = 0.58 end function59 subroutine s01(*)60 end subroutine61 subroutine s02(x)62 external :: x63 end subroutine64 subroutine s03(x)65 type(child(kind1=3, len1=*, len2=*)), intent(out) :: x66 end subroutine67 subroutine s04(x)68 type(child(kind1=4, len1=*, len2=*)), value :: x69 end subroutine70 subroutine s05(x)71 type(child(kind1=5, len1=*, len2=*)), pointer :: x72 end subroutine73 subroutine s06(x)74 type(child(kind1=6, len1=*, len2=*)), allocatable :: x75 end subroutine76 subroutine s07(x)77 type(child(kind1=7, len1=*, len2=*)) :: x[*]78 end subroutine79 subroutine s08(x)80 class(child(kind1=8, len1=*, len2=*)) :: x81 end subroutine82 subroutine s09(x)83 class(*) :: x84 end subroutine85 subroutine s10(x)86 type(child(kind1=10, len1=*, len2=*)), optional :: x87 end subroutine88 subroutine s11(x, y)89 type(child(kind1=11, len1=*, len2=*)) :: x, y90 end subroutine91 subroutine s1292 end subroutine93 subroutine s13(x)94 type(child(kind1=13)) :: x95 end subroutine96 subroutine s14(x)97 type(child(kind1=14, len1=*,len2=2)) :: x98 end subroutine99 subroutine s15(x)100 type(child(kind1=15, len2=*)) :: x101 end subroutine102 subroutine s16(x)103 type(*) :: x104 end subroutine105 subroutine s17(x)106 type(parent(kind1=17, len1=*)) :: x107 end subroutine108 subroutine nested109 type :: t110 contains111!ERROR: FINAL subroutine 'internal' of derived type 't' must be a module procedure112 final :: internal113 end type114 contains115 subroutine internal(x)116 type(t), intent(inout) :: x117 end subroutine118 end subroutine119end module120