[flang-commits] [flang] 6be6081 - [flang][openacc] Issue an error when TBP are used in data clause (#71444)

[via flang-commits]

Author: Valentin Clement (バレンタイン クレメン)
Date: 2023-11-06T14:52:41-08:00
New Revision: 6be6081610b108ff24a2509a0d82e13178c8ec37

URL: https://github.com/llvm/llvm-project/commit/6be6081610b108ff24a2509a0d82e13178c8ec37
DIFF: https://github.com/llvm/llvm-project/commit/6be6081610b108ff24a2509a0d82e13178c8ec37.diff

LOG: [flang][openacc] Issue an error when TBP are used in data clause (#71444)

Putting a type-bound procedure in a data clause was crashing the
lowering. Issue a proper semantic error in this case.

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-directives.cpp
    flang/test/Semantics/OpenACC/acc-data.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index 2be65920f689d60..fefccd6c6ceb0f3 100644
--- a/flang/lib/Semantics/resolve-directives.cpp
+++ b/flang/lib/Semantics/resolve-directives.cpp
@@ -280,6 +280,7 @@ class AccAttributeVisitor : DirectiveAttributeVisitor<llvm::acc::Directive> {
       const parser::Name &, const Symbol &, Symbol::Flag);
   void AllowOnlyArrayAndSubArray(const parser::AccObjectList &objectList);
   void DoNotAllowAssumedSizedArray(const parser::AccObjectList &objectList);
+  void AllowOnlyVariable(const parser::AccObject &object);
   void EnsureAllocatableOrPointer(
       const llvm::acc::Clause clause, const parser::AccObjectList &objectList);
   void AddRoutineInfoToSymbol(
@@ -1117,6 +1118,25 @@ void AccAttributeVisitor::DoNotAllowAssumedSizedArray(
   }
 }
 
+void AccAttributeVisitor::AllowOnlyVariable(const parser::AccObject &object) {
+  common::visit(
+      common::visitors{
+          [&](const parser::Designator &designator) {
+            const auto &name{GetLastName(designator)};
+            if (name.symbol && !semantics::IsVariableName(*name.symbol)) {
+              context_.Say(designator.source,
+                  "Only variables are allowed in data clauses on the %s "
+                  "directive"_err_en_US,
+                  parser::ToUpperCaseLetters(
+                      llvm::acc::getOpenACCDirectiveName(GetContext().directive)
+                          .str()));
+            }
+          },
+          [&](const auto &name) {},
+      },
+      object.u);
+}
+
 bool AccAttributeVisitor::Pre(const parser::OpenACCCacheConstruct &x) {
   const auto &verbatim{std::get<parser::Verbatim>(x.t)};
   PushContext(verbatim.source, llvm::acc::Directive::ACCD_cache);
@@ -1281,6 +1301,7 @@ Symbol *AccAttributeVisitor::ResolveAccCommonBlockName(
 void AccAttributeVisitor::ResolveAccObjectList(
     const parser::AccObjectList &accObjectList, Symbol::Flag accFlag) {
   for (const auto &accObject : accObjectList.v) {
+    AllowOnlyVariable(accObject);
     ResolveAccObject(accObject, accFlag);
   }
 }

diff  --git a/flang/test/Semantics/OpenACC/acc-data.f90 b/flang/test/Semantics/OpenACC/acc-data.f90
index 1a7a6f95f3d891e..095d06db91fc3ae 100644
--- a/flang/test/Semantics/OpenACC/acc-data.f90
+++ b/flang/test/Semantics/OpenACC/acc-data.f90
@@ -188,3 +188,26 @@ program openacc_data_validity
   !$acc end data
 
 end program openacc_data_validity
+
+module mod1
+  type :: t1
+    integer :: a
+  contains
+    procedure :: t1_proc
+  end type
+
+contains
+
+
+  subroutine t1_proc(this)
+    class(t1) :: this
+  end subroutine
+
+  subroutine sub4(t)
+    type(t1) :: t
+
+    !ERROR: Only variables are allowed in data clauses on the DATA directive
+    !$acc data copy(t%t1_proc)
+    !$acc end data
+  end subroutine
+end module