URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [move_alloc_8.f90] - Blame information for rev 749

Go to most recent revision | Details | Compare with Previous | View Log


! { dg-do compile }
!
! PR fortran/50684
!
! Module "bug" contributed by Martin Steghöfer.
!
 
MODULE BUG
  TYPE MY_TYPE
    INTEGER, ALLOCATABLE :: VALUE
  END TYPE
CONTAINS
  SUBROUTINE POINTER_INTENT_IN_BUG_WORKING(POINTER_INTENT_IN_VARIABLE)
    TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
    TYPE(MY_TYPE), POINTER :: POINTER_VARIABLE_LOCAL
    INTEGER, ALLOCATABLE :: LOCAL_VALUE
 
    POINTER_VARIABLE_LOCAL=>POINTER_INTENT_IN_VARIABLE
    CALL MOVE_ALLOC(POINTER_VARIABLE_LOCAL%VALUE, LOCAL_VALUE)
 
    RETURN
  END SUBROUTINE POINTER_INTENT_IN_BUG_WORKING
 
  SUBROUTINE POINTER_INTENT_IN_BUG_FAILING(POINTER_INTENT_IN_VARIABLE)
    TYPE(MY_TYPE), POINTER, INTENT(IN) :: POINTER_INTENT_IN_VARIABLE
    INTEGER, ALLOCATABLE :: LOCAL_VALUE
 
    CALL MOVE_ALLOC(POINTER_INTENT_IN_VARIABLE%VALUE, LOCAL_VALUE)
 
    RETURN
  END SUBROUTINE POINTER_INTENT_IN_BUG_FAILING
end module bug
 
subroutine test1()
  TYPE MY_TYPE
    INTEGER, ALLOCATABLE :: VALUE
  END TYPE
CONTAINS
  SUBROUTINE sub (dt)
    type(MY_TYPE), intent(in) :: dt
    INTEGER, ALLOCATABLE :: lv
    call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
  END SUBROUTINE
end subroutine test1
 
subroutine test2 (x, px)
  implicit none
  type t
    integer, allocatable :: a
  end type t
 
  type t2
    type(t), pointer :: ptr
    integer, allocatable :: a
  end type t2
 
  type(t2), intent(in) :: x
  type(t2), pointer, intent(in) :: px
 
  integer, allocatable :: a
  type(t2), pointer :: ta
 
  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
  call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
  call move_alloc (x%ptr%a, a)  ! OK (3)
  call move_alloc (px%a, a)     ! OK (4)
  call move_alloc (px%ptr%a, a) ! OK (5)
end subroutine test2
 
subroutine test3 (x, px)
  implicit none
  type t
    integer, allocatable :: a
  end type t
 
  type t2
    class(t), pointer :: ptr
    integer, allocatable :: a
  end type t2
 
  type(t2), intent(in) :: x
  class(t2), pointer, intent(in) :: px
 
  integer, allocatable :: a
  class(t2), pointer :: ta
 
  call move_alloc (px, ta)      ! { dg-error "cannot be INTENT.IN." }
  call move_alloc (x%a, a)      ! { dg-error "cannot be INTENT.IN." }
  call move_alloc (x%ptr%a, a)  ! OK (6)
  call move_alloc (px%a, a)     ! OK (7)
  call move_alloc (px%ptr%a, a) ! OK (8)
end subroutine test3
 
subroutine test4()
  TYPE MY_TYPE
    INTEGER, ALLOCATABLE :: VALUE
  END TYPE
CONTAINS
  SUBROUTINE sub (dt)
    CLASS(MY_TYPE), intent(in) :: dt
    INTEGER, ALLOCATABLE :: lv
    call move_alloc(dt%VALUE, lv) ! { dg-error "cannot be INTENT.IN." }
  END SUBROUTINE
end subroutine test4
 
! { dg-final { cleanup-modules "bug" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { 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`
105
106			`! { dg-final { cleanup-modules "bug" } }`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [move_alloc_8.f90] - Blame information for rev 749