@@ -876,6 +876,9 @@ class OmpAttributeVisitor : DirectiveAttributeVisitor<llvm::omp::Directive> {
876876
877877 bool IsNestedInDirective (llvm::omp::Directive directive);
878878 void ResolveOmpObjectList (const parser::OmpObjectList &, Symbol::Flag);
879+ void ResolveOmpDesignator (
880+ const parser::Designator &designator, Symbol::Flag ompFlag);
881+ void ResolveOmpCommonBlock (const parser::Name &name, Symbol::Flag ompFlag);
879882 void ResolveOmpObject (const parser::OmpObject &, Symbol::Flag);
880883 Symbol *ResolveOmp (const parser::Name &, Symbol::Flag, Scope &);
881884 Symbol *ResolveOmp (Symbol &, Symbol::Flag, Scope &);
@@ -2786,196 +2789,182 @@ static bool SymbolOrEquivalentIsInNamelist(const Symbol &symbol) {
27862789 });
27872790}
27882791
2789- void OmpAttributeVisitor::ResolveOmpObject (
2790- const parser::OmpObject &ompObject , Symbol::Flag ompFlag) {
2792+ void OmpAttributeVisitor::ResolveOmpDesignator (
2793+ const parser::Designator &designator , Symbol::Flag ompFlag) {
27912794 unsigned version{context_.langOptions ().OpenMPVersion };
2792- common::visit (
2793- common::visitors{
2794- [&](const parser::Designator &designator) {
2795- if (const auto *name{
2796- semantics::getDesignatorNameIfDataRef (designator)}) {
2797- if (auto *symbol{ResolveOmp (*name, ompFlag, currScope ())}) {
2798- auto checkExclusivelists =
2799- [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,
2800- const Symbol *symbol2, Symbol::Flag secondOmpFlag) {
2801- if ((symbol1->test (firstOmpFlag) &&
2802- symbol2->test (secondOmpFlag)) ||
2803- (symbol1->test (secondOmpFlag) &&
2804- symbol2->test (firstOmpFlag))) {
2805- context_.Say (designator.source ,
2806- " Variable '%s' may not "
2807- " appear on both %s and %s "
2808- " clauses on a %s construct" _err_en_US,
2809- symbol2->name (),
2810- Symbol::OmpFlagToClauseName (firstOmpFlag),
2811- Symbol::OmpFlagToClauseName (secondOmpFlag),
2812- parser::ToUpperCaseLetters (
2813- llvm::omp::getOpenMPDirectiveName (
2814- GetContext ().directive , version)
2815- .str ()));
2816- }
2817- };
2818- if (dataCopyingAttributeFlags.test (ompFlag)) {
2819- CheckDataCopyingClause (*name, *symbol, ompFlag);
2820- } else {
2821- AddToContextObjectWithExplicitDSA (*symbol, ompFlag);
2822- if (dataSharingAttributeFlags.test (ompFlag)) {
2823- CheckMultipleAppearances (*name, *symbol, ompFlag);
2824- }
2825- if (privateDataSharingAttributeFlags.test (ompFlag)) {
2826- CheckObjectIsPrivatizable (*name, *symbol, ompFlag);
2827- }
2795+ llvm::omp::Directive directive{GetContext ().directive };
28282796
2829- if (ompFlag == Symbol::Flag::OmpAllocate) {
2830- AddAllocateName (name);
2831- }
2832- }
2833- if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
2834- IsAllocatable (*symbol) &&
2835- !IsNestedInDirective (llvm::omp::Directive::OMPD_allocate)) {
2836- context_.Say (designator.source ,
2837- " List items specified in the ALLOCATE directive must not "
2838- " have the ALLOCATABLE attribute unless the directive is "
2839- " associated with an ALLOCATE statement" _err_en_US);
2840- }
2841- if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
2842- ompFlag ==
2843- Symbol::Flag::OmpExecutableAllocateDirective) &&
2844- ResolveOmpObjectScope (name) == nullptr ) {
2845- context_.Say (designator.source , // 2.15.3
2846- " List items must be declared in the same scoping unit "
2847- " in which the %s directive appears" _err_en_US,
2848- parser::ToUpperCaseLetters (
2849- llvm::omp::getOpenMPDirectiveName (
2850- GetContext ().directive , version)
2851- .str ()));
2852- }
2853- if (ompFlag == Symbol::Flag::OmpReduction) {
2854- // Using variables inside of a namelist in OpenMP reductions
2855- // is allowed by the standard, but is not allowed for
2856- // privatisation. This looks like an oversight. If the
2857- // namelist is hoisted to a global, we cannot apply the
2858- // mapping for the reduction variable: resulting in incorrect
2859- // results. Disabling this hoisting could make some real
2860- // production code go slower. See discussion in #109303
2861- if (SymbolOrEquivalentIsInNamelist (*symbol)) {
2862- context_.Say (name->source ,
2863- " Variable '%s' in NAMELIST cannot be in a REDUCTION clause" _err_en_US,
2864- name->ToString ());
2865- }
2866- }
2867- if (ompFlag == Symbol::Flag::OmpInclusiveScan ||
2868- ompFlag == Symbol::Flag::OmpExclusiveScan) {
2869- if (!symbol->test (Symbol::Flag::OmpInScanReduction)) {
2870- context_.Say (name->source ,
2871- " List item %s must appear in REDUCTION clause "
2872- " with the INSCAN modifier of the parent "
2873- " directive" _err_en_US,
2874- name->ToString ());
2875- }
2876- }
2877- if (ompFlag == Symbol::Flag::OmpDeclareTarget) {
2878- if (symbol->IsFuncResult ()) {
2879- if (Symbol * func{currScope ().symbol ()}) {
2880- CHECK (func->IsSubprogram ());
2881- func->set (ompFlag);
2882- name->symbol = func;
2883- }
2884- }
2885- }
2886- if (GetContext ().directive ==
2887- llvm::omp::Directive::OMPD_target_data) {
2888- checkExclusivelists (symbol, Symbol::Flag::OmpUseDevicePtr,
2889- symbol, Symbol::Flag::OmpUseDeviceAddr);
2890- }
2891- if (llvm::omp::allDistributeSet.test (GetContext ().directive )) {
2892- checkExclusivelists (symbol, Symbol::Flag::OmpFirstPrivate,
2893- symbol, Symbol::Flag::OmpLastPrivate);
2894- }
2895- if (llvm::omp::allTargetSet.test (GetContext ().directive )) {
2896- checkExclusivelists (symbol, Symbol::Flag::OmpIsDevicePtr,
2897- symbol, Symbol::Flag::OmpHasDeviceAddr);
2898- const auto *hostAssocSym{symbol};
2899- if (!(symbol->test (Symbol::Flag::OmpIsDevicePtr) ||
2900- symbol->test (Symbol::Flag::OmpHasDeviceAddr))) {
2901- if (const auto *details{
2902- symbol->detailsIf <HostAssocDetails>()}) {
2903- hostAssocSym = &details->symbol ();
2904- }
2905- }
2906- Symbol::Flag dataMappingAttributeFlags[] = {
2907- Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
2908- Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,
2909- Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,
2910- Symbol::Flag::OmpHasDeviceAddr};
2911-
2912- Symbol::Flag dataSharingAttributeFlags[] = {
2913- Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
2914- Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,
2915- Symbol::Flag::OmpLinear};
2916-
2917- // For OMP TARGET TEAMS directive some sharing attribute
2918- // flags and mapping attribute flags can co-exist.
2919- if (!(llvm::omp::allTeamsSet.test (GetContext ().directive ) ||
2920- llvm::omp::allParallelSet.test (
2921- GetContext ().directive ))) {
2922- for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {
2923- for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {
2924- if ((hostAssocSym->test (ompFlag2) &&
2925- hostAssocSym->test (
2926- Symbol::Flag::OmpExplicit)) ||
2927- (symbol->test (ompFlag2) &&
2928- symbol->test (Symbol::Flag::OmpExplicit))) {
2929- checkExclusivelists (
2930- hostAssocSym, ompFlag1, symbol, ompFlag2);
2931- }
2932- }
2933- }
2934- }
2935- }
2936- }
2937- } else {
2938- // Array sections to be changed to substrings as needed
2939- if (AnalyzeExpr (context_, designator)) {
2940- if (std::holds_alternative<parser::Substring>(designator.u )) {
2941- context_.Say (designator.source ,
2942- " Substrings are not allowed on OpenMP "
2943- " directives or clauses" _err_en_US);
2944- }
2945- }
2946- // other checks, more TBD
2947- }
2948- },
2949- [&](const parser::Name &name) { // common block
2950- if (auto *symbol{ResolveOmpCommonBlockName (&name)}) {
2951- if (!dataCopyingAttributeFlags.test (ompFlag)) {
2952- CheckMultipleAppearances (
2953- name, *symbol, Symbol::Flag::OmpCommonBlock);
2954- }
2955- // 2.15.3 When a named common block appears in a list, it has the
2956- // same meaning as if every explicit member of the common block
2957- // appeared in the list
2958- auto &details{symbol->get <CommonBlockDetails>()};
2959- unsigned index{0 };
2960- for (auto &object : details.objects ()) {
2961- if (auto *resolvedObject{
2962- ResolveOmp (*object, ompFlag, currScope ())}) {
2963- if (dataCopyingAttributeFlags.test (ompFlag)) {
2964- CheckDataCopyingClause (name, *resolvedObject, ompFlag);
2965- } else {
2966- AddToContextObjectWithExplicitDSA (*resolvedObject, ompFlag);
2967- }
2968- details.replace_object (*resolvedObject, index);
2969- }
2970- index++;
2971- }
2972- } else {
2973- context_.Say (name.source , // 2.15.3
2974- " COMMON block must be declared in the same scoping unit "
2975- " in which the OpenMP directive or clause appears" _err_en_US);
2797+ const auto *name{semantics::getDesignatorNameIfDataRef (designator)};
2798+ if (!name) {
2799+ // Array sections to be changed to substrings as needed
2800+ if (AnalyzeExpr (context_, designator)) {
2801+ if (std::holds_alternative<parser::Substring>(designator.u )) {
2802+ context_.Say (designator.source ,
2803+ " Substrings are not allowed on OpenMP directives or clauses" _err_en_US);
2804+ }
2805+ }
2806+ // other checks, more TBD
2807+ return ;
2808+ }
2809+
2810+ if (auto *symbol{ResolveOmp (*name, ompFlag, currScope ())}) {
2811+ auto checkExclusivelists{//
2812+ [&](const Symbol *symbol1, Symbol::Flag firstOmpFlag,
2813+ const Symbol *symbol2, Symbol::Flag secondOmpFlag) {
2814+ if ((symbol1->test (firstOmpFlag) && symbol2->test (secondOmpFlag)) ||
2815+ (symbol1->test (secondOmpFlag) && symbol2->test (firstOmpFlag))) {
2816+ context_.Say (designator.source ,
2817+ " Variable '%s' may not appear on both %s and %s clauses on a %s construct" _err_en_US,
2818+ symbol2->name (), Symbol::OmpFlagToClauseName (firstOmpFlag),
2819+ Symbol::OmpFlagToClauseName (secondOmpFlag),
2820+ parser::ToUpperCaseLetters (
2821+ llvm::omp::getOpenMPDirectiveName (directive, version)));
2822+ }
2823+ }};
2824+ if (dataCopyingAttributeFlags.test (ompFlag)) {
2825+ CheckDataCopyingClause (*name, *symbol, ompFlag);
2826+ } else {
2827+ AddToContextObjectWithExplicitDSA (*symbol, ompFlag);
2828+ if (dataSharingAttributeFlags.test (ompFlag)) {
2829+ CheckMultipleAppearances (*name, *symbol, ompFlag);
2830+ }
2831+ if (privateDataSharingAttributeFlags.test (ompFlag)) {
2832+ CheckObjectIsPrivatizable (*name, *symbol, ompFlag);
2833+ }
2834+
2835+ if (ompFlag == Symbol::Flag::OmpAllocate) {
2836+ AddAllocateName (name);
2837+ }
2838+ }
2839+ if (ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective &&
2840+ IsAllocatable (*symbol) &&
2841+ !IsNestedInDirective (llvm::omp::Directive::OMPD_allocate)) {
2842+ context_.Say (designator.source ,
2843+ " List items specified in the ALLOCATE directive must not have the ALLOCATABLE attribute unless the directive is associated with an ALLOCATE statement" _err_en_US);
2844+ }
2845+ if ((ompFlag == Symbol::Flag::OmpDeclarativeAllocateDirective ||
2846+ ompFlag == Symbol::Flag::OmpExecutableAllocateDirective) &&
2847+ ResolveOmpObjectScope (name) == nullptr ) {
2848+ context_.Say (designator.source , // 2.15.3
2849+ " List items must be declared in the same scoping unit in which the %s directive appears" _err_en_US,
2850+ parser::ToUpperCaseLetters (
2851+ llvm::omp::getOpenMPDirectiveName (directive, version)));
2852+ }
2853+ if (ompFlag == Symbol::Flag::OmpReduction) {
2854+ // Using variables inside of a namelist in OpenMP reductions
2855+ // is allowed by the standard, but is not allowed for
2856+ // privatisation. This looks like an oversight. If the
2857+ // namelist is hoisted to a global, we cannot apply the
2858+ // mapping for the reduction variable: resulting in incorrect
2859+ // results. Disabling this hoisting could make some real
2860+ // production code go slower. See discussion in #109303
2861+ if (SymbolOrEquivalentIsInNamelist (*symbol)) {
2862+ context_.Say (name->source ,
2863+ " Variable '%s' in NAMELIST cannot be in a REDUCTION clause" _err_en_US,
2864+ name->ToString ());
2865+ }
2866+ }
2867+ if (ompFlag == Symbol::Flag::OmpInclusiveScan ||
2868+ ompFlag == Symbol::Flag::OmpExclusiveScan) {
2869+ if (!symbol->test (Symbol::Flag::OmpInScanReduction)) {
2870+ context_.Say (name->source ,
2871+ " List item %s must appear in REDUCTION clause with the INSCAN modifier of the parent directive" _err_en_US,
2872+ name->ToString ());
2873+ }
2874+ }
2875+ if (ompFlag == Symbol::Flag::OmpDeclareTarget) {
2876+ if (symbol->IsFuncResult ()) {
2877+ if (Symbol * func{currScope ().symbol ()}) {
2878+ CHECK (func->IsSubprogram ());
2879+ func->set (ompFlag);
2880+ name->symbol = func;
2881+ }
2882+ }
2883+ }
2884+ if (directive == llvm::omp::Directive::OMPD_target_data) {
2885+ checkExclusivelists (symbol, Symbol::Flag::OmpUseDevicePtr, symbol,
2886+ Symbol::Flag::OmpUseDeviceAddr);
2887+ }
2888+ if (llvm::omp::allDistributeSet.test (directive)) {
2889+ checkExclusivelists (symbol, Symbol::Flag::OmpFirstPrivate, symbol,
2890+ Symbol::Flag::OmpLastPrivate);
2891+ }
2892+ if (llvm::omp::allTargetSet.test (directive)) {
2893+ checkExclusivelists (symbol, Symbol::Flag::OmpIsDevicePtr, symbol,
2894+ Symbol::Flag::OmpHasDeviceAddr);
2895+ const auto *hostAssocSym{symbol};
2896+ if (!symbol->test (Symbol::Flag::OmpIsDevicePtr) &&
2897+ !symbol->test (Symbol::Flag::OmpHasDeviceAddr)) {
2898+ if (const auto *details{symbol->detailsIf <HostAssocDetails>()}) {
2899+ hostAssocSym = &details->symbol ();
2900+ }
2901+ }
2902+ static Symbol::Flag dataMappingAttributeFlags[] = {//
2903+ Symbol::Flag::OmpMapTo, Symbol::Flag::OmpMapFrom,
2904+ Symbol::Flag::OmpMapToFrom, Symbol::Flag::OmpMapStorage,
2905+ Symbol::Flag::OmpMapDelete, Symbol::Flag::OmpIsDevicePtr,
2906+ Symbol::Flag::OmpHasDeviceAddr};
2907+
2908+ static Symbol::Flag dataSharingAttributeFlags[] = {//
2909+ Symbol::Flag::OmpPrivate, Symbol::Flag::OmpFirstPrivate,
2910+ Symbol::Flag::OmpLastPrivate, Symbol::Flag::OmpShared,
2911+ Symbol::Flag::OmpLinear};
2912+
2913+ // For OMP TARGET TEAMS directive some sharing attribute
2914+ // flags and mapping attribute flags can co-exist.
2915+ if (!llvm::omp::allTeamsSet.test (directive) &&
2916+ !llvm::omp::allParallelSet.test (directive)) {
2917+ for (Symbol::Flag ompFlag1 : dataMappingAttributeFlags) {
2918+ for (Symbol::Flag ompFlag2 : dataSharingAttributeFlags) {
2919+ if ((hostAssocSym->test (ompFlag2) &&
2920+ hostAssocSym->test (Symbol::Flag::OmpExplicit)) ||
2921+ (symbol->test (ompFlag2) &&
2922+ symbol->test (Symbol::Flag::OmpExplicit))) {
2923+ checkExclusivelists (hostAssocSym, ompFlag1, symbol, ompFlag2);
29762924 }
2977- },
2978- },
2925+ }
2926+ }
2927+ }
2928+ }
2929+ }
2930+ }
2931+
2932+ void OmpAttributeVisitor::ResolveOmpCommonBlock (
2933+ const parser::Name &name, Symbol::Flag ompFlag) {
2934+ if (auto *symbol{ResolveOmpCommonBlockName (&name)}) {
2935+ if (!dataCopyingAttributeFlags.test (ompFlag)) {
2936+ CheckMultipleAppearances (name, *symbol, Symbol::Flag::OmpCommonBlock);
2937+ }
2938+ // 2.15.3 When a named common block appears in a list, it has the
2939+ // same meaning as if every explicit member of the common block
2940+ // appeared in the list
2941+ auto &details{symbol->get <CommonBlockDetails>()};
2942+ for (auto [index, object] : llvm::enumerate (details.objects ())) {
2943+ if (auto *resolvedObject{ResolveOmp (*object, ompFlag, currScope ())}) {
2944+ if (dataCopyingAttributeFlags.test (ompFlag)) {
2945+ CheckDataCopyingClause (name, *resolvedObject, ompFlag);
2946+ } else {
2947+ AddToContextObjectWithExplicitDSA (*resolvedObject, ompFlag);
2948+ }
2949+ details.replace_object (*resolvedObject, index);
2950+ }
2951+ }
2952+ } else {
2953+ context_.Say (name.source , // 2.15.3
2954+ " COMMON block must be declared in the same scoping unit in which the OpenMP directive or clause appears" _err_en_US);
2955+ }
2956+ }
2957+
2958+ void OmpAttributeVisitor::ResolveOmpObject (
2959+ const parser::OmpObject &ompObject, Symbol::Flag ompFlag) {
2960+ common::visit (common::visitors{
2961+ [&](const parser::Designator &designator) {
2962+ ResolveOmpDesignator (designator, ompFlag);
2963+ },
2964+ [&](const parser::Name &name) { // common block
2965+ ResolveOmpCommonBlock (name, ompFlag);
2966+ },
2967+ },
29792968 ompObject.u );
29802969}
29812970
0 commit comments