flang/test/Semantics/call31.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
   2 ! Confirm enforcement of constraint C723 in F2018 for procedure pointers
   3
   4       module m
   5        contains
   6         subroutine subr(parg)
   7           !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
   8           procedure(character(*)), pointer :: parg
   9           !ERROR: An assumed (*) type parameter may be used only for a (non-statement function) dummy argument, associate name, named constant, or external function result
  10           procedure(character(*)), pointer :: plocal
  11           print *, parg()
  12           plocal => parg
  13           call subr_1(plocal)
  14         end subroutine
  15
  16         subroutine subr_1(parg_1)
  17           !PORTABILITY: A dummy procedure pointer should not have assumed-length CHARACTER(*) result type
  18           procedure(character(*)), pointer :: parg_1
  19           print *, parg_1()
  20         end subroutine
  21       end module
  22
  23       character(*) function f()
  24         f = 'abcdefgh'
  25       end function
  26
  27       program test
  28         use m
  29         character(4), external :: f
  30         procedure(character(4)), pointer :: p
  31         p => f
  32         call subr(p)
  33       end
  34