xref: /llvm-project/flang/test/Semantics/forall02.f90 (revision a5f576e5961ecc099bd7ccf8565da090edc84b0d)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2
3module 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
66end module m1
67
68