[Flang][OpenMP 4.5] Add semantic check for OpenMP Reduction Clause

[yhegde]

Summary

Semantic check for OpenMP 4.5 - 2.15.3.6 Reduction clause

Files:
check-directive-structure.h
check-omp-structure.h
check-omp-structure.cpp

Test cases:
omp-reduction01.f90
omp-reduction02.f90
omp-reduction03.f90
omp-reduction04.f90
omp-reduction05.f90
omp-reduction06.f90
omp-reduction07.f90
omp-reduction08.f90

[clementval]

Couple of comments and questions.

flang/lib/Semantics/check-directive-structure.h

322

The check and the error message seem very OpenMP specific. It would be better to move this to the OpenMP specific file. If it is reusable by OpenACC the error message should be passed to the function.

flang/test/Semantics/omp-reduction01.f90

12

Indent does not follows other tests already upstreamed.

flang/test/Semantics/omp-reduction02.f90

13

Same comment for the indentation.

flang/test/Semantics/omp-reduction03.f90

14

Indentation

flang/test/Semantics/omp-reduction04.f90

12

Indentation

flang/test/Semantics/omp-reduction05.f90

14

Indentation

flang/test/Semantics/omp-reduction06.f90

14

Indentation

flang/test/Semantics/omp-reduction07.f90

11

Indentation

[kiranchandramohan]

Thanks for this patch.

Can you check what is happening with this test?

      subroutine sb(q,nx)
      integer :: q(100)
      integer :: t1, t8
!$OMP PARALLEL DO PRIVATE(k,t1) REDUCTION(max:t8)
      do k=1,nx
        t1=q(k)
        t8=max(t8,t1)
      enddo
      end

[kiranchandramohan]

Would need a response for questions above to proceed to acceptance.

[yhegde]

In D90697#2372471, @kiranchandramohan wrote:

Thanks for this patch.

Can you check what is happening with this test?

      subroutine sb(q,nx)
      integer :: q(100)
      integer :: t1, t8
!$OMP PARALLEL DO PRIVATE(k,t1) REDUCTION(max:t8)
      do k=1,nx
        t1=q(k)
        t8=max(t8,t1)
      enddo
      end

Thank you very much @kiranchandramohan and @clementval for all the review comments. Working on this test case. Looks like there is nothing defined for max, min etc like parser::DefinedOperator::IntrinsicOperator is defined for Add, Subtract etc. I have attempted to define them. Will send the patch soon. Please let me know if the changes are in rt direction. Thanks again.
regards

[kiranchandramohan]

@clementval had some changes for the OpenACC reduction operator in the following commit. I am not sure whether it is related to this issue.
https://reviews.llvm.org/D86296

[clementval]

In D90697#2393971, @kiranchandramohan wrote:

@clementval had some changes for the OpenACC reduction operator in the following commit. I am not sure whether it is related to this issue.
https://reviews.llvm.org/D86296

Yeah that's what triggered the patch on the OpenACC side. Not sure you can follow the same path for OpenMP since you have to support user defined reduction operator.

[yhegde]

Thank you both @kiranchandramohan and @clementval for your review comments and inputs.

I have considered MAX, MIN, IAND, IOR and IEOR as IntrinsicProcedures. Hope that is ok. Positive test cases for the same are added.

[tskeith]

flang/include/flang/Parser/parse-tree.h

590 ↗

