[flang] Fix crash on erroneous program

[klausler]

Catch and report multiple initializations of the same procedure pointer rather than assuming that control wouldn't reach a given point in name resolution in that case.

Fixes #123538.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

Catch and report multiple initializations of the same procedure pointer rather than assuming that control wouldn't reach a given point in name resolution in that case.

Fixes #123538.

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/resolve-names.cpp (+6-4)
• (added) flang/test/Semantics/bug123538.f90 (+7)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index f3c2a5bf094d04..4fc0b35d914034 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8419,8 +8419,11 @@ void DeclarationVisitor::PointerInitialization(
     if (!context().HasError(ultimate)) {
       if (IsProcedurePointer(ultimate)) {
         auto &details{ultimate.get<ProcEntityDetails>()};
-        CHECK(!details.init());
-        if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
+        if (details.init()) {
+          Say(name, "'%s' was previously initialized"_err_en_US);
+          context().SetError(ultimate);
+        } else if (const auto *targetName{
+                       std::get_if<parser::Name>(&target.u)}) {
           Walk(target);
           if (!CheckUseError(*targetName) && targetName->symbol) {
             // Validation is done in declaration checking.
@@ -8431,8 +8434,7 @@ void DeclarationVisitor::PointerInitialization(
         }
       } else {
         Say(name,
-            "'%s' is not a procedure pointer but is initialized "
-            "like one"_err_en_US);
+            "'%s' is not a procedure pointer but is initialized like one"_err_en_US);
         context().SetError(ultimate);
       }
     }
diff --git a/flang/test/Semantics/bug123538.f90 b/flang/test/Semantics/bug123538.f90
new file mode 100644
index 00000000000000..2245abe3829e2c
--- /dev/null
+++ b/flang/test/Semantics/bug123538.f90
@@ -0,0 +1,7 @@
+!RUN: %python %S/test_errors.py %s %flang_fc1
+procedure(), pointer :: pp => tan
+!ERROR: EXTERNAL attribute was already specified on 'pp'
+!ERROR: POINTER attribute was already specified on 'pp'
+!ERROR: 'pp' was previously initialized
+procedure(real), pointer :: pp => tan
+end

[jeanPerier]

LGTM

[jeanPerier]

If there is an easy way, it would be nice to point at the previous initialization in an attachment (but If I am understanding details.init() correctly, you probably do not have that info here).

[klausler]

I think the previous location is no longer available at this point; I couldn't figure out a way to find it, anyway.