|
111
|
1 ! { dg-do compile }
|
|
|
2 !
|
|
|
3 ! PR fortran/50684
|
|
|
4 !
|
|
|
5 ! Module "bug" contributed by Martin Steghöfer.
|
|
|
6 !
|
|
|
7
|
|
|
8 MODULE BUG
|
|
|
9 TYPE MY_TYPE
|
|
|
10 INTEGER, ALLOCATABLE :: VALUE
|
|
|
11 END TYPE
|
|
|
12 CONTAINS
|
|
|
13 SUBROUTINE POINTER_INTENT_IN_BUG_WORKING(POINTER_INTENT_IN_VARIABLE)
|
|
|
14 TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
|
|
|
15 TYPE(MY_TYPE), POINTER :: POINTER_VARIABLE_LOCAL
|
|
|
16 INTEGER, ALLOCATABLE :: LOCAL_VALUE
|
|
|
17
|
|
|
18 POINTER_VARIABLE_LOCAL=>POINTER_INTENT_IN_VARIABLE
|
|
|
19 CALL MOVE_ALLOC(POINTER_VARIABLE_LOCAL%VALUE, LOCAL_VALUE)
|
|
|
20
|
|
|
21 RETURN
|
|
|
22 END SUBROUTINE POINTER_INTENT_IN_BUG_WORKING
|
|
|
23
|
|
|
24 SUBROUTINE POINTER_INTENT_IN_BUG_FAILING(POINTER_INTENT_IN_VARIABLE)
|
|
|
25 TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
|
|
|
26 INTEGER, ALLOCATABLE :: LOCAL_VALUE
|
|
|
27
|
|
|
28 CALL MOVE_ALLOC(POINTER_INTENT_IN_VARIABLE%VALUE, LOCAL_VALUE)
|
|
|
29
|
|
|
30 RETURN
|
|
|
31 END SUBROUTINE POINTER_INTENT_IN_BUG_FAILING
|
|
|
32 end module bug
|
|
|
33
|
|
|
34 subroutine test1()
|
|
|
35 TYPE MY_TYPE
|
|
|
36 INTEGER, ALLOCATABLE :: VALUE
|
|
|
37 END TYPE
|
|
|
38 CONTAINS
|
|
|
39 SUBROUTINE sub (dt)
|
|
|
40 type(MY_TYPE), intent(in) :: dt
|
|
|
41 INTEGER, ALLOCATABLE :: lv
|
|
|
42 call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
|
|
|
43 END SUBROUTINE
|
|
|
44 end subroutine test1
|
|
|
45
|
|
|
46 subroutine test2 (x, px)
|
|
|
47 implicit none
|
|
|
48 type t
|
|
|
49 integer, allocatable :: a
|
|
|
50 end type t
|
|
|
51
|
|
|
52 type t2
|
|
|
53 type(t), pointer :: ptr
|
|
|
54 integer, allocatable :: a
|
|
|
55 end type t2
|
|
|
56
|
|
|
57 type(t2), intent(in) :: x
|
|
|
58 type(t2), pointer, intent(in) :: px
|
|
|
59
|
|
|
60 integer, allocatable :: a
|
|
|
61 type(t2), pointer :: ta
|
|
|
62
|
|
|
63 call move_alloc (px, ta) ! { dg-error "cannot be INTENT.IN." }
|
|
|
64 call move_alloc (x%a, a) ! { dg-error "cannot be INTENT.IN." }
|
|
|
65 call move_alloc (x%ptr%a, a) ! OK (3)
|
|
|
66 call move_alloc (px%a, a) ! OK (4)
|
|
|
67 call move_alloc (px%ptr%a, a) ! OK (5)
|
|
|
68 end subroutine test2
|
|
|
69
|
|
|
70 subroutine test3 (x, px)
|
|
|
71 implicit none
|
|
|
72 type t
|
|
|
73 integer, allocatable :: a
|
|
|
74 end type t
|
|
|
75
|
|
|
76 type t2
|
|
|
77 class(t), pointer :: ptr
|
|
|
78 integer, allocatable :: a
|
|
|
79 end type t2
|
|
|
80
|
|
|
81 type(t2), intent(in) :: x
|
|
|
82 class(t2), pointer, intent(in) :: px
|
|
|
83
|
|
|
84 integer, allocatable :: a
|
|
|
85 class(t2), pointer :: ta
|
|
|
86
|
|
|
87 call move_alloc (px, ta) ! { dg-error "cannot be INTENT.IN." }
|
|
|
88 call move_alloc (x%a, a) ! { dg-error "cannot be INTENT.IN." }
|
|
|
89 call move_alloc (x%ptr%a, a) ! OK (6)
|
|
|
90 call move_alloc (px%a, a) ! OK (7)
|
|
|
91 call move_alloc (px%ptr%a, a) ! OK (8)
|
|
|
92 end subroutine test3
|
|
|
93
|
|
|
94 subroutine test4()
|
|
|
95 TYPE MY_TYPE
|
|
|
96 INTEGER, ALLOCATABLE :: VALUE
|
|
|
97 END TYPE
|
|
|
98 CONTAINS
|
|
|
99 SUBROUTINE sub (dt)
|
|
|
100 CLASS(MY_TYPE), intent(in) :: dt
|
|
|
101 INTEGER, ALLOCATABLE :: lv
|
|
|
102 call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
|
|
|
103 END SUBROUTINE
|
|
|
104 end subroutine test4
|
