• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1! RUN: %S/test_errors.sh %s %t %f18
2! Test DO loop semantics for constraint C1130 --
3! The constraint states that "If the locality-spec DEFAULT ( NONE ) appears in a
4! DO CONCURRENT statement; a variable that is a local or construct entity of a
5! scope containing the DO CONCURRENT construct; and that appears in the block of
6! the construct; shall have its locality explicitly specified by that
7! statement."
8
9module m
10  real :: mvar
11end module m
12
13subroutine s1()
14  use m
15  integer :: i, ivar, jvar, kvar
16  real :: x
17
18  type point
19    real :: x, y
20  end type point
21
22  type, extends(point) :: color_point
23    integer :: color
24  end type color_point
25
26  type(point), target :: c
27  class(point), pointer :: p_or_c
28
29  p_or_c => c
30
31  jvar = 5
32
33  ! References in this DO CONCURRENT are OK since there's no DEFAULT(NONE)
34  ! locality-spec
35  associate (avar => ivar)
36    do concurrent (i = 1:2) shared(jvar)
37      ivar = 3
38      ivar = ivar + i
39      block
40        real :: bvar
41        avar = 4
42        x = 3.5
43        bvar = 3.5 + i
44      end block
45      jvar = 5
46      mvar = 3.5
47    end do
48  end associate
49
50  associate (avar => ivar)
51!ERROR: DO CONCURRENT step expression may not be zero
52    do concurrent (i = 1:2:0) default(none) shared(jvar) local(kvar)
53!ERROR: Variable 'ivar' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
54      ivar =  &
55!ERROR: Variable 'ivar' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
56        ivar + i
57      block
58        real :: bvar
59!ERROR: Variable 'avar' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
60        avar = 4
61!ERROR: Variable 'x' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
62        x = 3.5
63        bvar = 3.5 + i ! OK, bvar's scope is within the DO CONCURRENT
64      end block
65      jvar = 5 ! OK, jvar appears in a locality spec
66      kvar = 5 ! OK, kvar appears in a locality spec
67
68!ERROR: Variable 'mvar' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
69      mvar = 3.5
70    end do
71  end associate
72
73  select type ( a => p_or_c )
74  type is ( point )
75    do concurrent (i=1:5) local(a)
76      ! C1130 This is OK because there's no DEFAULT(NONE) locality spec
77      a%x = 3.5
78    end do
79  end select
80
81  select type ( a => p_or_c )
82  type is ( point )
83    do concurrent (i=1:5) default (none)
84!ERROR: Variable 'a' from an enclosing scope referenced in DO CONCURRENT with DEFAULT(NONE) must appear in a locality-spec
85      a%x = 3.5
86    end do
87  end select
88
89  select type ( a => p_or_c )
90  type is ( point )
91    do concurrent (i=1:5) default (none) local(a)
92      ! C1130 This is OK because 'a' is in a locality-spec
93      a%x = 3.5
94    end do
95  end select
96
97  x = 5.0  ! OK, we're not in a DO CONCURRENT
98
99end subroutine s1
100