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

[Valentin Clement バレンタイン クレメン via flang-commits]

https://github.com/clementval created https://github.com/llvm/llvm-project/pull/71444

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

>From 93746297281a8346521f793c9ac4df61f1170244 Mon Sep 17 00:00:00 2001
From: Valentin Clement <clementval at gmail.com>
Date: Mon, 6 Nov 2023 13:24:03 -0800
Subject: [PATCH] [flang][openacc] Issue an error when TBP are used in data
 clause

---
 flang/lib/Semantics/resolve-directives.cpp | 24 ++++++++++++++++++++++
 flang/test/Semantics/OpenACC/acc-data.f90  | 23 +++++++++++++++++++++
 2 files changed, 47 insertions(+)

diff --git a/flang/lib/Semantics/resolve-directives.cpp b/flang/lib/Semantics/resolve-directives.cpp
index fc0648b34bedef9..ae9105e71939282 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,28 @@ 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 +1304,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