[flang-commits] [flang] 63a2987 - [flang] Allow initialization in blank COMMON

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-01-13T15:07:37-08:00
New Revision: 63a2987d51111d33232f49d1551b2404f121d3b8

URL: https://github.com/llvm/llvm-project/commit/63a2987d51111d33232f49d1551b2404f121d3b8
DIFF: https://github.com/llvm/llvm-project/commit/63a2987d51111d33232f49d1551b2404f121d3b8.diff

LOG: [flang] Allow initialization in blank COMMON

This is nonconformant usage, but widely accepted as an extension.
Downgrade the error message to a warning.

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

Added: 
    flang/test/Semantics/data14.f90

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/check-data.cpp
    flang/test/Semantics/data04.f90

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index a563d8b64d06..5537bf487742 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -196,6 +196,7 @@ end
   exactly one is unlimited polymorphic).
 * External unit 0 is predefined and connected to the standard error output,
   and defined as `ERROR_UNIT` in the intrinsic `ISO_FORTRAN_ENV` module.
+* Objects in blank COMMON may be initialized.
 
 ### Extensions supported when enabled by options
 

diff  --git a/flang/lib/Semantics/check-data.cpp b/flang/lib/Semantics/check-data.cpp
index bd8d836cf352..fac8d9949a9a 100644
--- a/flang/lib/Semantics/check-data.cpp
+++ b/flang/lib/Semantics/check-data.cpp
@@ -63,7 +63,6 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
                 : IsFunctionResult(symbol)     ? "Function result"
                 : IsAllocatable(symbol)        ? "Allocatable"
                 : IsInitialized(symbol, true)  ? "Default-initialized"
-                : IsInBlankCommon(symbol)      ? "Blank COMMON object"
                 : IsProcedure(symbol) && !IsPointer(symbol) ? "Procedure"
                 // remaining checks don't apply to components
                 : !isFirstSymbol                   ? nullptr
@@ -77,11 +76,17 @@ class DataVarChecker : public evaluate::AllTraverse<DataVarChecker, true> {
           "%s '%s' must not be initialized in a DATA statement"_err_en_US,
           whyNot, symbol.name());
       return false;
-    } else if (IsProcedurePointer(symbol)) {
+    }
+    if (IsProcedurePointer(symbol)) {
       context_.Say(source_,
           "Procedure pointer '%s' in a DATA statement is not standard"_en_US,
           symbol.name());
     }
+    if (IsInBlankCommon(symbol)) {
+      context_.Say(source_,
+          "Blank COMMON object '%s' in a DATA statement is not standard"_en_US,
+          symbol.name());
+    }
     return true;
   }
   bool operator()(const evaluate::Component &component) {

diff  --git a/flang/test/Semantics/data04.f90 b/flang/test/Semantics/data04.f90
index b89078fc5e10..aa085feb3a14 100644
--- a/flang/test/Semantics/data04.f90
+++ b/flang/test/Semantics/data04.f90
@@ -134,19 +134,8 @@ subroutine checkDerivedType(m2_number)
 
   program new
     use m2
-    integer a
-    real    b,c
-    type seqType
-      sequence
-      integer number
-    end type
-    type(SeqType) num
-    COMMON b,a,c,num
     type(newType) m2_number2
     !C876
-    !ERROR: Blank COMMON object 'b' must not be initialized in a DATA statement
-    DATA b /1/
-    !C876
     !ERROR: USE-associated object 'm2_i' must not be initialized in a DATA statement
     DATA m2_i /1/
     !C876
@@ -155,7 +144,4 @@ program new
     !C876
     !OK: m2_number2 is not associated through use association
     DATA m2_number2%number /1/
-    !C876
-    !ERROR: Blank COMMON object 'num' must not be initialized in a DATA statement
-    DATA num%number /1/
   end program

diff  --git a/flang/test/Semantics/data14.f90 b/flang/test/Semantics/data14.f90
new file mode 100644
index 000000000000..2e8c39508d92
--- /dev/null
+++ b/flang/test/Semantics/data14.f90
@@ -0,0 +1,16 @@
+! RUN: %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+! Verify varnings on nonconforming DATA statements
+! As a common extension, C876 violations are not errors.
+program main
+  type :: seqType
+    sequence
+    integer :: number
+  end type
+  type(seqType) :: x
+  integer :: j
+  common j, x, y
+  !CHECK: Blank COMMON object 'j' in a DATA statement is not standard
+  data j/1/
+  !CHECK: Blank COMMON object 'x' in a DATA statement is not standard
+  data x%number/2/
+end