diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -3353,17 +3353,20 @@ if (!symbol) { context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US, x.GetSource()); - } else if (auto *subp{symbol->detailsIf()}) { - auto *msg{context_.SayAt(x, - "Assignment to subprogram '%s' is not allowed"_err_en_US, - symbol->name())}; - if (subp->isFunction()) { - const auto &result{subp->result().name()}; - msg->Attach(result, "Function result is '%s'"_en_US, result); + } else if (IsProcedure(*symbol)) { + if (auto *msg{context_.SayAt(x, + "Assignment to procedure '%s' is not allowed"_err_en_US, + symbol->name())}) { + if (auto *subp{symbol->detailsIf()}) { + if (subp->isFunction()) { + const auto &result{subp->result().name()}; + msg->Attach(result, "Function result is '%s'"_en_US, result); + } + } } } else { - context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US, - symbol->name()); + context_.SayAt( + x, "Assignment to '%s' is not allowed"_err_en_US, symbol->name()); } } fatalErrors_ = true; diff --git a/flang/test/Semantics/assign04.f90 b/flang/test/Semantics/assign04.f90 --- a/flang/test/Semantics/assign04.f90 +++ b/flang/test/Semantics/assign04.f90 @@ -117,15 +117,22 @@ end subroutine s8 - !ERROR: Assignment to subprogram 's8' is not allowed + !ERROR: Assignment to procedure 's8' is not allowed s8 = 1.0 end real function f9() result(r) - !ERROR: Assignment to subprogram 'f9' is not allowed + !ERROR: Assignment to procedure 'f9' is not allowed f9 = 1.0 end +subroutine s9 + real f9a + !ERROR: Assignment to procedure 'f9a' is not allowed + f9a = 1.0 + print *, f9a(1) +end + !ERROR: No explicit type declared for dummy argument 'n' subroutine s10(a, n) implicit none