[flang-commits] [PATCH] D136971: [flang] Abstract interfaces can't be designated or referenced

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: clementval.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D136971

Files:
  flang/lib/Semantics/expression.cpp
  flang/lib/Semantics/resolve-names.cpp
  flang/test/Semantics/abstract02.f90
  flang/test/Semantics/resolve20.f90


Index: flang/test/Semantics/resolve20.f90
===================================================================
--- flang/test/Semantics/resolve20.f90
+++ flang/test/Semantics/resolve20.f90
@@ -3,6 +3,8 @@
   abstract interface
     subroutine foo
     end subroutine
+    subroutine foo2
+    end subroutine
   end interface
 
   procedure() :: a
@@ -70,9 +72,9 @@
   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
Index: flang/test/Semantics/abstract02.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -6974,10 +6974,7 @@
     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
Index: flang/lib/Semantics/expression.cpp
===================================================================
--- flang/lib/Semantics/expression.cpp
+++ flang/lib/Semantics/expression.cpp
@@ -200,6 +200,10 @@
   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)) {
@@ -2319,6 +2323,10 @@
       // 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;
   }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D136971.471617.patch
Type: text/x-patch
Size: 3510 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221028/374d9d64/attachment.bin>