flang/test/Semantics/associate01.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Tests of selectors whose defining expressions are pointer-valued functions;
   3 ! they must be valid targets, but not pointers.
   4 ! (F'2018 11.1.3.3 p1) "The associating entity does not have the ALLOCATABLE or
   5 ! POINTER attributes; it has the TARGET attribute if and only if the selector
   6 ! is a variable and has either the TARGET or POINTER attribute."
   7 module m1
   8   type t
   9    contains
  10     procedure, nopass :: iptr
  11   end type
  12  contains
  13   function iptr(n)
  14     integer, intent(in), target :: n
  15     integer, pointer :: iptr
  16     iptr => n
  17   end function
  18   subroutine test
  19     type(t) tv
  20     integer, target :: itarget
  21     integer, pointer :: ip
  22     associate (sel => iptr(itarget))
  23       ip => sel
  24       !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  25       if (.not. associated(sel)) stop
  26     end associate
  27     associate (sel => tv%iptr(itarget))
  28       ip => sel
  29       !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  30       if (.not. associated(sel)) stop
  31     end associate
  32     associate (sel => (iptr(itarget)))
  33       !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
  34       ip => sel
  35       !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  36       if (.not. associated(sel)) stop
  37     end associate
  38     associate (sel => 0 + iptr(itarget))
  39       !ERROR: In assignment to object pointer 'ip', the target 'sel' is not an object with POINTER or TARGET attributes
  40       ip => sel
  41       !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
  42       if (.not. associated(sel)) stop
  43     end associate
  44   end subroutine
  45 end module