[flang-commits] [flang] 46c49e6 - [flang] Extend characterization & checking for procedure bindings

Peter Klausler via flang-commits flang-commits at lists.llvm.org
Tue Aug 9 12:01:58 PDT 2022


Author: Peter Klausler
Date: 2022-08-09T12:01:45-07:00
New Revision: 46c49e66d8b2173b8b0467b907fb6d6b65e5e615

URL: https://github.com/llvm/llvm-project/commit/46c49e66d8b2173b8b0467b907fb6d6b65e5e615
DIFF: https://github.com/llvm/llvm-project/commit/46c49e66d8b2173b8b0467b907fb6d6b65e5e615.diff

LOG: [flang] Extend characterization & checking for procedure bindings

Procedure bindings with explicit interfaces don't work when the
interface is shadowed by a generic interface of the same name,
and can produce spurious semantic error messages.  Extend the
characterization and checking code for such things, and the utility
functionns on which they depend, to dig through generics when they
occlude interface-defining subprograms.  This is done on demand in
checking code, not once during name resolution, because the
procedures in question may also be forward-referenced.

Differential Revision: https://reviews.llvm.org/D131105

diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index e79f8ab6503e..0b03bf06eb73 100644
--- a/flang/include/flang/Semantics/symbol.h

Added: 
    

Modified: 
    flang/include/flang/Semantics/symbol.h
    flang/lib/Evaluate/characteristics.cpp
    flang/lib/Semantics/check-declarations.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/tools.cpp
    flang/test/Semantics/resolve20.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index e79f8ab6503e2..0b03bf06eb737 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -629,6 +629,10 @@ class Symbol {
                              [](const HostAssocDetails &x) {
                                return x.symbol().HasExplicitInterface();
                              },
+                             [](const GenericDetails &x) {
+                               return x.specific() &&
+                                   x.specific()->HasExplicitInterface();
+                             },
                              [](const auto &) { return false; },
                          },
         details_);

diff  --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index cc092cd1a46d7..a2cc866eecd19 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -499,7 +499,9 @@ static std::optional<Procedure> CharacterizeProcedure(
               }
               return intrinsic;
             }
-            const semantics::ProcInterface &interface { proc.interface() };
+            const semantics::ProcInterface &interface {
+              proc.interface()
+            };
             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
               auto interface {
                 CharacterizeProcedure(*interfaceSymbol, context, seenProcs)
@@ -558,6 +560,13 @@ static std::optional<Procedure> CharacterizeProcedure(
           [&](const semantics::HostAssocDetails &assoc) {
             return CharacterizeProcedure(assoc.symbol(), context, seenProcs);
           },
+          [&](const semantics::GenericDetails &generic) {
+            if (const semantics::Symbol * specific{generic.specific()}) {
+              return CharacterizeProcedure(*specific, context, seenProcs);
+            } else {
+              return std::optional<Procedure>{};
+            }
+          },
           [&](const semantics::EntityDetails &) {
             context.messages().Say(
                 "Procedure '%s' is referenced before being sufficiently defined in a context where it must be so"_err_en_US,

diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index dca82554c7c97..abfd3d4963f83 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1517,11 +1517,14 @@ void CheckHelper::CheckPointer(const Symbol &symbol) { // C852
 // C760 constraints on the passed-object dummy argument
 // C757 constraints on procedure pointer components
 void CheckHelper::CheckPassArg(
-    const Symbol &proc, const Symbol *interface, const WithPassArg &details) {
+    const Symbol &proc, const Symbol *interface0, const WithPassArg &details) {
   if (proc.attrs().test(Attr::NOPASS)) {
     return;
   }
   const auto &name{proc.name()};
+  const Symbol *interface {
+    interface0 ? FindInterface(*interface0) : nullptr
+  };
   if (!interface) {
     messages_.Say(name,
         "Procedure component '%s' must have NOPASS attribute or explicit interface"_err_en_US,

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 9cd3a414ed538..b6185e2517d68 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -4869,10 +4869,13 @@ void DeclarationVisitor::Post(
     if (!procedure) {
       procedure = NoteInterfaceName(procedureName);
     }
-    if (auto *s{MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
-      SetPassNameOn(*s);
-      if (GetAttrs().test(Attr::DEFERRED)) {
-        context().SetError(*s);
+    if (procedure) {
+      if (auto *s{
+              MakeTypeSymbol(bindingName, ProcBindingDetails{*procedure})}) {
+        SetPassNameOn(*s);
+        if (GetAttrs().test(Attr::DEFERRED)) {
+          context().SetError(*s);
+        }
       }
     }
   }

diff  --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 05a9317eb0a1e..d5eaed819c765 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -456,9 +456,25 @@ const Symbol *FindInterface(const Symbol &symbol) {
   return common::visit(
       common::visitors{
           [](const ProcEntityDetails &details) {
-            return details.interface().symbol();
+            const Symbol *interface {
+              details.interface().symbol()
+            };
+            return interface ? FindInterface(*interface) : nullptr;
+          },
+          [](const ProcBindingDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [&](const SubprogramDetails &) { return &symbol; },
+          [](const UseDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [](const HostAssocDetails &details) {
+            return FindInterface(details.symbol());
+          },
+          [](const GenericDetails &details) {
+            return details.specific() ? FindInterface(*details.specific())
+                                      : nullptr;
           },
-          [](const ProcBindingDetails &details) { return &details.symbol(); },
           [](const auto &) -> const Symbol * { return nullptr; },
       },
       symbol.details());
@@ -484,6 +500,10 @@ const Symbol *FindSubprogram(const Symbol &symbol) {
           [](const HostAssocDetails &details) {
             return FindSubprogram(details.symbol());
           },
+          [](const GenericDetails &details) {
+            return details.specific() ? FindSubprogram(*details.specific())
+                                      : nullptr;
+          },
           [](const auto &) -> const Symbol * { return nullptr; },
       },
       symbol.details());

diff  --git a/flang/test/Semantics/resolve20.f90 b/flang/test/Semantics/resolve20.f90
index 4d1c6381bb56f..9708d6efd46c4 100644
--- a/flang/test/Semantics/resolve20.f90
+++ b/flang/test/Semantics/resolve20.f90
@@ -57,7 +57,7 @@ subroutine forward
     integer :: i
   contains
     !ERROR: 'proc' must be an abstract interface or a procedure with an explicit interface
-    !ERROR: Procedure component 'p1' has invalid interface 'proc'
+    !ERROR: Procedure component 'p1' must have NOPASS attribute or explicit interface
     procedure(proc), deferred :: p1
   end type t1
 


        


More information about the flang-commits mailing list