[flang-commits] [flang] 3ac0078 - [flang] Fix crash on erroneous program (#123843)

[via flang-commits]

Author: Peter Klausler
Date: 2025-01-27T08:55:56-08:00
New Revision: 3ac00784ac3cd8b435c0c6be36f81f786ca5e489

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

LOG: [flang] Fix crash on erroneous program (#123843)

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 https://github.com/llvm/llvm-project/issues/123538.

Added: 
    flang/test/Semantics/bug123538.f90

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

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 0d690803c36dca..695c8265293a80 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -8630,8 +8630,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.
@@ -8642,8 +8645,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