1! { dg-do compile } 2! Tests the fix for PR20863 and PR20882, which were concerned with incorrect 3! application of constraints associated with "impure" variables in PURE 4! procedures. 5! 6! resolve.c (gfc_impure_variable) detects the following: 7! 12.6 Constraint: In a pure subprogram any variable which is in common or 8! accessed by host or use association, is a dummy argument to a pure function, 9! is a dummy argument with INTENT (IN) to a pure subroutine, or an object that 10! is storage associated with any such variable, shall not be used in the 11! following contexts: (clients of this function). */ 12! 13! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 14! 15MODULE pr20863 16 TYPE node_type 17 TYPE(node_type), POINTER :: next=>null() 18 END TYPE 19CONTAINS 20! Original bug - pointer assignments to "impure" derived type with 21! pointer component. 22 PURE FUNCTION give_next1(node) 23 TYPE(node_type), POINTER :: node 24 TYPE(node_type), POINTER :: give_next 25 give_next => node%next ! { dg-error "Bad target" } 26 node%next => give_next ! { dg-error "variable definition context" } 27 END FUNCTION 28! Comment #2 29 PURE integer FUNCTION give_next2(i) 30 TYPE node_type 31 sequence 32 TYPE(node_type), POINTER :: next 33 END TYPE 34 TYPE(node_type), POINTER :: node 35 TYPE(node_type), target :: t 36 integer, intent(in) :: i 37 node%next = t ! This is OK 38 give_next2 = i 39 END FUNCTION 40 PURE FUNCTION give_next3(node) 41 TYPE(node_type), intent(in) :: node 42 TYPE(node_type) :: give_next 43 give_next = node ! { dg-error "impure variable" } 44 END FUNCTION 45END MODULE pr20863 46 47MODULE pr20882 48 TYPE T1 49 INTEGER :: I 50 END TYPE T1 51 TYPE(T1), POINTER :: B 52CONTAINS 53 PURE FUNCTION TST(A) RESULT(RES) 54 TYPE(T1), INTENT(IN), TARGET :: A 55 TYPE(T1), POINTER :: RES 56 RES => A ! { dg-error "Bad target" } 57 RES => B ! { dg-error "Bad target" } 58 B => RES ! { dg-error "variable definition context" } 59 END FUNCTION 60 PURE FUNCTION TST2(A) RESULT(RES) 61 TYPE(T1), INTENT(IN), TARGET :: A 62 TYPE(T1), POINTER :: RES 63 allocate (RES) 64 RES = A 65 B = RES ! { dg-error "variable definition context" } 66 RES = B 67 END FUNCTION 68END MODULE pr20882 69