[flang-commits] [flang] 07f2cd6 - [flang] Improve error message for attempted assignment to a procedure

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-08-18T15:17:52-07:00
New Revision: 07f2cd6d04180d0720e41da1715fcc53c5e07744

URL: https://github.com/llvm/llvm-project/commit/07f2cd6d04180d0720e41da1715fcc53c5e07744
DIFF: https://github.com/llvm/llvm-project/commit/07f2cd6d04180d0720e41da1715fcc53c5e07744.diff

LOG: [flang] Improve error message for attempted assignment to a procedure

Emit a "Assignment to procedure 'foo' is not allowed" error message
for more cases of 'foo' than just declaraed subprograms, rather than
assuming that those additional cases were named constants.

Differential Revision: https://reviews.llvm.org/D132165

Added: 
    

Modified: 
    flang/lib/Semantics/expression.cpp
    flang/test/Semantics/assign04.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 39f3fb8bfc0b..37b2d6354231 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3353,17 +3353,20 @@ void ArgumentAnalyzer::Analyze(const parser::Variable &x) {
     if (!symbol) {
       context_.SayAt(x, "Assignment to constant '%s' is not allowed"_err_en_US,
           x.GetSource());
-    } else if (auto *subp{symbol->detailsIf<semantics::SubprogramDetails>()}) {
-      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<semantics::SubprogramDetails>()}) {
+          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
index 064cb0aa868c..a34d5987ad42 100644
--- a/flang/test/Semantics/assign04.f90
+++ b/flang/test/Semantics/assign04.f90
@@ -117,15 +117,22 @@ subroutine s7
 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