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