|
111
|
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 !
|
|
|
15 MODULE pr20863
|
|
|
16 TYPE node_type
|
|
|
17 TYPE(node_type), POINTER :: next=>null()
|
|
|
18 END TYPE
|
|
|
19 CONTAINS
|
|
|
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
|
|
145
|
43 give_next = node ! { dg-error "pure subprogram" }
|
|
111
|
44 END FUNCTION
|
|
|
45 END MODULE pr20863
|
|
|
46
|
|
|
47 MODULE pr20882
|
|
|
48 TYPE T1
|
|
|
49 INTEGER :: I
|
|
|
50 END TYPE T1
|
|
|
51 TYPE(T1), POINTER :: B
|
|
|
52 CONTAINS
|
|
|
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
|
|
|
68 END MODULE pr20882
|
