flang/test/Semantics/final01.f90

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