From 5de49af54036f1427ae8669b6482a198cbfeff2a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Thu, 13 Oct 2022 10:38:55 -0700
Subject: [PATCH] [flang] Abstract interfaces can't be designated or referenced

Broaden the check for misuse of ABSTRACT procedure interfaces by
doing it in expression analysis rather than name resolution so that
cases like pointer assignment targets and actual arguments are also
diagnosed as errors.

Differential Revision: https://reviews.llvm.org/D136971
---
 flang/lib/Semantics/expression.cpp    |  8 ++++++++
 flang/lib/Semantics/resolve-names.cpp |  5 +----
 flang/test/Semantics/abstract02.f90   | 17 +++++++++++++++++
 flang/test/Semantics/resolve20.f90    |  8 +++++---
 4 files changed, 31 insertions(+), 7 deletions(-)
 create mode 100644 flang/test/Semantics/abstract02.f90

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 603fb87..47421ef 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -200,6 +200,10 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
   const Symbol &last{ref.GetLastSymbol()};
   const Symbol &symbol{BypassGeneric(last).GetUltimate()};
   if (semantics::IsProcedure(symbol)) {
+    if (symbol.attrs().test(semantics::Attr::ABSTRACT)) {
+      Say("Abstract procedure interface '%s' may not be used as a designator"_err_en_US,
+          last.name());
+    }
     if (auto *component{std::get_if<Component>(&ref.u)}) {
       return Expr<SomeType>{ProcedureDesignator{std::move(*component)}};
     } else if (!std::holds_alternative<SymbolRef>(ref.u)) {
@@ -2340,6 +2344,10 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
       // re-resolve name to the specific procedure
       name.symbol = const_cast<Symbol *>(resolution);
     }
+  } else if (IsProcedure(ultimate) &&
+      ultimate.attrs().test(semantics::Attr::ABSTRACT)) {
+    Say("Abstract procedure interface '%s' may not be referenced"_err_en_US,
+        name.source);
   } else {
     resolution = symbol;
   }
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f600ddc..2c21896 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6981,10 +6981,7 @@ void ResolveNamesVisitor::HandleProcedureName(
     if (!symbol->has<GenericDetails>()) {
       CheckImplicitNoneExternal(name.source, *symbol);
     }
-    if (symbol->has<SubprogramDetails>() &&
-        symbol->attrs().test(Attr::ABSTRACT)) {
-      Say(name, "Abstract interface '%s' may not be called"_err_en_US);
-    } else if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
+    if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
         symbol->has<AssocEntityDetails>()) {
       // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted
       // here as procedure-designators because this means the related
diff --git a/flang/test/Semantics/abstract02.f90 b/flang/test/Semantics/abstract02.f90
new file mode 100644
index 0000000..29aad7b
--- /dev/null
+++ b/flang/test/Semantics/abstract02.f90
@@ -0,0 +1,17 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test misuse of abstract interfaces
+program test
+  abstract interface
+    subroutine abstract
+    end subroutine
+  end interface
+  procedure(abstract), pointer :: p
+  !ERROR: Abstract procedure interface 'abstract' may not be referenced
+  call abstract
+  !ERROR: Abstract procedure interface 'abstract' may not be used as a designator
+  p => abstract
+  !ERROR: Abstract procedure interface 'abstract' may not be used as a designator
+  call foo(abstract)
+  !ERROR: Abstract procedure interface 'abstract' may not be used as a designator
+  print *, associated(p, abstract)
+end
diff --git a/flang/test/Semantics/resolve20.f90 b/flang/test/Semantics/resolve20.f90
index 9708d6e..938decc 100644
--- a/flang/test/Semantics/resolve20.f90
+++ b/flang/test/Semantics/resolve20.f90
@@ -3,6 +3,8 @@ module m
   abstract interface
     subroutine foo
     end subroutine
+    subroutine foo2
+    end subroutine
   end interface
 
   procedure() :: a
@@ -70,9 +72,9 @@ contains
   subroutine bar
   end subroutine
   subroutine test
-    !ERROR: Abstract interface 'foo' may not be called
-    call foo()
-    !ERROR: Abstract interface 'f' may not be called
+    !ERROR: Abstract procedure interface 'foo2' may not be referenced
+    call foo2()
+    !ERROR: Abstract procedure interface 'f' may not be referenced
     x = f()
   end subroutine
 end module
-- 
2.7.4