xref: /llvm-project/flang/test/Semantics/resolve55.f90 (revision 3af717d661e9fe8d562181b933a373ca58e41b27)
1! RUN: %python %S/test_errors.py %s %flang_fc1
2! Tests for F'2023 C1130:
3! A variable-name that appears in a LOCAL or LOCAL_INIT locality-spec shall not
4! have the ALLOCATABLE; INTENT (IN); or OPTIONAL attribute; shall not be of
5! finalizable type; shall not be a nonpointer polymorphic dummy argument; and
6! shall not be a coarray or an assumed-size array.
7
8subroutine s1()
9! Cannot have ALLOCATABLE variable in a LOCAL/LOCAL_INIT locality spec
10  integer, allocatable :: k
11!ERROR: ALLOCATABLE variable 'k' not allowed in a LOCAL locality-spec
12  do concurrent(i=1:5) local(k)
13  end do
14!ERROR: ALLOCATABLE variable 'k' not allowed in a LOCAL_INIT locality-spec
15  do concurrent(i=1:5) local_init(k)
16  end do
17end subroutine s1
18
19subroutine s2(arg)
20! Cannot have a dummy OPTIONAL in a locality spec
21  integer, optional :: arg
22!ERROR: OPTIONAL argument 'arg' not allowed in a locality-spec
23  do concurrent(i=1:5) local(arg)
24  end do
25end subroutine s2
26
27subroutine s3(arg)
28! This is OK
29  real :: arg
30  do concurrent(i=1:5) local(arg)
31  end do
32end subroutine s3
33
34subroutine s4(arg)
35! Cannot have a dummy INTENT(IN) in a locality spec
36  real, intent(in) :: arg
37!ERROR: INTENT IN argument 'arg' not allowed in a locality-spec
38  do concurrent(i=1:5) local(arg)
39  end do
40end subroutine s4
41
42module m
43! Cannot have a variable of a finalizable type in a LOCAL locality spec
44  type t1
45    integer :: i
46  contains
47    final :: f
48  end type t1
49 contains
50  subroutine s5()
51    type(t1) :: var
52    !ERROR: Finalizable variable 'var' not allowed in a LOCAL locality-spec
53    do concurrent(i=1:5) local(var)
54    end do
55  end subroutine s5
56  subroutine f(x)
57    type(t1) :: x
58  end subroutine f
59end module m
60
61subroutine s6
62! Cannot have a nonpointer polymorphic dummy argument in a LOCAL locality spec
63  type :: t
64    integer :: field
65  end type t
66contains
67  subroutine s(x, y)
68    class(t), pointer :: x
69    class(t) :: y
70
71! This is allowed
72    do concurrent(i=1:5) local(x)
73    end do
74
75! This is not allowed
76!ERROR: Nonpointer polymorphic argument 'y' not allowed in a LOCAL locality-spec
77    do concurrent(i=1:5) local(y)
78    end do
79  end subroutine s
80end subroutine s6
81
82subroutine s7()
83! Cannot have a coarray
84  integer, codimension[*] :: coarray_var
85!ERROR: Coarray 'coarray_var' not allowed in a LOCAL locality-spec
86  do concurrent(i=1:5) local(coarray_var)
87  end do
88end subroutine s7
89
90subroutine s8(arg)
91! Cannot have an assumed size array
92  integer, dimension(*) :: arg
93!ERROR: Assumed size array 'arg' not allowed in a locality-spec
94  do concurrent(i=1:5) local(arg)
95  end do
96end subroutine s8
97