[flang] Address review comments

Original-commit: flang-compiler/f18@59e5565cb87eebd2c4f44defd22484ca83777942
Reviewed-on: https://github.com/flang-compiler/f18/pull/926
Tree-same-pre-rewrite: false

diff --git a/flang/documentation/Extensions.md b/flang/documentation/Extensions.md
index d81fa62..ad58469 100644 (file)
--- a/flang/documentation/Extensions.md
+++ b/flang/documentation/Extensions.md
@@ -25,6 +25,9 @@ Intentional violations of the standard
   `SIZE` that (as mentioned below) may return non-default
   `INTEGER` results by default to be passed.  A warning is
   emitted when truncation is possible.
+* We are not strict on the contents of `BLOCK DATA` subprograms
+  so long as they contain no executable code, no internal subprograms,
+  and allocate no storage outside a named `COMMON` block.  (C1415)
 
 Extensions, deletions, and legacy features supported by default
 ===============================================================

diff --git a/flang/lib/evaluate/check-expression.cc b/flang/lib/evaluate/check-expression.cc
index 304a8f3..d9b81bd 100644 (file)
--- a/flang/lib/evaluate/check-expression.cc
+++ b/flang/lib/evaluate/check-expression.cc
@@ -30,7 +30,7 @@ public:
     return IsKindTypeParameter(inq.parameter());
   }
   bool operator()(const semantics::Symbol &symbol) const {
-    return IsNamedConstant(symbol);
+    return IsNamedConstant(symbol) || IsImpliedDoIndex(symbol);
   }
   bool operator()(const CoarrayRef &) const { return false; }
   bool operator()(const semantics::ParamValue &param) const {

diff --git a/flang/lib/semantics/check-declarations.cc b/flang/lib/semantics/check-declarations.cc
index 21c5d49..3791735 100644 (file)
--- a/flang/lib/semantics/check-declarations.cc
+++ b/flang/lib/semantics/check-declarations.cc
@@ -17,7 +17,6 @@
 #include "../evaluate/check-expression.h"
 #include "../evaluate/fold.h"
 #include "../evaluate/tools.h"
-#include <algorithm>
 
 namespace Fortran::semantics {
 
@@ -1041,6 +1040,10 @@ void CheckHelper::CheckEquivalenceSet(const EquivalenceSet &) {
 
 void CheckHelper::CheckBlockData(const Scope &scope) {
   // BLOCK DATA subprograms should contain only named common blocks.
+  // C1415 presents a list of statements that shouldn't appear in
+  // BLOCK DATA, but so long as the subprogram contains no executable
+  // code and allocates no storage outside named COMMON, we're happy
+  // (e.g., an ENUM is strictly not allowed).
   for (const auto &pair : scope) {
     const Symbol &symbol{*pair.second};
     if (!(symbol.has<CommonBlockDetails>() || symbol.has<UseDetails>() ||

diff --git a/flang/lib/semantics/check-return.cc b/flang/lib/semantics/check-return.cc
index 158a337..9f7c93b 100644 (file)
--- a/flang/lib/semantics/check-return.cc
+++ b/flang/lib/semantics/check-return.cc
@@ -37,9 +37,6 @@ void ReturnStmtChecker::Leave(const parser::ReturnStmt &returnStmt) {
             "RETURN with expression is only allowed in SUBROUTINE subprogram"_err_en_US);
       }
     }
-  } else {
-    context_.Say(
-        "RETURN must be in the inclusive scope of a subprogram"_err_en_US);
   }
 }
 

diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc
index 232f405..a4631ba 100644 (file)
--- a/flang/lib/semantics/resolve-names.cc
+++ b/flang/lib/semantics/resolve-names.cc
@@ -661,7 +661,7 @@ public:
   bool BeginSubprogram(
       const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
   bool BeginMpSubprogram(const parser::Name &);
-  Symbol &PushBlockDataScope(const parser::Name &);
+  void PushBlockDataScope(const parser::Name &);
   void EndSubprogram();
 
 protected:
@@ -2790,7 +2790,7 @@ Symbol &SubprogramVisitor::PushSubprogramScope(
   return *symbol;
 }
 
-Symbol &SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
+void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
   if (auto *prev{FindSymbol(name)}) {
     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
       if (prev->test(Symbol::Flag::Subroutine) ||
@@ -2801,9 +2801,7 @@ Symbol &SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
       EraseSymbol(name);
     }
   }
-  Symbol &symbol{MakeSymbol(name, SubprogramDetails{})};
-  PushScope(Scope::Kind::BlockData, &symbol);
-  return symbol;
+  PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
 }
 
 // If name is a generic, return specific subprogram with the same name.
@@ -4979,7 +4977,7 @@ bool ResolveNamesVisitor::Pre(const parser::ImportStmt &x) {
       return false;
     }
     break;
-  case Scope::Kind::BlockData:
+  case Scope::Kind::BlockData:  // C1415 (in part)
     Say("IMPORT is not allowed in a BLOCK DATA subprogram"_err_en_US);
     return false;
   default:;

diff --git a/flang/lib/semantics/tools.h b/flang/lib/semantics/tools.h
index 257dbb2..6717914 100644 (file)
--- a/flang/lib/semantics/tools.h
+++ b/flang/lib/semantics/tools.h
@@ -143,6 +143,9 @@ inline bool IsIntentOut(const Symbol &symbol) {
 inline bool IsProtected(const Symbol &symbol) {
   return symbol.attrs().test(Attr::PROTECTED);
 }
+inline bool IsImpliedDoIndex(const Symbol &symbol) {
+  return symbol.owner().kind() == Scope::Kind::ImpliedDos;
+}
 bool IsFinalizable(const Symbol &);
 bool IsFinalizable(const DerivedTypeSpec &);
 bool HasImpureFinal(const DerivedTypeSpec &);

diff --git a/flang/test/semantics/block-data01.f90 b/flang/test/semantics/block-data01.f90
index c605ff3..86071f9 100644 (file)
--- a/flang/test/semantics/block-data01.f90
+++ b/flang/test/semantics/block-data01.f90
@@ -1,4 +1,7 @@
+! Test BLOCK DATA subprogram (14.3)
 block data foo
+  !ERROR: IMPORT is not allowed in a BLOCK DATA subprogram
+  import
   real :: pi = asin(-1.0) ! ok
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: notInCommon = 1