[flang] Warn about automatic data in main program, disallow in BLOCK … (llvm#102045)

…DATA

We allow automatic data objects in the specification part of the main
program; add an optional portability warning and documentation. Don't
allow them in BLOCK DATA. They're already disallowed as module
variables.

Author: klausler

flang/docs/Extensions.md

@@ -384,6 +384,8 @@ end
 * `BIND(C, NAME="...", CDEFINED)` signifies that the storage for an
   interoperable variable will be allocated outside of Fortran,
   probably by a C or C++ external definition.
+* An automatic data object may be declared in the specification part
+  of the main program.
 
 ### Extensions supported when enabled by options
 

flang/include/flang/Common/Fortran-features.h

@@ -51,7 +51,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     BadBranchTarget, ConvertedArgument, HollerithPolymorphic, ListDirectedSize,
     NonBindCInteroperability, CudaManaged, CudaUnified,
     PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
-    UndefinableAsynchronousOrVolatileActual)
+    UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram)
 
 // Portability and suspicious usage warnings
 ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,

flang/lib/Semantics/check-declarations.cpp

@@ -247,6 +247,14 @@ void CheckHelper::Check(
   }
 }
 
+static bool IsBlockData(const Scope &scope) {
+  return scope.kind() == Scope::Kind::BlockData;
+}
+
+static bool IsBlockData(const Symbol &symbol) {
+  return symbol.scope() && IsBlockData(*symbol.scope());
+}
+
 void CheckHelper::Check(const Symbol &symbol) {
   if (symbol.name().size() > common::maxNameLen &&
       &symbol == &symbol.GetUltimate()) {
@@ -463,6 +471,23 @@ void CheckHelper::Check(const Symbol &symbol) {
       messages_.Say(
           "Automatic data object '%s' may not appear in a module"_err_en_US,
           symbol.name());
+    } else if (IsBlockData(symbol.owner())) {
+      messages_.Say(
+          "Automatic data object '%s' may not appear in a BLOCK DATA subprogram"_err_en_US,
+          symbol.name());
+    } else if (symbol.owner().kind() == Scope::Kind::MainProgram) {
+      if (context_.IsEnabled(common::LanguageFeature::AutomaticInMainProgram)) {
+        if (context_.ShouldWarn(
+                common::LanguageFeature::AutomaticInMainProgram)) {
+          messages_.Say(
+              "Automatic data object '%s' should not appear in the specification part of a main program"_port_en_US,
+              symbol.name());
+        }
+      } else {
+        messages_.Say(
+            "Automatic data object '%s' may not appear in the specification part of a main program"_err_en_US,
+            symbol.name());
+      }
     }
   }
   if (IsProcedure(symbol)) {
@@ -2799,10 +2824,6 @@ static bool IsSubprogramDefinition(const Symbol &symbol) {
       symbol.scope()->kind() == Scope::Kind::Subprogram;
 }
 
-static bool IsBlockData(const Symbol &symbol) {
-  return symbol.scope() && symbol.scope()->kind() == Scope::Kind::BlockData;
-}
-
 static bool IsExternalProcedureDefinition(const Symbol &symbol) {
   return IsBlockData(symbol) ||
       (IsSubprogramDefinition(symbol) &&

flang/test/Semantics/resolve77.f90

@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
 ! Tests valid and invalid usage of forward references to procedures
 ! in specification expressions.
 module m
@@ -56,3 +56,16 @@ pure integer function if2(n)
     if2 = n
   end function
 end subroutine
+
+block data
+  common /blk2/ n
+  data n/100/
+  !ERROR: Automatic data object 'a' may not appear in a BLOCK DATA subprogram
+  real a(n)
+end
+
+program main
+  common /blk2/ n
+  !PORTABILITY: Automatic data object 'a' should not appear in the specification part of a main program
+  real a(n)
+end

flang/test/Semantics/stmt-func01.f90

@@ -10,6 +10,7 @@ program main
     pure integer function ifunc()
     end function
   end interface
+  !PORTABILITY: Automatic data object 'x1' should not appear in the specification part of a main program
   type(t1(k=4,l=ifunc())) x1
   !PORTABILITY: Statement function 'sf1' should not contain an array constructor
   sf1(n) = sum([(j,j=1,n)])