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