[flang-commits] [flang] [flang][OpenMP] Fix 2 more regressions after #101009 (PR #101538)

[Leandro Lupori via flang-commits]

https://github.com/luporl created https://github.com/llvm/llvm-project/pull/101538

PR #101009 exposed a semantic check issue with OPTIONAL dummy
arguments.
Another issue occurred when using %{re,im,len,kind}, as these also
need to be skipped when handling variables with implicitly defined
DSAs.

These issues were found by Fujitsu testsuite.


>From 5b9a8f18caa838d4ee22de53df4bc00091e4a8d6 Mon Sep 17 00:00:00 2001
From: Leandro Lupori <leandro.lupori at linaro.org>
Date: Thu, 1 Aug 2024 17:18:35 +0000
Subject: [PATCH] [flang][OpenMP] Fix 2 more regressions after #101009

PR #101009 exposed a semantic check issue with OPTIONAL dummy
arguments.
Another issue occurred when using %{re,im,len,kind}, as these also
need to be skipped when handling variables with implicitly defined
DSAs.

These issues were found by Fujitsu testsuite.
---
 flang/lib/Semantics/check-call.cpp         |  3 ++-
 flang/lib/Semantics/resolve-directives.cpp | 15 ++++++++-------
 flang/test/Semantics/OpenMP/complex.f90    | 13 +++++++++++++
 flang/test/Semantics/OpenMP/present.f90    |  9 +++++++++
 4 files changed, 32 insertions(+), 8 deletions(-)
 create mode 100644 flang/test/Semantics/OpenMP/complex.f90
 create mode 100644 flang/test/Semantics/OpenMP/present.f90

diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 9fad1aa3dd0bf..4708d51d3af4d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1645,7 +1645,8 @@ static void CheckPresent(evaluate::ActualArguments &arguments,
       } else {
         symbol = arg->GetAssumedTypeDummy();
       }
-      if (!symbol || !symbol->attrs().test(semantics::Attr::OPTIONAL)) {
+      if (!symbol ||
+          !symbol->GetUltimate().attrs().test(semantics::Attr::OPTIONAL)) {
         messages.Say(arg ? arg->sourceLocation() : messages.at(),
             "Argument of PRESENT() must be the name of a whole OPTIONAL dummy argument"_err_en_US);
       }
diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index d635a7b8b7874..cc9f1cc7ed269 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -2036,20 +2036,21 @@ void OmpAttributeVisitor::Post(const parser::OpenMPAllocatorsConstruct &x) {
 void OmpAttributeVisitor::Post(const parser::Name &name) {
   auto *symbol{name.symbol};
   auto IsPrivatizable = [](const Symbol *sym) {
+    auto *misc{sym->detailsIf<MiscDetails>()};
     return !IsProcedure(*sym) && !IsNamedConstant(*sym) &&
         !sym->owner().IsDerivedType() &&
         sym->owner().kind() != Scope::Kind::ImpliedDos &&
         !sym->detailsIf<semantics::AssocEntityDetails>() &&
-        !sym->detailsIf<semantics::NamelistDetails>();
+        !sym->detailsIf<semantics::NamelistDetails>() &&
+        (!misc ||
+            (misc->kind() != MiscDetails::Kind::ComplexPartRe &&
+                misc->kind() != MiscDetails::Kind::ComplexPartIm &&
+                misc->kind() != MiscDetails::Kind::KindParamInquiry &&
+                misc->kind() != MiscDetails::Kind::LenParamInquiry &&
+                misc->kind() != MiscDetails::Kind::ConstructName));
   };
 
   if (symbol && !dirContext_.empty() && GetContext().withinConstruct) {
-    // Exclude construct-names
-    if (auto *details{symbol->detailsIf<semantics::MiscDetails>()}) {
-      if (details->kind() == semantics::MiscDetails::Kind::ConstructName) {
-        return;
-      }
-    }
     if (IsPrivatizable(symbol) && !IsObjectWithDSA(*symbol)) {
       // TODO: create a separate function to go through the rules for
       //       predetermined, explicitly determined, and implicitly
diff --git a/flang/test/Semantics/OpenMP/complex.f90 b/flang/test/Semantics/OpenMP/complex.f90
new file mode 100644
index 0000000000000..62336c7e6b31a
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/complex.f90
@@ -0,0 +1,13 @@
+! RUN: %flang_fc1 -fopenmp -fsyntax-only %s
+
+! Check that using %re/%im inside 'parallel' doesn't cause syntax errors.
+subroutine test_complex_re_im
+  complex :: cc(4) = (1,2)
+  integer :: i
+
+  !$omp parallel do private(cc)
+    do i = 1, 4
+      print *, cc(i)%re, cc(i)%im
+    end do
+  !$omp end parallel do
+end subroutine
diff --git a/flang/test/Semantics/OpenMP/present.f90 b/flang/test/Semantics/OpenMP/present.f90
new file mode 100644
index 0000000000000..31bdcc7a8c654
--- /dev/null
+++ b/flang/test/Semantics/OpenMP/present.f90
@@ -0,0 +1,9 @@
+! RUN: %flang_fc1 -fopenmp -fsyntax-only %s
+
+! Check that using 'present' inside 'parallel' doesn't cause syntax errors.
+subroutine test_present(opt)
+  integer, optional :: opt
+  !$omp parallel
+    if (present(opt)) print *, "present"
+  !$omp end parallel
+end subroutine