@@ -1324,13 +1324,163 @@ void OmpStructureChecker::Leave(const parser::OmpEndBlockDirective &x) {
1324
1324
}
1325
1325
}
1326
1326
1327
+ template <typename T, typename D>
1328
+ bool OmpStructureChecker::IsOperatorValid (const T &node, const D &variable) {
1329
+ using AllowedBinaryOperators =
1330
+ std::variant<parser::Expr::Add, parser::Expr::Multiply,
1331
+ parser::Expr::Subtract, parser::Expr::Divide, parser::Expr::AND,
1332
+ parser::Expr::OR, parser::Expr::EQV, parser::Expr::NEQV>;
1333
+ using BinaryOperators = std::variant<parser::Expr::Add,
1334
+ parser::Expr::Multiply, parser::Expr::Subtract, parser::Expr::Divide,
1335
+ parser::Expr::AND, parser::Expr::OR, parser::Expr::EQV,
1336
+ parser::Expr::NEQV, parser::Expr::Power, parser::Expr::Concat,
1337
+ parser::Expr::LT, parser::Expr::LE, parser::Expr::EQ, parser::Expr::NE,
1338
+ parser::Expr::GE, parser::Expr::GT>;
1339
+
1340
+ if constexpr (common::HasMember<T, BinaryOperators>) {
1341
+ const auto &variableName{variable.GetSource ().ToString ()};
1342
+ const auto &exprLeft{std::get<0 >(node.t )};
1343
+ const auto &exprRight{std::get<1 >(node.t )};
1344
+ if ((exprLeft.value ().source .ToString () != variableName) &&
1345
+ (exprRight.value ().source .ToString () != variableName)) {
1346
+ context_.Say (variable.GetSource (),
1347
+ " Atomic update variable '%s' not found in the RHS of the assignment statement in an ATOMIC (UPDATE) construct" _err_en_US,
1348
+ variableName);
1349
+ }
1350
+ return common::HasMember<T, AllowedBinaryOperators>;
1351
+ }
1352
+ return true ;
1353
+ }
1354
+
1355
+ void OmpStructureChecker::CheckAtomicUpdateAssignmentStmt (
1356
+ const parser::AssignmentStmt &assignment) {
1357
+ const auto &expr{std::get<parser::Expr>(assignment.t )};
1358
+ const auto &var{std::get<parser::Variable>(assignment.t )};
1359
+ std::visit (
1360
+ common::visitors{
1361
+ [&](const common::Indirection<parser::FunctionReference> &x) {
1362
+ const auto &procedureDesignator{
1363
+ std::get<parser::ProcedureDesignator>(x.value ().v .t )};
1364
+ const parser::Name *name{
1365
+ std::get_if<parser::Name>(&procedureDesignator.u )};
1366
+ if (name &&
1367
+ !(name->source == " max" || name->source == " min" ||
1368
+ name->source == " iand" || name->source == " ior" ||
1369
+ name->source == " ieor" )) {
1370
+ context_.Say (expr.source ,
1371
+ " Invalid intrinsic procedure name in OpenMP ATOMIC (UPDATE) statement" _err_en_US);
1372
+ } else if (name) {
1373
+ bool foundMatch{false };
1374
+ if (auto varDesignatorIndirection =
1375
+ std::get_if<Fortran::common::Indirection<
1376
+ Fortran::parser::Designator>>(&var.u )) {
1377
+ const auto &varDesignator = varDesignatorIndirection->value ();
1378
+ if (const auto *dataRef = std::get_if<Fortran::parser::DataRef>(
1379
+ &varDesignator.u )) {
1380
+ if (const auto *name =
1381
+ std::get_if<Fortran::parser::Name>(&dataRef->u )) {
1382
+ const auto &varSymbol = *name->symbol ;
1383
+ if (const auto *e{GetExpr (expr)}) {
1384
+ for (const Symbol &symbol :
1385
+ evaluate::CollectSymbols (*e)) {
1386
+ if (symbol == varSymbol) {
1387
+ foundMatch = true ;
1388
+ break ;
1389
+ }
1390
+ }
1391
+ }
1392
+ }
1393
+ }
1394
+ }
1395
+ if (!foundMatch) {
1396
+ context_.Say (expr.source ,
1397
+ " Atomic update variable '%s' not found in the argument list of intrinsic procedure" _err_en_US,
1398
+ var.GetSource ().ToString ());
1399
+ }
1400
+ }
1401
+ },
1402
+ [&](const auto &x) {
1403
+ if (!IsOperatorValid (x, var)) {
1404
+ context_.Say (expr.source ,
1405
+ " Invalid operator in OpenMP ATOMIC (UPDATE) statement" _err_en_US);
1406
+ }
1407
+ },
1408
+ },
1409
+ expr.u );
1410
+ }
1411
+
1412
+ void OmpStructureChecker::CheckAtomicMemoryOrderClause (
1413
+ const parser::OmpAtomicClauseList &clauseList) {
1414
+ int numMemoryOrderClause = 0 ;
1415
+ for (const auto &clause : clauseList.v ) {
1416
+ if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u )) {
1417
+ numMemoryOrderClause++;
1418
+ if (numMemoryOrderClause > 1 ) {
1419
+ context_.Say (clause.source ,
1420
+ " More than one memory order clause not allowed on OpenMP Atomic construct" _err_en_US);
1421
+ return ;
1422
+ }
1423
+ }
1424
+ }
1425
+ }
1426
+
1427
+ void OmpStructureChecker::CheckAtomicMemoryOrderClause (
1428
+ const parser::OmpAtomicClauseList &leftHandClauseList,
1429
+ const parser::OmpAtomicClauseList &rightHandClauseList) {
1430
+ int numMemoryOrderClause = 0 ;
1431
+ for (const auto &clause : leftHandClauseList.v ) {
1432
+ if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u )) {
1433
+ numMemoryOrderClause++;
1434
+ if (numMemoryOrderClause > 1 ) {
1435
+ context_.Say (clause.source ,
1436
+ " More than one memory order clause not allowed on OpenMP Atomic construct" _err_en_US);
1437
+ return ;
1438
+ }
1439
+ }
1440
+ }
1441
+ for (const auto &clause : rightHandClauseList.v ) {
1442
+ if (std::get_if<Fortran::parser::OmpMemoryOrderClause>(&clause.u )) {
1443
+ numMemoryOrderClause++;
1444
+ if (numMemoryOrderClause > 1 ) {
1445
+ context_.Say (clause.source ,
1446
+ " More than one memory order clause not allowed on OpenMP Atomic construct" _err_en_US);
1447
+ return ;
1448
+ }
1449
+ }
1450
+ }
1451
+ }
1452
+
1327
1453
void OmpStructureChecker::Enter (const parser::OpenMPAtomicConstruct &x) {
1328
1454
std::visit (
1329
1455
common::visitors{
1330
- [&](const auto &someAtomicConstruct) {
1331
- const auto &dir{std::get<parser::Verbatim>(someAtomicConstruct.t )};
1456
+ [&](const parser::OmpAtomic &atomicConstruct) {
1457
+ const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t )};
1458
+ PushContextAndClauseSets (
1459
+ dir.source , llvm::omp::Directive::OMPD_atomic);
1460
+ CheckAtomicUpdateAssignmentStmt (
1461
+ std::get<parser::Statement<parser::AssignmentStmt>>(
1462
+ atomicConstruct.t )
1463
+ .statement );
1464
+ CheckAtomicMemoryOrderClause (
1465
+ std::get<parser::OmpAtomicClauseList>(atomicConstruct.t ));
1466
+ },
1467
+ [&](const parser::OmpAtomicUpdate &atomicConstruct) {
1468
+ const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t )};
1469
+ PushContextAndClauseSets (
1470
+ dir.source , llvm::omp::Directive::OMPD_atomic);
1471
+ CheckAtomicUpdateAssignmentStmt (
1472
+ std::get<parser::Statement<parser::AssignmentStmt>>(
1473
+ atomicConstruct.t )
1474
+ .statement );
1475
+ CheckAtomicMemoryOrderClause (
1476
+ std::get<0 >(atomicConstruct.t ), std::get<2 >(atomicConstruct.t ));
1477
+ },
1478
+ [&](const auto &atomicConstruct) {
1479
+ const auto &dir{std::get<parser::Verbatim>(atomicConstruct.t )};
1332
1480
PushContextAndClauseSets (
1333
1481
dir.source , llvm::omp::Directive::OMPD_atomic);
1482
+ CheckAtomicMemoryOrderClause (
1483
+ std::get<0 >(atomicConstruct.t ), std::get<2 >(atomicConstruct.t ));
1334
1484
},
1335
1485
},
1336
1486
x.u );
0 commit comments