flang/test/Semantics/forall02.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2
   3 module m1
   4   type :: impureFinal
   5   contains
   6     final :: impureSub
   7     final :: impureSubRank1
   8     final :: impureSubRank2
   9   end type
  10
  11  contains
  12
  13   impure subroutine impureSub(x)
  14     type(impureFinal), intent(in) :: x
  15   end subroutine
  16
  17   impure subroutine impureSubRank1(x)
  18     type(impureFinal), intent(in) :: x(:)
  19   end subroutine
  20
  21   impure subroutine impureSubRank2(x)
  22     type(impureFinal), intent(in) :: x(:,:)
  23   end subroutine
  24
  25   subroutine s1()
  26     implicit none
  27     integer :: i
  28     type(impureFinal), allocatable :: ifVar, ifvar1
  29     type(impureFinal), allocatable :: ifArr1(:), ifArr2(:,:)
  30     type(impureFinal) :: if0
  31     integer a(10)
  32     allocate(ifVar)
  33     allocate(ifVar1)
  34     allocate(ifArr1(5), ifArr2(5,5))
  35
  36     ! Error to invoke an IMPURE FINAL procedure in a FORALL
  37     forall (i = 1:10)
  38       !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
  39       !ERROR: Impure procedure 'impuresub' is referenced by finalization in a FORALL
  40       ifvar = ifvar1
  41     end forall
  42
  43     forall (i = 1:5)
  44       !ERROR: Impure procedure 'impuresub' is referenced by finalization in a FORALL
  45       ifArr1(i) = if0
  46     end forall
  47
  48     forall (i = 1:5)
  49       !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
  50       !ERROR: Impure procedure 'impuresubrank1' is referenced by finalization in a FORALL
  51       ifArr1 = if0
  52     end forall
  53
  54     forall (i = 1:5)
  55       !ERROR: Impure procedure 'impuresubrank1' is referenced by finalization in a FORALL
  56       ifArr2(i,:) = if0
  57     end forall
  58
  59     forall (i = 1:5)
  60       !WARNING: FORALL index variable 'i' not used on left-hand side of assignment
  61       !ERROR: Impure procedure 'impuresubrank2' is referenced by finalization in a FORALL
  62       ifArr2(:,:) = if0
  63     end forall
  64   end subroutine
  65
  66 end module m1
  67