flang/test/Semantics/resolve102.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2
   3 ! Tests for circularly defined procedures
   4 !ERROR: Procedure 'sub' is recursively defined.  Procedures in the cycle: 'sub', 'p2'
   5 subroutine sub(p2)
   6   PROCEDURE(sub) :: p2
   7
   8   call sub()
   9 end subroutine
  10
  11 subroutine circular
  12   !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
  13   procedure(sub) :: p
  14
  15   call p(sub)
  16
  17   contains
  18     subroutine sub(p2)
  19       procedure(p) :: p2
  20     end subroutine
  21 end subroutine circular
  22
  23 !ERROR: Procedure 'foo' is recursively defined.  Procedures in the cycle: 'foo', 'r'
  24 function foo() result(r)
  25   !ERROR: Procedure 'r' is recursively defined.  Procedures in the cycle: 'foo', 'r'
  26   procedure(foo), pointer :: r
  27 end function foo
  28
  29 subroutine iface
  30   !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
  31   procedure(sub) :: p
  32   interface
  33     !ERROR: Procedure 'sub' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
  34     subroutine sub(p2)
  35       import p
  36       procedure(p) :: p2
  37     end subroutine
  38   end interface
  39   call p(sub)
  40 end subroutine
  41
  42 subroutine mutual
  43   Procedure(sub1) :: p
  44
  45   Call p(sub)
  46
  47   contains
  48     !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'p', 'sub1', 'arg'
  49     Subroutine sub1(arg)
  50       procedure(sub1) :: arg
  51     End Subroutine
  52
  53     Subroutine sub(p2)
  54       Procedure(sub1) :: p2
  55     End Subroutine
  56 End subroutine
  57
  58 subroutine mutual1
  59   Procedure(sub1) :: p
  60
  61   Call p(sub)
  62
  63   contains
  64     !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'p', 'sub1', 'arg', 'sub', 'p2'
  65     Subroutine sub1(arg)
  66       procedure(sub) :: arg
  67     End Subroutine
  68
  69     Subroutine sub(p2)
  70       Procedure(sub1) :: p2
  71     End Subroutine
  72 End subroutine
  73
  74 subroutine twoCycle
  75   !ERROR: The interface for procedure 'p1' is recursively defined
  76   !ERROR: The interface for procedure 'p2' is recursively defined
  77   procedure(p1) p2
  78   procedure(p2) p1
  79   call p1
  80   call p2
  81 end subroutine
  82
  83 subroutine threeCycle
  84   !ERROR: The interface for procedure 'p1' is recursively defined
  85   !ERROR: The interface for procedure 'p2' is recursively defined
  86   procedure(p1) p2
  87   !ERROR: The interface for procedure 'p3' is recursively defined
  88   procedure(p2) p3
  89   procedure(p3) p1
  90   call p1
  91   call p2
  92   call p3
  93 end subroutine
  94
  95 module mutualSpecExprs
  96 contains
  97   pure integer function f(n)
  98     integer, intent(in) :: n
  99     real arr(g(n))
 100     f = size(arr)
 101   end function
 102   pure integer function g(n)
 103     integer, intent(in) :: n
 104     !ERROR: Procedure 'f' is referenced before being sufficiently defined in a context where it must be so
 105     real arr(f(n))
 106     g = size(arr)
 107   end function
 108 end