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