diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index f3c2a5bf094d0..4fc0b35d91403 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()}; - CHECK(!details.init()); - if (const auto *targetName{std::get_if(&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(&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 0000000000000..2245abe3829e2 --- /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