1! RUN: %S/test_errors.sh %s %t %flang_fc1 2! REQUIRES: shell 3! Tests for C760: 4! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable 5! dummy data object with the same declared type as the type being defined; 6! all of its length type parameters shall be assumed; it shall be polymorphic 7! (7.3.2.3) if and only if the type being defined is extensible (7.5.7). 8! It shall not have the VALUE attribute. 9! 10! C757 If the procedure pointer component has an implicit interface or has no 11! arguments, NOPASS shall be specified. 12! 13! C758 If PASS (arg-name) appears, the interface of the procedure pointer 14! component shall have a dummy argument named arg-name. 15 16 17module m1 18 type :: t 19 procedure(real), pointer, nopass :: a 20 !ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface 21 procedure(real), pointer :: b 22 end type 23end 24 25module m2 26 type :: t 27 !ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute 28 procedure(s1), pointer :: a 29 !ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute 30 procedure(s1), pointer, pass :: b 31 contains 32 !ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute 33 procedure :: p1 => s1 34 !ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute 35 procedure, pass :: p2 => s1 36 end type 37contains 38 subroutine s1() 39 end 40end 41 42module m3 43 type :: t 44 !ERROR: 'y' is not a dummy argument of procedure interface 's' 45 procedure(s), pointer, pass(y) :: a 46 contains 47 !ERROR: 'z' is not a dummy argument of procedure interface 's' 48 procedure, pass(z) :: p => s 49 end type 50contains 51 subroutine s(x) 52 class(t) :: x 53 end 54end 55 56module m4 57 type :: t 58 !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute 59 procedure(s1), pointer :: a 60 !ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute 61 procedure(s2), pointer, pass(x) :: b 62 !ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object 63 procedure(s3), pointer, pass :: c 64 !ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar 65 procedure(s4), pointer, pass :: d 66 end type 67contains 68 subroutine s1(x) 69 class(t), pointer :: x 70 end 71 subroutine s2(w, x) 72 real :: x 73 !ERROR: The type of 'x' has already been declared 74 class(t), allocatable :: x 75 end 76 subroutine s3(f) 77 interface 78 real function f() 79 end function 80 end interface 81 end 82 subroutine s4(x) 83 class(t) :: x(10) 84 end 85end 86 87module m5 88 type :: t1 89 sequence 90 !ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)' 91 procedure(s), pointer :: a 92 end type 93 type :: t2 94 contains 95 !ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)' 96 procedure, pass(y) :: s 97 end type 98contains 99 subroutine s(x, y) 100 real :: x 101 type(t1) :: y 102 end 103end 104 105module m6 106 type :: t(k, l) 107 integer, kind :: k 108 integer, len :: l 109 !ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l' 110 procedure(s1), pointer :: a 111 end type 112contains 113 subroutine s1(x) 114 class(t(1, 2)) :: x 115 end 116end 117 118module m7 119 type :: t 120 sequence ! t is not extensible 121 !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible 122 procedure(s), pointer :: a 123 end type 124contains 125 subroutine s(x) 126 !ERROR: Non-extensible derived type 't' may not be used with CLASS keyword 127 class(t) :: x 128 end 129end 130 131module m8 132 type :: t 133 contains 134 !ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible 135 procedure :: s 136 end type 137contains 138 subroutine s(x) 139 type(t) :: x ! x is not polymorphic 140 end 141end 142