Thanks to visit codestin.com
Credit goes to github.com

Skip to content

Conversation

klausler
Copy link
Contributor

@klausler klausler commented May 9, 2025

Fixes #138915.

@llvmbot llvmbot added flang Flang issues not falling into any other category flang:semantics labels May 9, 2025
@llvmbot
Copy link
Member

llvmbot commented May 9, 2025

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Fixes #138915.


Full diff: https://github.com/llvm/llvm-project/pull/139325.diff

3 Files Affected:

  • (modified) flang/lib/Evaluate/tools.cpp (+8-10)
  • (modified) flang/lib/Semantics/check-declarations.cpp (+9-3)
  • (added) flang/test/Semantics/bug138915.f90 (+15)
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 702711e3cff53..865020e050b03 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1196,16 +1196,6 @@ parser::Message *AttachDeclaration(
       const auto *assoc{unhosted->detailsIf<semantics::HostAssocDetails>()}) {
     unhosted = &assoc->symbol();
   }
-  if (const auto *binding{
-          unhosted->detailsIf<semantics::ProcBindingDetails>()}) {
-    if (binding->symbol().name() != symbol.name()) {
-      message.Attach(binding->symbol().name(),
-          "Procedure '%s' of type '%s' is bound to '%s'"_en_US, symbol.name(),
-          symbol.owner().GetName().value(), binding->symbol().name());
-      return &message;
-    }
-    unhosted = &binding->symbol();
-  }
   if (const auto *use{symbol.detailsIf<semantics::UseDetails>()}) {
     message.Attach(use->location(),
         "'%s' is USE-associated with '%s' in module '%s'"_en_US, symbol.name(),
@@ -1214,6 +1204,14 @@ parser::Message *AttachDeclaration(
     message.Attach(
         unhosted->name(), "Declaration of '%s'"_en_US, unhosted->name());
   }
+  if (const auto *binding{
+          unhosted->detailsIf<semantics::ProcBindingDetails>()}) {
+    if (binding->symbol().name() != symbol.name()) {
+      message.Attach(binding->symbol().name(),
+          "Procedure '%s' of type '%s' is bound to '%s'"_en_US, symbol.name(),
+          symbol.owner().GetName().value(), binding->symbol().name());
+    }
+  }
   return &message;
 }
 
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 318085518cc57..94258444cf7ef 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2555,6 +2555,9 @@ void CheckHelper::CheckProcBinding(
     const Symbol &symbol, const ProcBindingDetails &binding) {
   const Scope &dtScope{symbol.owner()};
   CHECK(dtScope.kind() == Scope::Kind::DerivedType);
+  bool isInaccessibleDeferred{false};
+  const Symbol *overridden{
+      FindOverriddenBinding(symbol, isInaccessibleDeferred)};
   if (symbol.attrs().test(Attr::DEFERRED)) {
     if (const Symbol *dtSymbol{dtScope.symbol()}) {
       if (!dtSymbol->attrs().test(Attr::ABSTRACT)) { // C733
@@ -2568,6 +2571,11 @@ void CheckHelper::CheckProcBinding(
           "Type-bound procedure '%s' may not be both DEFERRED and NON_OVERRIDABLE"_err_en_US,
           symbol.name());
     }
+    if (overridden && !overridden->attrs().test(Attr::DEFERRED)) {
+      SayWithDeclaration(*overridden,
+          "Override of non-DEFERRED '%s' must not be DEFERRED"_err_en_US,
+          symbol.name());
+    }
   }
   if (binding.symbol().attrs().test(Attr::INTRINSIC) &&
       !context_.intrinsics().IsSpecificIntrinsicFunction(
@@ -2576,9 +2584,7 @@ void CheckHelper::CheckProcBinding(
         "Intrinsic procedure '%s' is not a specific intrinsic permitted for use in the definition of binding '%s'"_err_en_US,
         binding.symbol().name(), symbol.name());
   }
-  bool isInaccessibleDeferred{false};
-  if (const Symbol *
-      overridden{FindOverriddenBinding(symbol, isInaccessibleDeferred)}) {
+  if (overridden) {
     if (isInaccessibleDeferred) {
       SayWithDeclaration(*overridden,
           "Override of PRIVATE DEFERRED '%s' must appear in its module"_err_en_US,
diff --git a/flang/test/Semantics/bug138915.f90 b/flang/test/Semantics/bug138915.f90
new file mode 100644
index 0000000000000..786a4ac2d930b
--- /dev/null
+++ b/flang/test/Semantics/bug138915.f90
@@ -0,0 +1,15 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+module m
+  type base
+   contains
+     procedure, nopass :: tbp
+  end type
+  type, extends(base), abstract :: child
+   contains
+     !ERROR: Override of non-DEFERRED 'tbp' must not be DEFERRED
+     procedure(tbp), deferred, nopass :: tbp
+  end type
+ contains
+  subroutine tbp
+  end
+end

Copy link
Contributor

@DanielCChen DanielCChen left a comment

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

LGTM.
It fixed our test case.
Thanks!

@klausler klausler merged commit 8fc1a64 into llvm:main May 12, 2025
14 checks passed
@klausler klausler deleted the bug138915 branch May 12, 2025 19:27
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
flang:semantics flang Flang issues not falling into any other category
Projects
None yet
Development

Successfully merging this pull request may close these issues.

[flang] Missing diagnostic on missing DEFERRED attribute
5 participants