146 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc12! Tests for C760:3! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable4! 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 polymorphic6! (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 no10! arguments, NOPASS shall be specified.11!12! C758 If PASS (arg-name) appears, the interface of the procedure pointer13! component shall have a dummy argument named arg-name.14 15 16module m117 type :: t18 procedure(real), pointer, nopass :: a19 !ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface20 procedure(real), pointer :: b21 end type22end23 24module m225 type :: t26 !ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute27 procedure(s1), pointer :: a28 !ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute29 procedure(s1), pointer, pass :: b30 contains31 !ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute32 procedure :: p1 => s133 !ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute34 procedure, pass :: p2 => s135 end type36contains37 subroutine s1()38 end39end40 41module m342 type :: t43 !ERROR: 'y' is not a dummy argument of procedure interface 's'44 procedure(s), pointer, pass(y) :: a45 contains46 !ERROR: 'z' is not a dummy argument of procedure interface 's'47 procedure, pass(z) :: p => s48 end type49contains50 subroutine s(x)51 class(t) :: x52 end53 subroutine test54 type(t) x55 !ERROR: Dummy argument 'x=' (#1) is not OPTIONAL and is not associated with an actual argument in this procedure reference56 call x%p57 end58end59 60module m461 type :: t62 !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute63 procedure(s1), pointer :: a64 !ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute65 procedure(s2), pointer, pass(x) :: b66 !ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object67 procedure(s3), pointer, pass :: c68 !ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar69 procedure(s4), pointer, pass :: d70 end type71contains72 subroutine s1(x)73 class(t), pointer :: x74 end75 subroutine s2(w, x)76 real :: x77 !ERROR: The type of 'x' has already been declared78 class(t), allocatable :: x79 end80 subroutine s3(f)81 interface82 real function f()83 end function84 end interface85 end86 subroutine s4(x)87 class(t) :: x(10)88 end89end90 91module m592 type :: t193 sequence94 !ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)'95 procedure(s), pointer :: a96 end type97 type :: t298 contains99 !ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)'100 procedure, pass(y) :: s101 end type102contains103 subroutine s(x, y)104 real :: x105 type(t1) :: y106 end107end108 109module m6110 type :: t(k, l)111 integer, kind :: k112 integer, len :: l113 !ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l'114 procedure(s1), pointer :: a115 end type116contains117 subroutine s1(x)118 class(t(1, 2)) :: x119 end120end121 122module m7123 type :: t124 sequence ! t is not extensible125 !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible126 procedure(s), pointer :: a127 end type128contains129 subroutine s(x)130 !ERROR: Non-extensible derived type 't' may not be used with CLASS keyword131 class(t) :: x132 end133end134 135module m8136 type :: t137 contains138 !ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible139 procedure :: s140 end type141contains142 subroutine s(x)143 type(t) :: x ! x is not polymorphic144 end145end146