[flang-commits] [flang] d69ad21 - [flang] Missing function-vs-subroutine checks on bindings (#177699)

[via flang-commits]

Author: Peter Klausler
Date: 2026-01-27T08:23:23-08:00
New Revision: d69ad211b5da5a1c34848451366f1b0ddb123ccc

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

LOG: [flang] Missing function-vs-subroutine checks on bindings (#177699)

Derived type procedure bindings aren't always subject to the checks of
the function-vs-subroutine classification flags on their symbol table
entries in name resolution, and we're missing some cases that aren't
caught later in expression semantics, which assumed that name resolution
would have already handled them. So check function-vs-subroutine errors
on bindings in expression semantics entirely.

Fixes https://github.com/llvm/llvm-project/issues/177601.

Added: 
    flang/test/Semantics/bug177601.f90

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e07d2ccd4f16b..e20ce698abc65 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2651,6 +2651,13 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
                 "Base of procedure component reference must be scalar"_err_en_US);
           }
         }
+        if (IsFunction(*sym) == isSubroutine &&
+            sym->has<semantics::ProcBindingDetails>()) {
+          AttachDeclaration(
+              Say(sc.Component().source, "Binding '%s' is not a %s"_err_en_US,
+                  sym->name(), isSubroutine ? "subroutine" : "function"),
+              *sym);
+        }
         if (const Symbol *resolution{
                 GetBindingResolution(dtExpr->GetType(), *sym)}) {
           AddPassArg(arguments, std::move(*dtExpr), *sym, false);

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f207ab91ab682..16b76b72880c9 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -9537,6 +9537,11 @@ static bool IsLocallyImplicitGlobalSymbol(
 // Check and set the Function or Subroutine flag on symbol; false on error.
 bool ResolveNamesVisitor::SetProcFlag(
     const parser::Name &name, Symbol &symbol, Symbol::Flag flag) {
+  if (symbol.has<ProcBindingDetails>()) {
+    // Binding function-vs-subroutine errors are caught later in
+    // expression semantics and procedure compatibility checking.
+    return true;
+  }
   if (symbol.test(Symbol::Flag::Function) && flag == Symbol::Flag::Subroutine) {
     SayWithDecl(
         name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);

diff  --git a/flang/test/Semantics/bug177601.f90 b/flang/test/Semantics/bug177601.f90
new file mode 100644
index 0000000000000..d811e08cd84d4
--- /dev/null
+++ b/flang/test/Semantics/bug177601.f90
@@ -0,0 +1,80 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+module m
+  type :: tbps
+   contains
+    procedure, nopass :: fprocf, fprocs, ffunc1, ffunc2, ffunc3, fsub
+   end type
+ contains
+  function fprocf()
+    procedure(), pointer :: fprocf
+    fprocf => func
+  end
+  function fprocs()
+    procedure(), pointer :: fprocs
+    fprocs => sub
+  end
+  function ffunc1()
+    procedure(), pointer :: ffunc1
+    real ffunc1
+    ffunc1 => func
+  end
+  function ffunc2()
+    procedure(real), pointer :: ffunc2
+    ffunc2 => func
+  end
+  function ffunc3()
+    procedure(func), pointer :: ffunc3
+    ffunc3 => func
+  end
+  function fsub()
+    procedure(sub), pointer :: fsub
+    fsub => sub
+  end
+  subroutine sub
+  end
+  function func()
+    func = 0.
+  end
+end
+
+program p
+  use m
+  type(tbps) :: x
+  procedure(), pointer :: gp
+  procedure(real), pointer :: rfp
+  procedure(sub), pointer :: sp
+  gp => x%fprocf() ! procedure() always ok to assign any procedure to
+  gp => x%fprocs()
+  gp => x%ffunc1()
+  gp => x%ffunc2()
+  gp => x%ffunc3()
+  gp => x%fsub()
+  rfp => x%fprocf() ! can be assigned a procedure() function result
+  rfp => x%fprocs() ! can be assigned a procedure() function result
+  rfp => x%ffunc1()
+  rfp => x%ffunc2()
+  rfp => x%ffunc3()
+  !ERROR: Procedure pointer 'rfp' associated with result of reference to function 'fsub' that is an incompatible procedure pointer: incompatible procedures: one is a function, the other a subroutine
+  rfp => x%fsub()
+  sp => x%fprocf() ! can be assigned a procedure() function result
+  sp => x%fprocs() ! can be assigned a procedure() function result
+  !ERROR: Procedure pointer 'sp' associated with result of reference to function 'ffunc1' that is an incompatible procedure pointer: incompatible procedures: one is a function, the other a subroutine
+  sp => x%ffunc1()
+  !ERROR: Procedure pointer 'sp' associated with result of reference to function 'ffunc2' that is an incompatible procedure pointer: incompatible procedures: one is a function, the other a subroutine
+  sp => x%ffunc2()
+  !ERROR: Procedure pointer 'sp' associated with result of reference to function 'ffunc3' that is an incompatible procedure pointer: incompatible procedures: one is a function, the other a subroutine
+  sp => x%ffunc3()
+  sp => x%fsub()
+  !ERROR: Binding 'fprocf' is not a subroutine
+  call x%fprocf()
+  !ERROR: Binding 'fprocs' is not a subroutine
+  call x%fprocs()
+  !ERROR: Binding 'ffunc1' is not a subroutine
+  call x%ffunc1()
+  !ERROR: Binding 'ffunc2' is not a subroutine
+  call x%ffunc2()
+  !ERROR: Binding 'ffunc3' is not a subroutine
+  call x%ffunc3()
+  !ERROR: Binding 'fsub' is not a subroutine
+  call x%fsub()
+end