diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -503,6 +503,8 @@ OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate, // OpenMP data-mapping attribute OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete, + // OpenMP data-copying attribute + OmpCopyIn, // OpenMP miscellaneous flags OmpCommonBlock, OmpReduction, OmpAllocate, OmpDeclareSimd, OmpDeclareTarget, OmpThreadprivate, OmpDeclareReduction, OmpFlushed, diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp --- a/flang/lib/Semantics/resolve-directives.cpp +++ b/flang/lib/Semantics/resolve-directives.cpp @@ -223,7 +223,7 @@ bool Pre(const parser::SpecificationPart &x) { Walk(std::get>(x.t)); - return false; + return true; } bool Pre(const parser::OpenMPBlockConstruct &); @@ -269,6 +269,10 @@ ResolveOmpObjectList(x.v, Symbol::Flag::OmpLastPrivate); return false; } + bool Pre(const parser::OmpClause::Copyin &x) { + ResolveOmpObjectList(x.v, Symbol::Flag::OmpCopyIn); + return false; + } void Post(const parser::Name &); @@ -292,6 +296,9 @@ static constexpr Symbol::Flags ompFlagsRequireMark{ Symbol::Flag::OmpThreadprivate}; + static constexpr Symbol::Flags dataCopyingAttributeFlags{ + Symbol::Flag::OmpCopyIn}; + std::vector allocateNames_; // on one directive SymbolSet privateDataSharingAttributeObjects_; // on one directive @@ -320,6 +327,9 @@ Symbol *DeclareOrMarkOtherAccessEntity(Symbol &, Symbol::Flag); void CheckMultipleAppearances( const parser::Name &, const Symbol &, Symbol::Flag); + + void CheckDataCopyingClause( + const parser::Name &, const Symbol &, Symbol::Flag); }; template @@ -869,7 +879,7 @@ PushContext(x.source, llvm::omp::Directive::OMPD_threadprivate); const auto &list{std::get(x.t)}; ResolveOmpObjectList(list, Symbol::Flag::OmpThreadprivate); - return false; + return true; } void OmpAttributeVisitor::Post(const parser::OmpDefaultClause &x) { @@ -922,9 +932,14 @@ : nullptr}) { name->symbol = prev; return prev; - } else { - return nullptr; } + // Check if the Common Block is declared in the current scope + if (auto *commonBlockSymbol{ + name ? GetContext().scope.FindCommonBlock(name->source) : nullptr}) { + name->symbol = commonBlockSymbol; + return commonBlockSymbol; + } + return nullptr; } void OmpAttributeVisitor::ResolveOmpObjectList( @@ -941,12 +956,16 @@ [&](const parser::Designator &designator) { if (const auto *name{GetDesignatorNameIfDataRef(designator)}) { if (auto *symbol{ResolveOmp(*name, ompFlag, currScope())}) { - AddToContextObjectWithDSA(*symbol, ompFlag); - if (dataSharingAttributeFlags.test(ompFlag)) { - CheckMultipleAppearances(*name, *symbol, ompFlag); - } - if (ompFlag == Symbol::Flag::OmpAllocate) { - AddAllocateName(name); + if (dataCopyingAttributeFlags.test(ompFlag)) { + CheckDataCopyingClause(*name, *symbol, ompFlag); + } else { + AddToContextObjectWithDSA(*symbol, ompFlag); + if (dataSharingAttributeFlags.test(ompFlag)) { + CheckMultipleAppearances(*name, *symbol, ompFlag); + } + if (ompFlag == Symbol::Flag::OmpAllocate) { + AddAllocateName(name); + } } } } else { @@ -963,15 +982,21 @@ }, [&](const parser::Name &name) { // common block if (auto *symbol{ResolveOmpCommonBlockName(&name)}) { - CheckMultipleAppearances( - name, *symbol, Symbol::Flag::OmpCommonBlock); + if (!dataCopyingAttributeFlags.test(ompFlag)) { + CheckMultipleAppearances( + name, *symbol, Symbol::Flag::OmpCommonBlock); + } // 2.15.3 When a named common block appears in a list, it has the // same meaning as if every explicit member of the common block // appeared in the list for (auto &object : symbol->get().objects()) { if (auto *resolvedObject{ ResolveOmp(*object, ompFlag, currScope())}) { - AddToContextObjectWithDSA(*resolvedObject, ompFlag); + if (dataCopyingAttributeFlags.test(ompFlag)) { + CheckDataCopyingClause(name, *resolvedObject, ompFlag); + } else { + AddToContextObjectWithDSA(*resolvedObject, ompFlag); + } } } } else { @@ -1073,4 +1098,20 @@ } } +void OmpAttributeVisitor::CheckDataCopyingClause( + const parser::Name &name, const Symbol &symbol, Symbol::Flag ompFlag) { + const auto *checkSymbol{&symbol}; + if (ompFlag == Symbol::Flag::OmpCopyIn) { + if (const auto *details{symbol.detailsIf()}) + checkSymbol = &details->symbol(); + + // List of items/objects that can appear in a 'copyin' clause must be + // 'threadprivate' + if (!checkSymbol->test(Symbol::Flag::OmpThreadprivate)) + context_.Say(name.source, + "Non-THREADPRIVATE object '%s' in COPYIN clause"_err_en_US, + checkSymbol->name()); + } +} + } // namespace Fortran::semantics diff --git a/flang/test/Semantics/omp-combined-constructs.f90 b/flang/test/Semantics/omp-combined-constructs.f90 --- a/flang/test/Semantics/omp-combined-constructs.f90 +++ b/flang/test/Semantics/omp-combined-constructs.f90 @@ -53,6 +53,7 @@ !$omp end target parallel !ERROR: COPYIN clause is not allowed on the TARGET PARALLEL directive + !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause !$omp target parallel copyin(a) do i = 1, N a(i) = 3.14 @@ -98,6 +99,7 @@ enddo !$omp end target parallel do + !ERROR: Non-THREADPRIVATE object 'a' in COPYIN clause !$omp target parallel do copyin(a) do i = 1, N a(i) = 3.14 diff --git a/flang/test/Semantics/omp-copyin01.f90 b/flang/test/Semantics/omp-copyin01.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-copyin01.f90 @@ -0,0 +1,34 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.4.1 copyin Clause +! A list item that appears in a copyin clause must be threadprivate + +program omp_copyin + + integer :: i + integer, save :: k + integer :: a(10), b(10) + common /cmn/ j + + k = 10 + + !ERROR: Non-THREADPRIVATE object 'k' in COPYIN clause + !$omp parallel do copyin(k) + do i = 1, 10 + a(i) = k + i + j = j + a(i) + end do + !$omp end parallel do + + print *, a + + !ERROR: Non-THREADPRIVATE object 'j' in COPYIN clause + !$omp parallel do copyin(/cmn/) + do i = 1, 10 + b(i) = a(i) + j + end do + !$omp end parallel do + + print *, b + +end program omp_copyin diff --git a/flang/test/Semantics/omp-copyin02.f90 b/flang/test/Semantics/omp-copyin02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-copyin02.f90 @@ -0,0 +1,23 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.4.1 copyin Clause +! A common block name that appears in a copyin clause must be declared to be +! a common block in the same scoping unit in which the copyin clause appears. + +subroutine copyin() + integer :: a = 10 + common /cmn/ a + + !$omp threadprivate(/cmn/) + call copyin_clause() + + contains + + subroutine copyin_clause() + !ERROR: COMMON block must be declared in the same scoping unit in which the OpenMP directive or clause appears + !$omp parallel copyin(/cmn/) + print *, a + !$omp end parallel + end subroutine copyin_clause + +end subroutine copyin diff --git a/flang/test/Semantics/omp-copyin03.f90 b/flang/test/Semantics/omp-copyin03.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-copyin03.f90 @@ -0,0 +1,33 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.4.1 copyin Clause +! A list item that appears in a copyin clause must be threadprivate. +! Named variables appearing in a threadprivate common block may be specified +! It is not necessary to specify the whole common block. + +program omp_copyin + + integer :: a(10), b(10) + common /cmn/ j, k + + !$omp threadprivate(/cmn/) + + j = 20 + k = 10 + + !$omp parallel copyin(/cmn/) + a(:5) = k + b(:5) = j + !$omp end parallel + + j = j + k + k = k * j + + !$omp parallel copyin(j, k) + a(6:) = j + b(6:) = k + !$omp end parallel + + print *, a, b + +end program omp_copyin diff --git a/flang/test/Semantics/omp-copyin04.f90 b/flang/test/Semantics/omp-copyin04.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-copyin04.f90 @@ -0,0 +1,26 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.4.1 copyin Clause +! A list item that appears in a copyin clause must be threadprivate + +program omp_copyin + + integer :: i + integer, save :: j, k + integer :: a(10), b(10) + + !$omp threadprivate(j, k) + + j = 20 + k = 10 + + !$omp parallel do copyin(j, k) + do i = 1, 10 + a(i) = k + i + b(i) = j + i + end do + !$omp end parallel do + + print *, a, b + +end program omp_copyin diff --git a/flang/test/Semantics/omp-copyin05.f90 b/flang/test/Semantics/omp-copyin05.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/omp-copyin05.f90 @@ -0,0 +1,23 @@ +! RUN: %S/test_errors.sh %s %t %f18 -fopenmp +! OpenMP Version 4.5 +! 2.15.4.1 copyin Clause +! A common block name that appears in a copyin clause must be declared to be +! a common block in the same scoping unit in which the copyin clause appears. + +subroutine copyin() + call copyin_clause() + + contains + + subroutine copyin_clause() + integer :: a = 20 + common /cmn/ a + + !$omp threadprivate(/cmn/) + + !$omp parallel copyin(/cmn/) + print *, a + !$omp end parallel + end subroutine copyin_clause + +end subroutine copyin