[flang-commits] [flang] 1f17a89 - [flang] Add one missed semantic check for named constant in common block

[via flang-commits]

Author: PeixinQiao
Date: 2022-06-09T00:43:30+08:00
New Revision: 1f17a8978c32af4b65615d32f367c341bacb4770

URL: https://github.com/llvm/llvm-project/commit/1f17a8978c32af4b65615d32f367c341bacb4770
DIFF: https://github.com/llvm/llvm-project/commit/1f17a8978c32af4b65615d32f367c341bacb4770.diff

LOG: [flang] Add one missed semantic check for named constant in common block

As Fortran 2018 R874, common block object must be one variable name, which
cannot be one named constant. Add this check.

Reviewed By: klausler

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/declarations01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 4c34392ecdc8..a1a3e53801b2 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5341,6 +5341,9 @@ void DeclarationVisitor::CheckCommonBlocks() {
     } else if (attrs.test(Attr::BIND_C)) {
       Say(name,
           "Variable '%s' with BIND attribute may not appear in a COMMON block"_err_en_US);
+    } else if (IsNamedConstant(*symbol)) {
+      Say(name,
+          "A named constant '%s' may not appear in a COMMON block"_err_en_US);
     } else if (IsDummy(*symbol)) {
       Say(name,
           "Dummy argument '%s' may not appear in a COMMON block"_err_en_US);

diff  --git a/flang/test/Semantics/declarations01.f90 b/flang/test/Semantics/declarations01.f90
index f3673a7ed0d1..77cb6b4f1fef 100644
--- a/flang/test/Semantics/declarations01.f90
+++ b/flang/test/Semantics/declarations01.f90
@@ -4,5 +4,10 @@
 function f1() result(x)
   !ERROR: A function result may not also be a named constant
   integer, parameter :: x = 1
-end
 
+  integer, parameter :: x2 = 1
+  integer :: x3
+  !ERROR: A named constant 'x2' may not appear in a COMMON block
+  common /blk/ x2, x3
+
+end