gcc/testsuite/gfortran.dg/move_alloc_8.f90

   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 "must be ALLOCATABLE" }
  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 "must be ALLOCATABLE" }
  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