(On Diff #305204)

This change doesn't belong here, it should be in OpenMP-specific code. A defined-operator in Fortran does not include any intrinsic procedures.

flang/lib/Parser/Fortran-parsers.cpp

110 ↗

(On Diff #305204)

Same problem here. This accepts interface operator(max) which is not valid Fortran.

[clementval]

flang/include/flang/Parser/parse-tree.h

590 ↗

(On Diff #305204)

Thanks @tskeith for looking at this. +1

flang/include/flang/Semantics/symbol.h

403 ↗

(On Diff #305204)

Not sure if this is the way to go since you add only a fraction of intrinsic procedure her

[yhegde]

Thanks for review comments.
The code changes with this patch includes ResolvingNames for max, min, iand, ior, and ieor , assuming that the reduction clause can take user defined procedures.

[kiranchandramohan]

flang/lib/Semantics/check-omp-structure.cpp

786

Is some code missing here?

Is that the reason why the following code does not work?

program test
  integer :: y
  !$omp parallel reduction(max:y)
    y = 1
  !$omp end parallel
end program

[yhegde]

flang/lib/Semantics/check-omp-structure.cpp

786

That failure was due to missing Name symbol in ProcedureDesignator. I have tried to fix it. Now please let me know the following is the positive case? or do I need to catch it?
program test

integer :: y
!$omp parallel  reduction(foo:y)
  y = foo(1,0)
!$omp end parallel

end program

[kiranchandramohan]

flang/lib/Semantics/check-omp-structure.cpp

786

That failure was due to missing Name symbol in ProcedureDesignator. I have tried to fix it. Now please let me know the following is the positive case? or do I need to catch it?
program test

integer :: y
!$omp parallel  reduction(foo:y)
  y = foo(1,0)
!$omp end parallel

end program

Catch it as in provide an error if there is no declare reduction for foo? If so that can be left for the semantics check of declare reduction. Please add an entry in the excel sheet for this.

[yhegde]

This patch resolves the name symbol for the procedure, called in Reduction clause.
A new test case is added -
omp-reduction10.f90.

Semantic check of declare reduction will be addressed in the next patch.

[clementval]

flang/lib/Semantics/check-directive-structure.h

304

Add a blank line here.

315

Can you add a blank line here? The rest of the file has blank lines between functions.

317

Maybe I miss the point here but the function itself does not check for any private attribute on the symbol or smith like that. It just check whether the symbol is in the list of reductionSymbol which can be populated differently.

flang/lib/Semantics/check-omp-structure.cpp

743

Should be removed?

748

Comment should be removed?

flang/lib/Semantics/resolve-directives.cpp

380

Indent is wrong. See clang-format message below.

flang/test/Semantics/omp-reduction08.f90

7

Should you use test_symbols.sh if you want to check this kind of information?

[yhegde]

flang/lib/Semantics/check-directive-structure.h

317

A list item that appears on reduction clause cannot appear in the private clause. This function is initiated from private clause, checks whether the same symbol appeared on the reduction clauses from the same context.

[yhegde]

This patch is updated with corrections to positive test cases and indentations.

[kiranchandramohan]

The following are not implemented. They also don't seem to be in the list of items to do. Do you know why they were not added?
-> The type and the rank of a list item that appears in a reduction clause must be valid for the combiner and initializer.
-> Additionally, the list item or the pointer component of the list item must not be deallocated, allocated, or pointer assigned within the region.
-> Additionally, the list item or the allocatable component of the list item must be neither deallocated nor allocated within the region.

flang/lib/Semantics/check-directive-structure.h

142

Should this be a list? Can it be a vector or llvm::SmallVector?
https://llvm.org/docs/ProgrammersManual.html#list

flang/lib/Semantics/check-omp-structure.cpp

802–804

I believe similar functionality was implemented before. eg CheckIntentInPointer. Can it be reused? If not and if they are simple then consider inlining it here.

862

CheckDependArraySection has a similar check. Can you either reuse or refactor such that common code is not duplicated?

868

This will not catch cases like the following.

program mn
  integer :: c(10,10,10)
  integer :: i
  integer :: k = 10

  !$omp parallel do reduction(+:c(1:10,5,1:6))
  do i = 1, 10
    k = k + 1
  end do
  !$omp end parallel do
  print *, is_contiguous(c(1:10,5,1:6))
end program

871

continuous -> contiguous?

936

This does not seem to work for the following case. I think you should start from the reduction list and the check whether those variables are private.

program omp_reduction

  integer :: i
  integer :: k = 10
  !$omp parallel private(k)
  !$omp do reduction(+:k)
  do i = 1, 10
    k = k + 1
  end do
  !$omp end do
  !$omp end parallel
end program

[yhegde]

In D90697#2465189, @kiranchandramohan wrote:

The following are not implemented. They also don't seem to be in the list of items to do. Do you know why they were not added?

I think we were not very sure that we can catch them at compile time. But I suppose type and rank of a list item can be checked at compile time.

-> The type and the rank of a list item that appears in a reduction clause must be valid for the combiner and initializer.
-> Additionally, the list item or the pointer component of the list item must not be deallocated, allocated, or pointer assigned within the region.
-> Additionally, the list item or the allocatable component of the list item must be neither deallocated nor allocated within the region

[yhegde]

flang/lib/Semantics/check-omp-structure.cpp

862

Sure. Will check what all can be reused.

868

Thank you. This will be addressed.

936

Thank you once again. This case will be addressed.

[yhegde]

Addressed review issues. Code with similar checks are reused. There are minor changes in depend clause related checks because same function is called from reduction clause related checks.

[yhegde]

With updated Reduction Clause (OmpObjectList).

[yhegde]

With updated Reduction Clause.

[kiranchandramohan]

A few comments.

flang/lib/Semantics/check-directive-structure.h

220

In a multimap there can be more than one clause which maps to the same key (i.e more than one clause of the same type). Should there be an assert for only single existence?

305

Is this function OpenMP specific and hence be in the OpenMPChecker?

flang/lib/Semantics/check-omp-structure.cpp

796

Nit: Remove enclosingSymbols if not used.

799

I guess this function can also work with ompObjectList like others. If you iterate over the names then you dont need the map from symbol to name source.

1516

I guess this function should only be called if the reduction appears in a worksharing construct. Currently there seems to be no checks for that.

1520

There seems to be an assumption here that the immediate enclosing context is the parallel region. Is that always the case?

1528

Is there an assumption here that for non-sharable clauses a new symbol is created? Is that always the case? If so, can you add a comment here?

1530

Consider making this error more readable.

You can state the restriction in the standard, then add a comma and say that reduction variable x is <private/first/lastprivate> here.

flang/lib/Semantics/check-omp-structure.h

169

Remove this function if not used anymore.

[yhegde]

flang/lib/Semantics/check-directive-structure.h

220

removed multimap which was used only to reuse some part of the code.

flang/lib/Semantics/check-omp-structure.cpp

1516

Few more test cases added with worksharing constructs in omp-reduction07.f90. Hope they are ok.

1520

No such assumptions made. Included few test cases in omp-reduction07.f90 having enclosing context other than parallel construct. Hope they are ok.

1528

I have cleaned up this part of the code. Hope this address the review comment.

1530

Rt now separate error messages are thrown for each of these enclosing clauses . For ex: "REDUCTION variable 'k' is FIRSTPRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind." or
"REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind." Please let me know if they are not ok.

[yhegde]

This patch has the following changes.

1. The functions CheckIntentInPointer and CheckDefinableObjects are combined and renamed as 'CheckIntentInPointerAndDefinable'.
2. Removed CheckDependArraySection function.
3. cleaned up unwanted code around multimap which was required earlier to reuse some part of the code.
4. Added few test cases in omp-reduction02.f90 and omp-reduction07.f90 to address the review comments.
5. Removed some unnecessary code in CheckIsVarPartOfAnotherVar

[kiranchandramohan]

A few questions and change requests.

flang/lib/Semantics/check-omp-structure.cpp

756

Is name->source and direct comparison with smallcase sufficient?

821

Can this be const?

823

Please add a TODO here.
TODO: Verify the assumption here that the immediately inclosing region is the parallel region to which the worksharing construct having reduction binds to.

Also add a check that the enclosingContext is a parallel construct.

849

Ideally a new symbol should be created for private clauses and reductions (see below). If new symbols are created then how will there be a match in this find? Can you explain?

static constexpr Symbol::Flags ompFlagsRequireNewSymbol{
    Symbol::Flag::OmpPrivate, Symbol::Flag::OmpLinear,
    Symbol::Flag::OmpFirstPrivate, Symbol::Flag::OmpLastPrivate,
    Symbol::Flag::OmpReduction};

1516

What I meant here is that if the reduction clause does not appear in a worksharing construct (example below) then the following error does not apply.

!ERROR: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.

program omp_reduction
  
  integer :: i,j,l
  integer :: k = 10

  !$omp parallel private(k)
  !$omp simd reduction(+:k)
  do i = 1, 10
    k = k + 1
  end do
  !$omp end simd
  !$omp end parallel

end program omp_reduction

flang/lib/Semantics/resolve-directives.cpp

376

Nit: namepair -> namePair

396

Where was the symbol created for these names?

flang/test/Semantics/omp-reduction07.f90

37

From the standard: "distribute, distribute simd, distribute parallel loop, distribute parallel loop SIMD, and parallel regions, including any parallel regions arising from combined constructs, are the only OpenMP regions that may be strictly nested inside the teams region"

Nesting of an omp do worksharing loop inside a teams region is not allowed. This particular test in this file can be removed.

[yhegde]

flang/lib/Semantics/check-omp-structure.cpp

756

I think I was converting them to upper case because I came across a few examples with 'max' , 'min' in uppercase and few in lower case.

821

Thank you for commenting on this. I rolled back from the most of common code sharing part.

823

Please add a TODO here.
TODO: Verify the assumption here that the immediately inclosing region is the parallel region to which the worksharing construct having reduction binds to.

Can this be verified with the following cases ?
program red
!$omp sections private(k)

!$omp do reduction(+:k) reduction(-:j)
do i = 1, 10
  k = k + 1
end do
!$omp end do

!$omp end sections
end program red

program red1
!$omp parallel sections private(k)

!$omp do reduction(+:k) reduction(-:j)
do i = 1, 10
  k = k + 1
end do
!$omp end do

!$omp end parallel sections
end program red1

Also add a check that the enclosingContext is a parallel construct.

can the following a valid testcase and hence can be added ?
program red
!$omp target private(k)

!$omp sections  reduction(+:k) reduction(-:j)
do i = 1, 10
  k = k + 1
end do
!$omp end sections

!$omp end target
end program red

849

Thats right. It was overlooked while trying to share the common code. Thank you.

1516

Thank you for explaining. I removed that case from omp-reduction07.f90. I suppose the following can be added?

1. program red

!$omp sections private(k)

!$omp sections  reduction(+:k) reduction(-:j)
do i = 1, 10
  k = k + 1
end do
!$omp end sections

!$omp end sections
end program red

2. program red

!$omp parallel sections private(k)

!$omp sections  reduction(+:k) reduction(-:j)
do i = 1, 10
  k = k + 1
end do
!$omp end sections

!$omp end parallel sections
end program red

flang/lib/Semantics/resolve-directives.cpp

396

Not sure I understood this question. I think here symbols are created with IntrinsicOperators.

flang/test/Semantics/omp-reduction07.f90

37

removed.

[yhegde]

Thanks for the review comments. @kiranchandramohan . The patch is updated after addressing the review comments.

[kiranchandramohan]

A few nits, comments and clarifications.

flang/lib/Semantics/check-omp-structure.cpp

756

Just confirm, add a test with max and MAX.

823

The ones which you specify for verifying the assumption (program red and program red1) should be caught by the nesting check (i.e. a worksharing region cannot occur in another worksharing region i.e do in sections).

program red
!$omp sections private(k)
!$omp do reduction(+:k) reduction(-:j)

program red1
!$omp parallel sections private(k)
!$omp do reduction(+:k) reduction(-:j)

The one which you specify for the enclosing context is probably a valid case and the reduction error should not apply.

program red
!$omp target private(k)
!$omp sections  reduction(+:k) reduction(-:j)

870

Nit: remove empty line.

876

Nit: remove empty line.

1296

Nit: contiguos -> contiguous

1516

Sections cannot be nested inside another sections since it is a worksharing construct.

flang/lib/Semantics/resolve-directives.cpp

396

I saw symbols created for the reduction operation above but not for the variable.

[yhegde]

flang/lib/Semantics/check-omp-structure.cpp

756

The following example is from https://www.openmp.org//wp-content/uploads/openmp-examples-4.5.0.pdf

SUBROUTINE REDUCTION1(A, B, C, D, X, Y, N)
REAL :: X(*), A, D
INTEGER :: Y(*), N, B, C
INTEGER :: I
A = 0
B = 0
C = Y(1)
D = X(1)
!$OMP PARALLEL DO PRIVATE(I) SHARED(X, Y, N) REDUCTION(+:A) &
!$OMP& REDUCTION(IEOR:B) REDUCTION(MIN:C) REDUCTION(MAX:D)
DO I=1,N
A = A + X(I)
B = IEOR(B, Y(I))
C = MIN(C, Y(I))
IF (D < X(I)) D = X(I)
END DO
END SUBROUTINE REDUCTION1

But probably can be ignored ?! and only lower cases sufficient ?

823

The ones which you specify for verifying the assumption (program red and program red1) should be caught by the nesting check (i.e. a worksharing region cannot occur in another worksharing region i.e do in sections).

program red
!$omp sections private(k)
!$omp do reduction(+:k) reduction(-:j)

yes this test case catching both the errors .

./red.f90:3:7: error: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region

!$omp do reduction(+:k) reduction(-:j)
      ^^

./red.f90:3:10: error: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.

!$omp do reduction(+:k) reduction(-:j)
         ^^^^^^^^^^^^^^

flang/lib/Semantics/resolve-directives.cpp

396

The symbols were not created for ProcedureDesignator. So they were created here. And I think all other symbols associated with reduction are created along with IntrinsicOperators .

[yhegde]

Patch updated and rebased after addressing the reviewer's comments.

[kiranchandramohan]

Can you mark all comments which you believe are handled as done?

flang/lib/Semantics/check-omp-structure.cpp

756

Feel free to add tests. If it is from the standards document then add a comment mentioning the source.

I am thinking that everything is converted to lowercase, but I could be wrong, hence asking to check with both small and caps letters for max.

823

OK.

flang/lib/Semantics/resolve-directives.cpp

396

OK. Is there a test_symbols.sh test which checks for the symbol for non-Intrinsic reduction?

[yhegde]

flang/lib/Semantics/check-omp-structure.cpp

756

test_symbols.sh throws error for the test cases with MAX,MIN etc in upper case.

1516

ok.

flang/lib/Semantics/resolve-directives.cpp

396

I suppose , you mean the following test cases ?

!$omp do reduction(-:k) reduction(*:j) reduction(-:l)

!DEF: /omp_reduction/Block7/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
do i=1,10
  !REF: /omp_reduction/k
  k = k+1
end do
!$omp end do


!$omp do reduction(.and.:k) reduction(.or.:j) reduction(.eqv.:l)
!DEF: /omp_reduction/Block8/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
do i=1,10
  !REF: /omp_reduction/k
  k = k+1
end do
!$omp end do

I can add them.

[yhegde]

flang/lib/Semantics/resolve-directives.cpp

396

Or if the cases similar to the following case are, those under consideration ,

program red
!$omp sections reduction(&:k) reduction(#:j)
do i = 1, 10

k = k + 1

end do
!$omp end sections
end program red

then the test_symbols.sh is catching them.

[kiranchandramohan]

There are a few comments not marked as done. Are these not done or have been just not marked done?

flang/lib/Semantics/resolve-directives.cpp

396

For the example with loop induction variable "i" and reduction variable "k", the example you show above only contains the OmpPrivate attribute for the loop induction variable "i", it does not show anything for the reduction variable "k". Shouldn't it show OmpReduction for the reduction variables? And shouldn't it be checked?

[yhegde]

In D90697#2592760, @kiranchandramohan wrote:

There are a few comments not marked as done. Are these not done or have been just not marked done?

I believe I have addressed all the issues raised. Hence marking them as done except question type remarks.

flang/lib/Semantics/resolve-directives.cpp

396

Thank you @kiranchandramohan for the review comments. Sorry for the delayed response. Thanks for pointing out the above issue. Calling ResolveOmpObjectList() will resolve this issue. However the recent commits giving some error . Working on that. Will update the patch soon.

[yhegde]

This patch is updated after addressing the review comments.

However there is an error in the build.
The following sections from the omp-firstprivate01.f90 is the source.

!$omp parallel reduction(+:a)
!$omp sections firstprivate(a, b)
!$omp section 
 c = c * a + b
!$omp end sections
!$omp end parallel


!$omp parallel reduction(-:a)
!$omp task firstprivate(a,b)
 c =  c - a * b
!$omp end task
!$omp end parallel

With the above test case
The "enclosingContext{GetEnclosingDirContext()" is returning reduction clause causing the error as -
"REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the "worksharing" construct bind."

This is because as it appears to me, that the each directive context is pushed including end sections
( void OmpStructureChecker::Enter(const parser::OmpEndSectionsDirective &x) {

case llvm::omp::Directive::OMPD_sections:
PushContextAndClauseSets(
    dir.source, llvm::omp::Directive::OMPD_end_sections);
break;

)
but there is no corresponding pop for the end sections . This is probably because by the std. it is "There is an implicit barrier at the end of a sections construct unless a nowait clause is specified "
( https://www.openmp.org/wp-content/uploads/openmp-4.5.pdf :page 66 )

And it looks to me that "no wait" is not yet implemented and that could be the cause of error for all the worksharing constructs, because the implementation of nowait may have a corresponding pop (dirContext_.pop_back();).

I request the reviewer's suggestions to handle this case.

[kiranchandramohan]

If popping the end_sections helps you move forward, I am fine with it. Please go ahead.

Does this mean that currently the stack of clause sets is not empty when semantic checks finishes? And with your fix the set will be empty? If so, can you add such an assert (size of clase stack is 0) in the appropriate place?

[yhegde]

Thanks for the suggestion. This patch is rebased and updated with the popping of end_section and other end worksharing clauses fix.

[kiranchandramohan]

LGTM. Thanks for the patience.

@clementval Do you have further concerns about this patch?

flang/lib/Semantics/check-directive-structure.h

209

Nit: Praveen added a "GetEnclosingContextWithDir" with D91920.

flang/lib/Semantics/check-omp-structure.cpp

525

Nit: Please add a comment on why this pop is required and why it is only for these two directives. If more are to be added later on then please add a todo.

flang/test/Semantics/omp-reduction07.f90

5

Nit: convert one of the tests in this file to work with max/min/....

[yhegde]

In D90697#2610306, @kiranchandramohan wrote:

LGTM. Thanks for the patience.

Thank you for the review comments. Sure will update the diff with the suggestions.

[yhegde]

flang/lib/Semantics/check-directive-structure.h

209

They are two different functions. GetEnclosingDirContext() checks the immediate enclosing directive context.

flang/lib/Semantics/check-omp-structure.cpp

525

There are many begin and end directive mismatch checks in omp-clause-validity01.f90. Hence popping the right directive context was required.

flang/test/Semantics/omp-reduction07.f90

5

omp-reduction07.f90 updated with max/min etc

[yhegde]

This patch is updated with a few more test cases with max/min etc in omp-reduction07.f90 and also TODO comments. Hope they are acceptable.

Thanks to @clementval and @kiranchandramohan for accepting this PR and for the review comments. Thanks to @praveen for the kind co operation.

[kiranchandramohan]

In D90697#2617519, @yhegde wrote:

This patch is updated with a few more test cases with max/min etc in omp-reduction07.f90 and also TODO comments. Hope they are acceptable.

Thanks to @clementval and @kiranchandramohan for accepting this PR and for the review comments. Thanks to @praveen for the kind co operation.

Please go ahead and submit.
Thanks for your help and patience @yhegde, @praveen. Goes without saying, You are both welcome to make contributions to Flang and OpenMP in particular.
Best wishes for your future endeavours.

[yhegde]

In D90697#2620677, @kiranchandramohan wrote:

In D90697#2617519, @yhegde wrote:

This patch is updated with a few more test cases with max/min etc in omp-reduction07.f90 and also TODO comments. Hope they are acceptable.

Thanks to @clementval and @kiranchandramohan for accepting this PR and for the review comments. Thanks to @praveen for the kind co operation.

Please go ahead and submit.
Thanks for your help and patience @yhegde, @praveen. Goes without saying, You are both welcome to make contributions to Flang and OpenMP in particular.
Best wishes for your future endeavours.

Sure. We look ahead for that. Thank you.

flang/lib/Semantics/check-directive-structure.h

struct DirectiveContext {
     common::EnumSet<C, ClauseEnumSize> allowedClauses{};
     common::EnumSet<C, ClauseEnumSize> allowedOnceClauses{};
     common::EnumSet<C, ClauseEnumSize> allowedExclusiveClauses{};
     common::EnumSet<C, ClauseEnumSize> requiredClauses{};
 
     const PC *clause{nullptr};
     ClauseMapTy clauseInfo;
     std::list<C> actualClauses;
     Symbol *loopIV{nullptr};
   };
 
   void SetLoopIv(Symbol *symbol) { GetContext().loopIV = symbol; }
 
   // back() is the top of the stack
   DirectiveContext &GetContext() {
     CHECK(!dirContext_.empty());
     return dirContext_.back();
protected:
   const PC *FindClause(C type) {
     auto it{GetContext().clauseInfo.find(type)};
     if (it != GetContext().clauseInfo.end()) {
       return it->second;
     }
     return nullptr;
   }
 
   std::pair<typename ClauseMapTy::iterator, typename ClauseMapTy::iterator>
   FindClauses(C type) {
     auto it{GetContext().clauseInfo.equal_range(type)};
     return it;
   }
 
+  DirectiveContext *GetEnclosingDirContext() {
+    CHECK(!dirContext_.empty());
+    auto it{dirContext_.rbegin()};
+    if (++it != dirContext_.rend()) {
+      return &(*it);
+    }
+    return nullptr;
+  }
+
   void PushContext(const parser::CharBlock &source, D dir) {
     dirContext_.emplace_back(source, dir);
   }
 
   DirectiveContext *GetEnclosingContextWithDir(D dir) {
     CHECK(!dirContext_.empty());
     auto it{dirContext_.rbegin()};
     while (++it != dirContext_.rend()) {
protected:
   SemanticsContext &context_;
   std::vector<DirectiveContext> dirContext_; // used as a stack
   std::unordered_map<D, DirectiveClauses<C, ClauseEnumSize>>
       directiveClausesMap_;
 
   std::string ClauseSetToString(const common::EnumSet<C, ClauseEnumSize> set);
 };
 
 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckNoBranching(
     const parser::Block &block, D directive,
     const parser::CharBlock &directiveSource) {
   NoBranchingEnforce<D> noBranchingEnforce{
       context_, directiveSource, directive, ContextDirectiveAsFortran()};
   parser::Walk(block, noBranchingEnforce);
 }
 
 // Check that only clauses included in the given set are present after the given
 // clause.
 template <typename D, typename C, typename PC, std::size_t ClauseEnumSize>
 void DirectiveStructureChecker<D, C, PC, ClauseEnumSize>::CheckOnlyAllowedAfter(
     C clause, common::EnumSet<C, ClauseEnumSize> set) {
   bool enforceCheck = false;
   for (auto cl : GetContext().actualClauses) {
     if (cl == clause) {
       enforceCheck = true;
       continue;
     } else if (enforceCheck && !set.test(cl)) {
       auto parserClause = GetContext().clauseInfo.find(cl);
       context_.Say(parserClause->second->source,
           "Clause %s is not allowed after clause %s on the %s "
           "directive"_err_en_US,
           parser::ToUpperCaseLetters(getClauseName(cl).str()),
           parser::ToUpperCaseLetters(getClauseName(clause).str()),
           ContextDirectiveAsFortran());

flang/lib/Semantics/check-omp-structure.h

#include "llvm/Frontend/OpenMP/OMP.inc"
   void Enter(const parser::OpenMPConstruct &);
   void Enter(const parser::OpenMPLoopConstruct &);
   void Leave(const parser::OpenMPLoopConstruct &);
   void Enter(const parser::OmpEndLoopDirective &);
 
   void Enter(const parser::OpenMPBlockConstruct &);
   void Leave(const parser::OpenMPBlockConstruct &);
   void Enter(const parser::OmpEndBlockDirective &);
+  void Leave(const parser::OmpEndBlockDirective &);
 
   void Enter(const parser::OpenMPSectionsConstruct &);
   void Leave(const parser::OpenMPSectionsConstruct &);
   void Enter(const parser::OmpEndSectionsDirective &);
+  void Leave(const parser::OmpEndSectionsDirective &);
 
   void Enter(const parser::OpenMPDeclareSimdConstruct &);
   void Leave(const parser::OpenMPDeclareSimdConstruct &);
   void Enter(const parser::OpenMPDeclarativeAllocate &);
   void Leave(const parser::OpenMPDeclarativeAllocate &);
   void Enter(const parser::OpenMPDeclareTargetConstruct &);
   void Leave(const parser::OpenMPDeclareTargetConstruct &);
   void Enter(const parser::OpenMPExecutableAllocate &);
private:
   bool ScheduleModifierHasType(const parser::OmpScheduleClause &,
       const parser::OmpScheduleModifierType::ModType &);
   void CheckAllowedMapTypes(const parser::OmpMapType::Type &,
       const std::list<parser::OmpMapType::Type> &);
   llvm::StringRef getClauseName(llvm::omp::Clause clause) override;
   llvm::StringRef getDirectiveName(llvm::omp::Directive directive) override;
 
   void CheckDependList(const parser::DataRef &);
   void CheckDependArraySection(
       const common::Indirection<parser::ArrayElement> &, const parser::Name &);
   void CheckIsVarPartOfAnotherVar(const parser::OmpObjectList &objList);
   void CheckIntentInPointer(
       const parser::OmpObjectList &, const llvm::omp::Clause);
   void GetSymbolsInObjectList(const parser::OmpObjectList &, SymbolSourceMap &);
   void CheckDefinableObjects(SymbolSourceMap &, const llvm::omp::Clause);
   void CheckPrivateSymbolsInOuterCxt(
       SymbolSourceMap &, DirectivesClauseTriple &, const llvm::omp::Clause);
   const parser::Name GetLoopIndex(const parser::DoConstruct *x);
   void SetLoopInfo(const parser::OpenMPLoopConstruct &x);
   void CheckIsLoopIvPartOfClause(
       llvmOmpClause clause, const parser::OmpObjectList &ompObjectList);
   void CheckWorkshareBlockStmts(const parser::Block &, parser::CharBlock);
 
   void CheckLoopItrVariableIsInt(const parser::OpenMPLoopConstruct &x);
   void CheckDoWhile(const parser::OpenMPLoopConstruct &x);
   void CheckCycleConstraints(const parser::OpenMPLoopConstruct &x);
   std::int64_t GetOrdCollapseLevel(const parser::OpenMPLoopConstruct &x);
   void CheckIfDoOrderedClause(const parser::OmpBlockDirective &blkDirectiv);
+  bool CheckReductionOperators(const parser::OmpClause::Reduction &);
+  bool CheckIntrinsicOperator(
+      const parser::DefinedOperator::IntrinsicOperator &);
+  void CheckReductionTypeList(const parser::OmpClause::Reduction &);
+  void CheckReductionArraySection(const parser::OmpObjectList &ompObjectList);
+  void CheckIntentInPointerAndDefinable(
+      const parser::OmpObjectList &, const llvm::omp::Clause);
+  void CheckArraySection(const parser::ArrayElement &arrayElement,
+      const parser::Name &name, const llvm::omp::Clause clause);
+  void CheckMultipleAppearanceAcrossContext(
+      const parser::OmpObjectList &ompObjectList);
 };
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_CHECK_OMP_STRUCTURE_H_

flang/lib/Semantics/check-omp-structure.cpp

PushContextAndClauseSets(
         dir.source, llvm::omp::Directive::OMPD_end_sections);
     break;
   default:
     // no clauses are allowed
     break;
   }
 }
 
+// TODO: Verify the popping of dirContext requirement after nowait
+// implementation, as there is an implicit barrier at the end of the worksharing
+// constructs unless a nowait clause is specified. Only OMPD_end_sections is
+// popped becuase it is pushed while entering the EndSectionsDirective.
+void OmpStructureChecker::Leave(const parser::OmpEndSectionsDirective &x) {
+  if (GetContext().directive == llvm::omp::Directive::OMPD_end_sections) {
+    dirContext_.pop_back();
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPDeclareSimdConstruct &x) {
   const auto &dir{std::get<parser::Verbatim>(x.t)};
   PushContextAndClauseSets(dir.source, llvm::omp::Directive::OMPD_declare_simd);
 }
 
 void OmpStructureChecker::Leave(const parser::OpenMPDeclareSimdConstruct &) {
   dirContext_.pop_back();
 }
PushContextAndClauseSets(
         dir.source, llvm::omp::Directive::OMPD_end_workshare);
     break;
   default:
     // no clauses are allowed
     break;
   }
 }
 
+// TODO: Verify the popping of dirContext requirement after nowait
+// implementation, as there is an implicit barrier at the end of the worksharing
+// constructs unless a nowait clause is specified. Only OMPD_end_single and
+// end_workshareare popped as they are pushed while entering the
+// EndBlockDirective.
+void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
+  if ((GetContext().directive == llvm::omp::Directive::OMPD_end_single) ||
+      (GetContext().directive == llvm::omp::Directive::OMPD_end_workshare)) {
+    dirContext_.pop_back();
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OpenMPAtomicConstruct &x) {
   std::visit(
       common::visitors{
           [&](const auto &someAtomicConstruct) {
             const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t)};
             PushContextAndClauseSets(
                 dir.source, llvm::omp::Directive::OMPD_atomic);
           },

 CHECK_SIMPLE_CLAUSE(Inbranch, OMPC_inbranch)
 CHECK_SIMPLE_CLAUSE(IsDevicePtr, OMPC_is_device_ptr)
 CHECK_SIMPLE_CLAUSE(Link, OMPC_link)
 CHECK_SIMPLE_CLAUSE(Mergeable, OMPC_mergeable)
 CHECK_SIMPLE_CLAUSE(Nogroup, OMPC_nogroup)
 CHECK_SIMPLE_CLAUSE(Notinbranch, OMPC_notinbranch)
 CHECK_SIMPLE_CLAUSE(Nowait, OMPC_nowait)
 CHECK_SIMPLE_CLAUSE(ProcBind, OMPC_proc_bind)
-CHECK_SIMPLE_CLAUSE(Reduction, OMPC_reduction)
 CHECK_SIMPLE_CLAUSE(Release, OMPC_release)
 CHECK_SIMPLE_CLAUSE(Relaxed, OMPC_relaxed)
 CHECK_SIMPLE_CLAUSE(SeqCst, OMPC_seq_cst)
 CHECK_SIMPLE_CLAUSE(Simd, OMPC_simd)
 CHECK_SIMPLE_CLAUSE(Sizes, OMPC_sizes)
 CHECK_SIMPLE_CLAUSE(TaskReduction, OMPC_task_reduction)
 CHECK_SIMPLE_CLAUSE(To, OMPC_to)
 CHECK_SIMPLE_CLAUSE(UnifiedAddress, OMPC_unified_address)

 CHECK_REQ_SCALAR_INT_CLAUSE(ThreadLimit, OMPC_thread_limit)
 
 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Collapse, OMPC_collapse)
 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Safelen, OMPC_safelen)
 CHECK_REQ_CONSTANT_SCALAR_INT_CLAUSE(Simdlen, OMPC_simdlen)
 
 // Restrictions specific to each clause are implemented apart from the
 // generalized restrictions.
+void OmpStructureChecker::Enter(const parser::OmpClause::Reduction &x) {
+  CheckAllowed(llvm::omp::Clause::OMPC_reduction);
+  if (CheckReductionOperators(x)) {
+    CheckReductionTypeList(x);
+  }
+}
+bool OmpStructureChecker::CheckReductionOperators(
+    const parser::OmpClause::Reduction &x) {
+
+  const auto &definedOp{std::get<0>(x.v.t)};
+  bool ok = false;
+  std::visit(
+      common::visitors{
+          [&](const parser::DefinedOperator &dOpr) {
+            const auto &intrinsicOp{
+                std::get<parser::DefinedOperator::IntrinsicOperator>(dOpr.u)};
+            ok = CheckIntrinsicOperator(intrinsicOp);
+          },
+          [&](const parser::ProcedureDesignator &procD) {
+            const parser::Name *name{std::get_if<parser::Name>(&procD.u)};
+            if (name) {
+              if (name->source == "max" || name->source == "min" ||
+                  name->source == "iand" || name->source == "ior" ||
+                  name->source == "ieor") {
+                ok = true;
+              } else {
+                context_.Say(GetContext().clauseSource,
+                    "Invalid reduction identifier in REDUCTION clause."_err_en_US,
+                    ContextDirectiveAsFortran());
+              }
+            }
+          },
+      },
+      definedOp.u);
+
+  return ok;
+}
+bool OmpStructureChecker::CheckIntrinsicOperator(
+    const parser::DefinedOperator::IntrinsicOperator &op) {
+
+  switch (op) {
+  case parser::DefinedOperator::IntrinsicOperator::Add:
+  case parser::DefinedOperator::IntrinsicOperator::Subtract:
+  case parser::DefinedOperator::IntrinsicOperator::Multiply:
+  case parser::DefinedOperator::IntrinsicOperator::AND:
+  case parser::DefinedOperator::IntrinsicOperator::OR:
+  case parser::DefinedOperator::IntrinsicOperator::EQV:
+  case parser::DefinedOperator::IntrinsicOperator::NEQV:
+    return true;
+  default:
+    context_.Say(GetContext().clauseSource,
+        "Invalid reduction operator in REDUCTION clause."_err_en_US,
+        ContextDirectiveAsFortran());
+  }
+  return false;
+}
+
+void OmpStructureChecker::CheckReductionTypeList(
+    const parser::OmpClause::Reduction &x) {
+  const auto &ompObjectList{std::get<parser::OmpObjectList>(x.v.t)};
+  CheckIntentInPointerAndDefinable(
+      ompObjectList, llvm::omp::Clause::OMPC_reduction);
+  CheckReductionArraySection(ompObjectList);
+  CheckMultipleAppearanceAcrossContext(ompObjectList);
+}
+
+void OmpStructureChecker::CheckIntentInPointerAndDefinable(
+    const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
+  for (const auto &ompObject : objectList.v) {
+    if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+      if (const auto *symbol{name->symbol}) {
+        if (IsPointer(symbol->GetUltimate()) &&
+            IsIntentIn(symbol->GetUltimate())) {
+          context_.Say(GetContext().clauseSource,
+              "Pointer '%s' with the INTENT(IN) attribute may not appear "
+              "in a %s clause"_err_en_US,
+              symbol->name(),
+              parser::ToUpperCaseLetters(getClauseName(clause).str()));
+        }
+        if (auto msg{
+                WhyNotModifiable(*symbol, context_.FindScope(name->source))}) {
+          context_.Say(GetContext().clauseSource,
+              "Variable '%s' on the %s clause is not definable"_err_en_US,
+              symbol->name(),
+              parser::ToUpperCaseLetters(getClauseName(clause).str()));
+        }
+      }
+    }
+  }
+}
+
+void OmpStructureChecker::CheckReductionArraySection(
+    const parser::OmpObjectList &ompObjectList) {
+  for (const auto &ompObject : ompObjectList.v) {
+    if (const auto *dataRef{parser::Unwrap<parser::DataRef>(ompObject)}) {
+      if (const auto *arrayElement{
+              parser::Unwrap<parser::ArrayElement>(ompObject)}) {
+        if (arrayElement) {
+          CheckArraySection(*arrayElement, GetLastName(*dataRef),
+              llvm::omp::Clause::OMPC_reduction);
+        }
+      }
+    }
+  }
+}
+
+void OmpStructureChecker::CheckMultipleAppearanceAcrossContext(
+    const parser::OmpObjectList &redObjectList) {
+  const parser::OmpObjectList *objList{nullptr};
+  //  TODO: Verify the assumption here that the immediately enclosing region is
+  //  the parallel region to which the worksharing construct having reduction
+  //  binds to.
+  if (auto *enclosingContext{GetEnclosingDirContext()}) {
+    for (auto it : enclosingContext->clauseInfo) {
+      llvmOmpClause type = it.first;
+      const auto *clause = it.second;
+      if (type == llvm::omp::Clause::OMPC_private) {
+        const auto &pClause{std::get<parser::OmpClause::Private>(clause->u)};
+        objList = &pClause.v;
+      } else if (type == llvm::omp::Clause::OMPC_firstprivate) {
+        const auto &fpClause{
+            std::get<parser::OmpClause::Firstprivate>(clause->u)};
+        objList = &fpClause.v;
+      } else if (type == llvm::omp::Clause::OMPC_lastprivate) {
+        const auto &lpClause{
+            std::get<parser::OmpClause::Lastprivate>(clause->u)};
+        objList = &lpClause.v;
+      } else if (type == llvm::omp::Clause::OMPC_reduction) {
+        const auto &rClause{std::get<parser::OmpClause::Reduction>(clause->u)};
+        const auto &olist{std::get<1>(rClause.v.t)};
+        objList = &olist;
+      }
+      if (objList) {
+        for (const auto &ompObject : objList->v) {
+          if (const auto *name{parser::Unwrap<parser::Name>(ompObject)}) {
+            if (const auto *symbol{name->symbol}) {
+              for (const auto &redOmpObject : redObjectList.v) {
+                if (const auto *rname{
+                        parser::Unwrap<parser::Name>(redOmpObject)}) {
+                  if (const auto *rsymbol{rname->symbol}) {
+                    if (rsymbol->name() == symbol->name()) {
+                      context_.Say(GetContext().clauseSource,
+                          "%s variable '%s' is %s in outer context must"
+                          " be shared in the parallel regions to which any"
+                          " of the worksharing regions arising from the "
+                          "worksharing"
+                          " construct bind."_err_en_US,
+                          parser::ToUpperCaseLetters(
+                              getClauseName(llvm::omp::Clause::OMPC_reduction)
+                                  .str()),
+                          symbol->name(),
+                          parser::ToUpperCaseLetters(
+                              getClauseName(type).str()));
+                    }
+                  }
+                }
+              }
+            }
+          }
+        }
+      }
+    }
+  }
+}
+
 void OmpStructureChecker::Enter(const parser::OmpClause::Ordered &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_ordered);
   // the parameter of ordered clause is optional
   if (const auto &expr{x.v}) {
     RequiresConstantPositiveParameter(llvm::omp::Clause::OMPC_ordered, *expr);
     // 2.8.3 Loop SIMD Construct Restriction
     if (llvm::omp::doSimdSet.test(GetContext().directive)) {
       context_.Say(GetContext().clauseSource,
void OmpStructureChecker::Enter(const parser::OmpClause::Private &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_private);
   CheckIsVarPartOfAnotherVar(x.v);
   CheckIntentInPointer(x.v, llvm::omp::Clause::OMPC_private);
 }
 
 void OmpStructureChecker::CheckIsVarPartOfAnotherVar(
     const parser::OmpObjectList &objList) {
   for (const auto &ompObject : objList.v) {
-    std::visit(
-        common::visitors{
-            [&](const parser::Designator &designator) {
-              if (std::get_if<parser::DataRef>(&designator.u)) {
-                if ((parser::Unwrap<parser::StructureComponent>(ompObject)) ||
-                    (parser::Unwrap<parser::ArrayElement>(ompObject))) {
-                  context_.Say(GetContext().clauseSource,
-                      "A variable that is part of another variable (as an "
-                      "array or structure element)"
-                      " cannot appear in a PRIVATE or SHARED clause."_err_en_US);
-                }
-              }
-            },
-            [&](const parser::Name &name) {},
-        },
-        ompObject.u);
-  }
 }
 void OmpStructureChecker::Enter(const parser::OmpClause::Firstprivate &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_firstprivate);
   CheckIsLoopIvPartOfClause(llvmOmpClause::OMPC_firstprivate, x.v);
 
   SymbolSourceMap currSymbols;
   GetSymbolsInObjectList(x.v, currSymbols);
 
   DirectivesClauseTriple dirClauseTriple;
   // Check firstprivate variables in worksharing constructs
void OmpStructureChecker::Enter(const parser::OmpClause::Depend &x) {
   if (const auto *inOut{std::get_if<parser::OmpDependClause::InOut>(&x.v.u)}) {
     const auto &designators{std::get<std::list<parser::Designator>>(inOut->t)};
     for (const auto &ele : designators) {
       if (const auto *dataRef{std::get_if<parser::DataRef>(&ele.u)}) {
         CheckDependList(*dataRef);
         if (const auto *arr{
                 std::get_if<common::Indirection<parser::ArrayElement>>(
                     &dataRef->u)}) {
-          CheckDependArraySection(*arr, GetLastName(*dataRef));
+          CheckArraySection(arr->value(), GetLastName(*dataRef),
+              llvm::omp::Clause::OMPC_depend);
         }
       }
     }
   }
 }
 
 void OmpStructureChecker::Enter(const parser::OmpClause::Copyprivate &x) {
   CheckAllowed(llvm::omp::Clause::OMPC_copyprivate);
std::visit(
             context_.Say(GetContext().clauseSource,
                 "Coarrays are not supported in DEPEND clause"_err_en_US);
           },
           [&](const parser::Name &) { return; },
       },
       d.u);
 }
 
-void OmpStructureChecker::CheckDependArraySection(
-    const common::Indirection<parser::ArrayElement> &arr,
-    const parser::Name &name) {
-  for (const auto &subscript : arr.value().subscripts) {
+// Called from both Reduction and Depend clause.
+void OmpStructureChecker::CheckArraySection(
+    const parser::ArrayElement &arrayElement, const parser::Name &name,
+    const llvm::omp::Clause clause) {
+  if (!arrayElement.subscripts.empty()) {
+    for (const auto &subscript : arrayElement.subscripts) {
       if (const auto *triplet{
               std::get_if<parser::SubscriptTriplet>(&subscript.u)}) {
-      if (std::get<2>(triplet->t)) {
-        context_.Say(GetContext().clauseSource,
-            "Stride should not be specified for array section in DEPEND "
-            "clause"_err_en_US);
-      }
+        if (std::get<0>(triplet->t) && std::get<1>(triplet->t)) {
           const auto &lower{std::get<0>(triplet->t)};
           const auto &upper{std::get<1>(triplet->t)};
           if (lower && upper) {
             const auto lval{GetIntValue(lower)};
             const auto uval{GetIntValue(upper)};
             if (lval && uval && *uval < *lval) {
               context_.Say(GetContext().clauseSource,
-              "'%s' in DEPEND clause is a zero size array section"_err_en_US,
-              name.ToString());
+                  "'%s' in %s clause"
+                  " is a zero size array section"_err_en_US,
+                  name.ToString(),
+                  parser::ToUpperCaseLetters(getClauseName(clause).str()));
+              break;
+            } else if (std::get<2>(triplet->t)) {
+              const auto &strideExpr{std::get<2>(triplet->t)};
+              if (strideExpr) {
+                if (clause == llvm::omp::Clause::OMPC_depend) {
+                  context_.Say(GetContext().clauseSource,
+                      "Stride should not be specified for array section in "
+                      "DEPEND "
+                      "clause"_err_en_US);
+                }
+                const auto stride{GetIntValue(strideExpr)};
+                if ((stride && stride != 1)) {
+                  context_.Say(GetContext().clauseSource,
+                      "A list item that appears in a REDUCTION clause"
+                      " should have a contiguous storage array section."_err_en_US,
+                      ContextDirectiveAsFortran());
                   break;
                 }
               }
             }
           }
         }
+      }
+    }
+  }
+}
 
 void OmpStructureChecker::CheckIntentInPointer(
     const parser::OmpObjectList &objectList, const llvm::omp::Clause clause) {
   SymbolSourceMap symbols;
   GetSymbolsInObjectList(objectList, symbols);
   for (auto it{symbols.begin()}; it != symbols.end(); ++it) {
     const auto *symbol{it->first};
     const auto source{it->second};
if (auto *enclosingContext{GetEnclosingContextWithDir(enclosingDir)}) {
               parser::ToUpperCaseLetters(getClauseName(currClause).str()),
               symbol->name());
         }
       }
     }
   }
 }
 
-void OmpStructureChecker::CheckWorkshareBlockStmts(const parser::Block &block,
-                                                   parser::CharBlock source) {
+void OmpStructureChecker::CheckWorkshareBlockStmts(
+    const parser::Block &block, parser::CharBlock source) {
   OmpWorkshareBlockChecker ompWorkshareBlockChecker{context_, source};
 
   for (auto it{block.begin()}; it != block.end(); ++it) {
     if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
         parser::Unwrap<parser::ForallStmt>(*it) ||
         parser::Unwrap<parser::ForallConstruct>(*it) ||
         parser::Unwrap<parser::WhereStmt>(*it) ||
         parser::Unwrap<parser::WhereConstruct>(*it)) {
if (parser::Unwrap<parser::AssignmentStmt>(*it) ||
       context_.Say(source,
           "The structured block in a WORKSHARE construct may consist of only "
           "SCALAR or ARRAY assignments, FORALL or WHERE statements, "
           "FORALL, WHERE, ATOMIC, CRITICAL or PARALLEL constructs"_err_en_US);
     }
   }
 }
 
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-directives.cpp

std::visit(common::visitors{
                            &linearWithModifier) {
                      ResolveOmpNameList(
                          linearWithModifier.names, Symbol::Flag::OmpLinear);
                    },
                },
         x.u);
     return false;
   }
+
+  bool Pre(const parser::OmpClause::Reduction &x) {
+    const parser::OmpReductionOperator &opr{
+        std::get<parser::OmpReductionOperator>(x.v.t)};
+    if (const auto *procD{parser::Unwrap<parser::ProcedureDesignator>(opr.u)}) {
+      if (const auto *name{parser::Unwrap<parser::Name>(procD->u)}) {
+        if (!name->symbol) {
+          const auto namePair{currScope().try_emplace(
+              name->source, Attrs{}, ProcEntityDetails{})};
+          auto &symbol{*namePair.first->second};
+          name->symbol = &symbol;
+          name->symbol->set(Symbol::Flag::OmpReduction);
+          AddToContextObjectWithDSA(*name->symbol, Symbol::Flag::OmpReduction);
+        }
+      }
+      if (const auto *procRef{
+              parser::Unwrap<parser::ProcComponentRef>(procD->u)}) {
+        ResolveOmp(*procRef->v.thing.component.symbol,
+            Symbol::Flag::OmpReduction, currScope());
+      }
+    }
+    const auto &objList{std::get<parser::OmpObjectList>(x.v.t)};
+    ResolveOmpObjectList(objList, Symbol::Flag::OmpReduction);
+    return false;
+  }
+
   bool Pre(const parser::OmpAlignedClause &x) {
     const auto &alignedNameList{std::get<std::list<parser::Name>>(x.t)};
     ResolveOmpNameList(alignedNameList, Symbol::Flag::OmpAligned);
     return false;
   }
   void Post(const parser::Name &);
 
   // Keep track of labels in the statements that causes jumps to target labels
   void Post(const parser::GotoStmt &gotoStmt) { CheckSourceLabel(gotoStmt.v); }
   void Post(const parser::ComputedGotoStmt &computedGotoStmt) {
     for (auto &label : std::get<std::list<parser::Label>>(computedGotoStmt.t)) {

flang/test/Semantics/omp-reduction01.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+  integer :: i
+  integer :: k = 10
+
+  !ERROR: Invalid reduction operator in REDUCTION clause.
+  !$omp parallel do reduction(**:k)
+  do i = 1, 10
+    k = k ** 1
+  end do
+  !$omp end parallel do
+end program omp_reduction

flang/test/Semantics/omp-reduction02.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+  integer :: i
+  integer :: k = 10
+  integer :: j = 10
+
+  !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+  !$omp parallel do reduction(+:k), reduction(-:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+  !$omp parallel do reduction(+:k), reduction(-:j), reduction(+:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+  !$omp parallel do reduction(+:j), reduction(-:k), reduction(+:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'k' appears in more than one data-sharing clause on the same OpenMP directive
+  !$omp parallel do reduction(+:j), reduction(-:k), private(k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+end program omp_reduction

flang/test/Semantics/omp-reduction03.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+subroutine omp_target(p)
+  integer, pointer, intent(in) :: p
+
+  integer :: i
+  integer :: k = 10
+
+  !ERROR: Pointer 'p' with the INTENT(IN) attribute may not appear in a REDUCTION clause
+  !$omp parallel do reduction(+:p)
+  do i = 1, 10
+    k= k + 1
+  end do
+  !$omp end parallel do
+
+end subroutine omp_target

flang/test/Semantics/omp-reduction04.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_Reduction
+  integer :: i
+  integer, parameter :: k = 10
+  common /c/ a, b
+
+  !ERROR: Variable 'k' on the REDUCTION clause is not definable
+  !$omp parallel do reduction(+:k)
+  do i = 1, 10
+    l = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: Variable 'c' on the REDUCTION clause is not definable
+  !$omp parallel do reduction(-:/c/)
+  do i = 1, 10
+    l = k + 1
+  end do
+  !$omp end parallel do
+end program omp_Reduction

flang/test/Semantics/omp-reduction05.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+program omp_reduction
+
+  integer :: i
+  integer :: k = 10
+  integer :: a(10),b(10,10,10)
+
+  !ERROR: 'a' in REDUCTION clause is a zero size array section
+  !$omp parallel do reduction(+:a(1:0:2))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'a' in REDUCTION clause is a zero size array section
+  !$omp parallel do reduction(+:a(1:0))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'b' in REDUCTION clause is a zero size array section
+  !$omp parallel do reduction(+:b(1:6,5,1:0))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: 'b' in REDUCTION clause is a zero size array section
+  !$omp parallel do reduction(+:b(1:6,1:0:5,1:10))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+end program omp_reduction

flang/test/Semantics/omp-reduction06.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+
+program omp_reduction
+
+  integer :: i
+  integer :: k = 10
+  integer :: a(10), b(10,10,10)
+
+  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !$omp parallel do reduction(+:a(1:10:3))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !$omp parallel do reduction(+:b(1:10:3,1:8:1,1:5:1))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+
+  !ERROR: A list item that appears in a REDUCTION clause should have a contiguous storage array section.
+  !$omp parallel do reduction(+:b(1:10:1,1:8:2,1:5:1))
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end parallel do
+end program omp_reduction

flang/test/Semantics/omp-reduction07.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+  integer :: i,j,l
+  integer :: k = 10
+  !$omp parallel private(k)
+  !ERROR: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !$omp do reduction(+:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end do
+  !$omp end parallel
+
+
+  !$omp parallel private(j),reduction(-:k)
+  !ERROR: REDUCTION variable 'k' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !$omp do reduction(+:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end do
+  !$omp end parallel
+
+  !$omp parallel private(j),firstprivate(k)
+  !ERROR: REDUCTION variable 'k' is FIRSTPRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !$omp do reduction(min:k)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end do
+  !$omp end parallel
+
+
+  !$omp parallel private(l,j),firstprivate(k)
+  !ERROR: REDUCTION variable 'k' is FIRSTPRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !ERROR: REDUCTION variable 'j' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !$omp sections reduction(ior:k) reduction(-:j)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end sections
+  !$omp end parallel
+
+!$omp sections private(k)
+  !ERROR: A worksharing region may not be closely nested inside a worksharing, explicit task, taskloop, critical, ordered, atomic, or master region
+  !ERROR: REDUCTION variable 'k' is PRIVATE in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+  !$omp do reduction(+:k) reduction(max:j)
+  do i = 1, 10
+    k = k + 1
+  end do
+  !$omp end do
+!$omp end sections
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp sections reduction(-:a)
+a = 10
+!$omp end sections
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the WORKSHARE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp workshare reduction(-:a)
+a = 10
+!$omp end workshare
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the SINGLE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp single reduction(-:a)
+a = 10
+!$omp end single
+!$omp end parallel
+
+!$omp parallel reduction(-:a)
+!$omp end parallel
+
+
+!$omp parallel reduction(+:a)
+!ERROR: REDUCTION clause is not allowed on the SINGLE directive
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp single reduction(iand:a)
+a = 10
+!$omp end single
+!$omp end parallel
+
+!$omp parallel reduction(iand:a)
+!$omp end parallel
+
+!$omp parallel reduction(ieor:a)
+!ERROR: REDUCTION variable 'a' is REDUCTION in outer context must be shared in the parallel regions to which any of the worksharing regions arising from the worksharing construct bind.
+!$omp sections reduction(-:a)
+a = 10
+!$omp end sections
+!$omp end parallel
+
+!$omp parallel reduction(ieor:a)
+!$omp end parallel
+
+end program omp_reduction

flang/test/Semantics/omp-reduction08.f90

+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause Positive cases
+
+!DEF: /omp_reduction MainProgram
+program omp_reduction
+  !DEF: /omp_reduction/i ObjectEntity INTEGER(4)
+  integer i
+  !DEF: /omp_reduction/k ObjectEntity INTEGER(4)
+  integer :: k = 10
+  !DEF: /omp_reduction/m ObjectEntity INTEGER(4)
+  integer :: m = 12
+  !$omp parallel do  reduction(max:k)
+  !DEF: /omp_reduction/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+    !DEF: /omp_reduction/max ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+    !REF: /omp_reduction/m
+    k = max(k, m)
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(min:k)
+  !DEF: /omp_reduction/Block2/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block2/k (OmpReduction) HostAssoc INTEGER(4)
+    !DEF: /omp_reduction/min ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+    !REF: /omp_reduction/m
+    k = min(k, m)
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(iand:k)
+  !DEF: /omp_reduction/Block3/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block3/k (OmpReduction) HostAssoc INTEGER(4)
+    !DEF: /omp_reduction/iand ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+    !REF: /omp_reduction/m
+    k = iand(k, m)
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(ior:k)
+  !DEF: /omp_reduction/Block4/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block4/k (OmpReduction) HostAssoc INTEGER(4)
+    !DEF: /omp_reduction/ior ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+    !REF: /omp_reduction/m
+    k = ior(k, m)
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(ieor:k)
+  !DEF: /omp_reduction/Block5/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block5/k (OmpReduction) HostAssoc INTEGER(4)
+    !DEF: /omp_reduction/ieor ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
+    !REF: /omp_reduction/m
+    k = ieor(k,m)
+  end do
+  !$omp end parallel do
+
+end program omp_reduction

flang/test/Semantics/omp-reduction09.f90

+! RUN: %S/test_symbols.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause Positive cases.
+!DEF: /omp_reduction MainProgram
+program omp_reduction
+  !DEF: /omp_reduction/i ObjectEntity INTEGER(4)
+  integer i
+  !DEF: /omp_reduction/k ObjectEntity INTEGER(4)
+  integer :: k = 10
+  !DEF: /omp_reduction/a ObjectEntity INTEGER(4)
+  integer a(10)
+  !DEF: /omp_reduction/b ObjectEntity INTEGER(4)
+  integer b(10,10,10)
+
+  !$omp parallel  shared(k)
+  !$omp do  reduction(+:k)
+  !DEF: /omp_reduction/Block1/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block1/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+    k = k+1
+  end do
+  !$omp end do
+  !$omp end parallel
+
+
+  !$omp parallel do  reduction(+:a(10))
+  !DEF: /omp_reduction/Block2/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !REF: /omp_reduction/k
+    k = k+1
+  end do
+  !$omp end parallel do
+
+
+  !$omp parallel do  reduction(+:a(1:10:1))
+  !DEF: /omp_reduction/Block3/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !REF: /omp_reduction/k
+    k = k+1
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(+:b(1:10:1,1:5,2))
+  !DEF: /omp_reduction/Block4/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !REF: /omp_reduction/k
+    k = k+1
+  end do
+  !$omp end parallel do
+
+  !$omp parallel do  reduction(+:b(1:10:1,1:5,2:5:1))
+  !DEF: /omp_reduction/Block5/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !REF: /omp_reduction/k
+    k = k+1
+  end do
+  !$omp end parallel do
+
+  !$omp parallel  private(i)
+  !$omp do reduction(+:k) reduction(+:j)
+  !DEF: /omp_reduction/Block6/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block6/Block1/k (OmpReduction) HostAssoc INTEGER(4)
+    k = k+1
+  end do
+  !$omp end do
+  !$omp end parallel
+
+  !$omp do reduction(-:k) reduction(*:j) reduction(-:l)
+  !DEF: /omp_reduction/Block7/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block7/k (OmpReduction) HostAssoc INTEGER(4)
+    k = k+1
+  end do
+  !$omp end do
+
+
+  !$omp do reduction(.and.:k) reduction(.or.:j) reduction(.eqv.:l)
+  !DEF: /omp_reduction/Block8/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
+  do i=1,10
+    !DEF: /omp_reduction/Block8/k (OmpReduction) HostAssoc INTEGER(4)
+    k = k+1
+  end do
+  !$omp end do
+
+end program omp_reduction

flang/test/Semantics/omp-reduction10.f90

+! RUN: %S/test_errors.sh %s %t %f18 -fopenmp
+! OpenMP Version 4.5
+! 2.15.3.6 Reduction Clause
+program omp_reduction
+
+  integer :: i
+  integer :: k = 10
+
+  !ERROR: Invalid reduction identifier in REDUCTION clause.
+  !$omp parallel do reduction(foo:k)
+  do i = 1, 10
+    k = foo(k)
+  end do
+  !$omp end parallel do
+end program omp_reduction

flang/test/Semantics/omp-symbol08.f90

  do i0=1,n,block_size
 !$omp parallel do  reduction(+:sum)
   !DEF: /dotprod/Block1/Block1/Block1/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
   !REF: /dotprod/Block1/Block1/Block1/i0
   !DEF: /dotprod/min ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
   !REF: /dotprod/block_size
   !REF: /dotprod/n
   do i=i0,min(i0+block_size, n)
-   !REF: /dotprod/sum
+   !DEF: /dotprod/Block1/Block1/Block1/Block1/sum (OmpReduction) HostAssoc REAL(4)
    !REF: /dotprod/b
    !REF: /dotprod/Block1/Block1/Block1/Block1/i
    !REF: /dotprod/c
    sum = sum+b(i)*c(i)
   end do
  end do
 !$omp end teams
 !$omp end target