[flang] Fix bug accessing implicit variable in specification expression

[tskeith]

Summary

A specification expression can reference an implicitly declared variable
in the host procedure. Because we have to process specification parts
before execution parts, this may be the first time we encounter the
variable. We were assuming the variable was implicitly declared in the
scope where it was encountered, leading to an error because local
variables may not be referenced in specification expressions.

The fix is to tentatively create the implicit variable in the host
procedure because that is the only way the specification expression can
be valid. We mark it with the flag ImplicitOrError to indicate that
either it must be implicitly defined in the host (by being mentioned in
the execution part) or else its use turned out to be an error.
We need to apply the implicit type rules of the host, which requires
some changes to implicit typing.

Variables in common blocks are allowed to appear in specification expressions
(because they are not locals) but the common block definition may not appear
until after their use. To handle this we create common block symbols and object
entities for each common block object during the PreSpecificationConstruct
pass. This allows us to remove the corresponding code in the main visitor and
commonBlockInfo_.curr. The change in order of processing causes some
different error messages to be emitted.

Some cleanup is included with this change:

• In ExpressionAnalyzer, if an unresolved name is encountered but no error has been reported, emit an internal error.
• Change ImplicitRulesVisitor to hide the ImplicitRules object that implements it. Change the interface to pass in names rather than having to get the first character of the name.
• Change DeclareObjectEntity to have the attrs argument default to an empty set; that is the typical case.
• In Pre(parser::SpecificationPart) use "structured bindings" to give names to the pieces that make up a specification-part.
• Enhance parser::Unwrap to unwrap Statement and UnlabeledStatement and make use of that in PreSpecificationConstruct.

[PeteSteinfeld]

All builds, tests, and looks good.

[klausler]

flang/include/flang/Semantics/symbol.h

486

"implicitly typed"

flang/lib/Semantics/check-declarations.cpp

770

"implicitly typed" might be better here too.

flang/lib/Semantics/resolve-names.cpp

1938

Consider adding a "while" predicate to this loop. It'll never be false, but it would remove the need for the reader to have to think about it.

5474

Can some of this logic be simplified if the internal procedure or the host has IMPLICIT NONE? Or maybe I'm missing out on how it works. But it seems like we need these new features only when neither scope has IMPLICIT NONE.

5998

Instead of using a new flag here, you could declare the common block's symbol and point the block's objects to it.

flang/test/Semantics/block-data01.f90

10–12

Is the old error message now dead? Maybe there's useless code that can be cleaned out from check-declarations.cpp.

flang/test/Semantics/implicit11.f90

53

Consider adding a test case with IMPLICIT NONE in the host procedure.

[tskeith]

Address review comments

Create common block symbol in PreSpecificationConstruct so that common
block objects can immediately be added to them. Remove the corresponding
code in the main visitor and commonBlockInfo_.curr. Eliminate the
InCommonBlock flag because the InCommonBlock function can replace it.
Move that function to tools.{h,cpp}.

Enhance parser::Unwrap to unwrap Statement and UnlabeledStatement and
make use of that in PreSpecificationConstruct.

[tskeith]

• Handle IMPLICIT NONE in host procedure

[tskeith]

flang/lib/Semantics/resolve-names.cpp

5474

If the internal procedure has IMPLICIT NONE but the host does not, we still need this. That's why we don't get an error on m in subroutine s1a in implicit11.f90.

I've changed this function to exit early when the host has IMPLICIT NONE.

5998

Yes, that's a better way to do it. Now it's all done in CreateCommonBlockSymbols and that allows the main visitor to be simplified.

flang/test/Semantics/block-data01.f90

10–12

It can still happen. I've added a new test that produces it.

flang/test/Semantics/implicit11.f90

53

Thanks -- I did that and it turned up another small change that was needed.

[klausler]

LGTM & thanks!

flang/include/flang/Parser/tools.h

struct UnwrapperHelper {
   static const A *Unwrap(const std::optional<B> &o) {
     if (o) {
       return Unwrap<A>(*o);
     } else {
       return nullptr;
     }
   }
 
+  template <typename A, typename B>
+  static const A *Unwrap(const UnlabeledStatement<B> &x) {
+    return Unwrap<A>(x.statement);
+  }
+  template <typename A, typename B>
+  static const A *Unwrap(const Statement<B> &x) {
+    return Unwrap<A>(x.statement);
+  }
+
   template <typename A, typename B> static const A *Unwrap(B &x) {
     if constexpr (std::is_same_v<std::decay_t<A>, std::decay_t<B>>) {
       return &x;
     } else if constexpr (ConstraintTrait<B>) {
       return Unwrap<A>(x.thing);
     } else if constexpr (WrapperTrait<B>) {
       return Unwrap<A>(x.v);
     } else if constexpr (UnionTrait<B>) {

flang/include/flang/Semantics/symbol.h

private:
   listType occurrences_;
 };
 
 // A symbol host-associated from an enclosing scope.
 class HostAssocDetails {
 public:
   HostAssocDetails(const Symbol &symbol) : symbol_{symbol} {}
   const Symbol &symbol() const { return symbol_; }
+  bool implicitOrSpecExprError{false};
+  bool implicitOrExplicitTypeError{false};
 
 private:
   SymbolRef symbol_;
 };
 
 // A GenericKind is one of: generic name, defined operator,
 // defined assignment, intrinsic operator, or defined I/O.
 struct GenericKind {

 class Symbol {
 public:
   ENUM_CLASS(Flag,
       Error, // an error has been reported on this symbol
       Function, // symbol is a function
       Subroutine, // symbol is a subroutine
       StmtFunction, // symbol is a statement function (Function is set too)
       Implicit, // symbol is implicitly typed
+      ImplicitOrError, // symbol must be implicitly typed or it's an error
       ModFile, // symbol came from .mod file
       ParentComp, // symbol is the "parent component" of an extended type
       CrayPointer, CrayPointee,
       LocalityLocal, // named in LOCAL locality-spec
       LocalityLocalInit, // named in LOCAL_INIT locality-spec
       LocalityShared, // named in SHARED locality-spec
       InDataStmt, // initialized in a DATA statement
-
       // OpenACC data-sharing attribute
       AccPrivate, AccFirstPrivate, AccShared,
       // OpenACC data-mapping attribute
       AccCopyIn, AccCopyOut, AccCreate, AccDelete, AccPresent,
       // OpenACC miscellaneous flags
       AccCommonBlock, AccThreadPrivate, AccReduction, AccNone, AccPreDetermined,
-
       // OpenMP data-sharing attribute
       OmpShared, OmpPrivate, OmpLinear, OmpFirstPrivate, OmpLastPrivate,
       // OpenMP data-mapping attribute
       OmpMapTo, OmpMapFrom, OmpMapAlloc, OmpMapRelease, OmpMapDelete,
       // OpenMP miscellaneous flags
       OmpCommonBlock, OmpReduction, OmpDeclareSimd, OmpDeclareTarget,
       OmpThreadprivate, OmpDeclareReduction, OmpFlushed, OmpCriticalLock,
       OmpIfSpecified, OmpNone, OmpPreDetermined);

flang/include/flang/Semantics/tools.h

 bool IsEventTypeOrLockType(const DerivedTypeSpec *);
 bool IsOrContainsEventOrLockComponent(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false);
 bool HasIntrinsicTypeName(const Symbol &);
 bool IsSeparateModuleProcedureInterface(const Symbol *);
 bool IsAutomatic(const Symbol &);
 bool HasAlternateReturns(const Symbol &);
+bool InCommonBlock(const Symbol &);
 
 // Return an ultimate component of type that matches predicate, or nullptr.
 const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
     const std::function<bool(const Symbol &)> &predicate);
 const Symbol *FindUltimateComponent(
     const Symbol &symbol, const std::function<bool(const Symbol &)> &predicate);
 
 // Returns an immediate component of type that matches predicate, or nullptr.

flang/lib/Semantics/check-declarations.cpp

void CheckPassArg(
       const Symbol &proc, const Symbol *interface, const WithPassArg &);
   void CheckProcBinding(const Symbol &, const ProcBindingDetails &);
   void CheckObjectEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckArraySpec(const Symbol &, const ArraySpec &);
   void CheckProcEntity(const Symbol &, const ProcEntityDetails &);
   void CheckSubprogram(const Symbol &, const SubprogramDetails &);
   void CheckAssumedTypeEntity(const Symbol &, const ObjectEntityDetails &);
   void CheckDerivedType(const Symbol &, const DerivedTypeDetails &);
+  void CheckHostAssoc(const Symbol &, const HostAssocDetails &);
   void CheckGeneric(const Symbol &, const GenericDetails &);
   std::optional<std::vector<Procedure>> Characterize(const SymbolVector &);
   bool CheckDefinedOperator(const SourceName &, const GenericKind &,
       const Symbol &, const Procedure &);
   std::optional<parser::MessageFixedText> CheckNumberOfArgs(
       const GenericKind &, std::size_t);
   bool CheckDefinedOperatorArg(
       const SourceName &, const Symbol &, const Procedure &, std::size_t);
void CheckHelper::Check(const Symbol &symbol) {
   const DerivedTypeSpec *derived{type ? type->AsDerived() : nullptr};
   auto restorer{messages_.SetLocation(symbol.name())};
   context_.set_location(symbol.name());
   bool isAssociated{symbol.has<UseDetails>() || symbol.has<HostAssocDetails>()};
   if (symbol.attrs().test(Attr::VOLATILE)) {
     CheckVolatile(symbol, isAssociated, derived);
   }
   if (isAssociated) {
-    return; // only care about checking VOLATILE on associated symbols
+    if (const auto *details{symbol.detailsIf<HostAssocDetails>()}) {
+      CheckHostAssoc(symbol, *details);
+    }
+    return; // no other checks on associated symbols
   }
   if (IsPointer(symbol)) {
     CheckPointer(symbol);
   }
   std::visit(
       common::visitors{
           [&](const ProcBindingDetails &x) { CheckProcBinding(symbol, x); },
           [&](const ObjectEntityDetails &x) { CheckObjectEntity(symbol, x); },
if (const DeclTypeSpec * parent{FindParentTypeSpec(symbol)}) {
     }
   }
   if (HasIntrinsicTypeName(symbol)) { // C729
     messages_.Say("A derived type name cannot be the name of an intrinsic"
                   " type"_err_en_US);
   }
 }
 
+void CheckHelper::CheckHostAssoc(
+    const Symbol &symbol, const HostAssocDetails &details) {
+  const Symbol &hostSymbol{details.symbol()};
+  if (hostSymbol.test(Symbol::Flag::ImplicitOrError)) {
+    if (details.implicitOrSpecExprError) {
+      messages_.Say("Implicitly typed local entity '%s' not allowed in"
+                    " specification expression"_err_en_US,
+          symbol.name());
+    } else if (details.implicitOrExplicitTypeError) {
+      messages_.Say(
+          "No explicit type declared for '%s'"_err_en_US, symbol.name());
+    }
+  }
+}
+
 void CheckHelper::CheckGeneric(
     const Symbol &symbol, const GenericDetails &details) {
   const SymbolVector &specifics{details.specificProcs()};
   const auto &bindingNames{details.bindingNames()};
   std::optional<std::vector<Procedure>> procs{Characterize(specifics)};
   if (!procs) {
     return;
   }

flang/lib/Semantics/compute-offsets.cpp

void ComputeOffsetsHelper::Compute(Scope &scope) {
   for (Scope &child : scope.children()) {
     Compute(child);
   }
   DoScope(scope);
   dependents_.clear();
   equivalenceBlock_.clear();
 }
 
-static bool InCommonBlock(const Symbol &symbol) {
-  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
-  return details && details->commonBlock();
-}
-
 void ComputeOffsetsHelper::DoScope(Scope &scope) {
   if (scope.symbol() && scope.IsParameterizedDerivedType()) {
     return; // only process instantiations of parameterized derived types
   }
   // Build dependents_ from equivalences: symbol -> symbol+offset
   for (const EquivalenceSet &set : scope.equivalenceSets()) {
     DoEquivalenceSet(set);
   }

flang/lib/Semantics/expression.cpp

static std::optional<Expr<SomeInteger>> MakeBareTypeParamInquiry(
   return std::nullopt;
 }
 
 // Names and named constants
 MaybeExpr ExpressionAnalyzer::Analyze(const parser::Name &n) {
   if (std::optional<int> kind{IsImpliedDo(n.source)}) {
     return AsMaybeExpr(ConvertToKind<TypeCategory::Integer>(
         *kind, AsExpr(ImpliedDoIndex{n.source})));
-  } else if (context_.HasError(n) || !n.symbol) {
+  } else if (context_.HasError(n)) {
+    return std::nullopt;
+  } else if (!n.symbol) {
+    SayAt(n, "Internal error: unresolved name '%s'"_err_en_US, n.source);
     return std::nullopt;
   } else {
     const Symbol &ultimate{n.symbol->GetUltimate()};
     if (ultimate.has<semantics::TypeParamDetails>()) {
       // A bare reference to a derived type parameter (within a parameterized
       // derived type definition)
       return AsMaybeExpr(MakeBareTypeParamInquiry(&ultimate));
     } else {

flang/lib/Semantics/resolve-names.cpp

ImplicitRules(SemanticsContext &context, ImplicitRules *parent)
       : parent_{parent}, context_{context} {
     inheritFromParent_ = parent != nullptr;
   }
   bool isImplicitNoneType() const;
   bool isImplicitNoneExternal() const;
   void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
   void set_isImplicitNoneExternal(bool x) { isImplicitNoneExternal_ = x; }
   void set_inheritFromParent(bool x) { inheritFromParent_ = x; }
-  // Get the implicit type for identifiers starting with ch. May be null.
-  const DeclTypeSpec *GetType(char ch) const;
+  // Get the implicit type for this name. May be null.
+  const DeclTypeSpec *GetType(SourceName) const;
   // Record the implicit type for the range of characters [fromLetter,
   // toLetter].
   void SetTypeMapping(const DeclTypeSpec &type, parser::Location fromLetter,
       parser::Location toLetter);
 
 private:
   static char Incr(char ch);
 
public:
   using ImplicitNoneNameSpec = parser::ImplicitStmt::ImplicitNoneNameSpec;
 
   void Post(const parser::ParameterStmt &);
   bool Pre(const parser::ImplicitStmt &);
   bool Pre(const parser::LetterSpec &);
   bool Pre(const parser::ImplicitSpec &);
   void Post(const parser::ImplicitSpec &);
 
-  ImplicitRules &implicitRules() { return *implicitRules_; }
-  const ImplicitRules &implicitRules() const { return *implicitRules_; }
+  const DeclTypeSpec *GetType(SourceName name) {
+    return implicitRules_->GetType(name);
+  }
   bool isImplicitNoneType() const {
-    return implicitRules().isImplicitNoneType();
+    return implicitRules_->isImplicitNoneType();
+  }
+  bool isImplicitNoneType(const Scope &scope) const {
+    return implicitRulesMap_->at(&scope).isImplicitNoneType();
   }
   bool isImplicitNoneExternal() const {
-    return implicitRules().isImplicitNoneExternal();
+    return implicitRules_->isImplicitNoneExternal();
+  }
+  void set_inheritFromParent(bool x) {
+    implicitRules_->set_inheritFromParent(x);
   }
 
 protected:
   void BeginScope(const Scope &);
   void SetScope(const Scope &);
 
 private:
   // implicit rules in effect for current scope

 
 // Manage a stack of Scopes
 class ScopeHandler : public ImplicitRulesVisitor {
 public:
   using ImplicitRulesVisitor::Post;
   using ImplicitRulesVisitor::Pre;
 
   Scope &currScope() { return DEREF(currScope_); }
+  // The enclosing host procedure if current scope is in an internal procedure
+  Scope *GetHostProcedure();
   // The enclosing scope, skipping blocks and derived types.
   // TODO: Will return the scope of a FORALL or implied DO loop; is this ok?
   // If not, should call FindProgramUnitContaining() instead.
   Scope &InclusiveScope();
   // The enclosing scope, skipping derived types.
   Scope &NonDerivedTypeScope();
 
   // Create a new scope and push it on the scope stack.
protected:
   bool ConvertToObjectEntity(Symbol &);
   bool ConvertToProcEntity(Symbol &);
 
   const DeclTypeSpec &MakeNumericType(
       TypeCategory, const std::optional<parser::KindSelector> &);
   const DeclTypeSpec &MakeLogicalType(
       const std::optional<parser::KindSelector> &);
 
+  bool inExecutionPart_{false};
+
 private:
   Scope *currScope_{nullptr};
 };
 
 class ModuleVisitor : public virtual ScopeHandler {
 public:
   bool Pre(const parser::AccessStmt &);
   bool Pre(const parser::Only &);
bool BeginSubprogram(
       const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
   bool BeginMpSubprogram(const parser::Name &);
   void PushBlockDataScope(const parser::Name &);
   void EndSubprogram();
 
 protected:
   // Set when we see a stmt function that is really an array element assignment
   bool badStmtFuncFound_{false};
-  bool inExecutionPart_{false};
 
 private:
   // Info about the current function: parse tree of the type in the PrefixSpec;
   // name and symbol of the function result from the Suffix; source location.
   struct {
     const parser::DeclarationTypeSpec *parsedType{nullptr};
     const parser::Name *resultName{nullptr};
     Symbol *resultSymbol{nullptr};
public:
   void Post(const parser::FinalProcedureStmt &);
   bool Pre(const parser::TypeBoundGenericStmt &);
   bool Pre(const parser::AllocateStmt &);
   void Post(const parser::AllocateStmt &);
   bool Pre(const parser::StructureConstructor &);
   bool Pre(const parser::NamelistStmt::Group &);
   bool Pre(const parser::IoControlSpec &);
   bool Pre(const parser::CommonStmt::Block &);
-  void Post(const parser::CommonStmt::Block &);
   bool Pre(const parser::CommonBlockObject &);
   void Post(const parser::CommonBlockObject &);
   bool Pre(const parser::EquivalenceStmt &);
   bool Pre(const parser::SaveStmt &);
   bool Pre(const parser::BasedPointerStmt &);
 
   void PointerInitialization(
       const parser::Name &, const parser::InitialDataTarget &);
   void PointerInitialization(
       const parser::Name &, const parser::ProcPointerInit &);
   void NonPointerInitialization(
       const parser::Name &, const parser::ConstantExpr &, bool inComponentDecl);
   void CheckExplicitInterface(const parser::Name &);
   void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
 
   const parser::Name *ResolveDesignator(const parser::Designator &);
 
 protected:
   bool BeginDecl();
   void EndDecl();
-  Symbol &DeclareObjectEntity(const parser::Name &, Attrs);
+  Symbol &DeclareObjectEntity(const parser::Name &, Attrs = Attrs{});
   // Make sure that there's an entity in an enclosing scope called Name
   Symbol &FindOrDeclareEnclosingEntity(const parser::Name &);
   // Declare a LOCAL/LOCAL_INIT entity. If there isn't a type specified
   // it comes from the entity in the containing scope, or implicit rules.
   // Return pointer to the new symbol, or nullptr on error.
   Symbol *DeclareLocalEntity(const parser::Name &);
   // Declare a statement entity (e.g., an implied DO loop index).
   // If there isn't a type specified, implicit rules apply.
   // Return pointer to the new symbol, or nullptr on error.
   Symbol *DeclareStatementEntity(
       const parser::Name &, const std::optional<parser::IntegerTypeSpec> &);
+  Symbol &MakeCommonBlockSymbol(const parser::Name &);
+  Symbol &MakeCommonBlockSymbol(const std::optional<parser::Name> &);
   bool CheckUseError(const parser::Name &);
   void CheckAccessibility(const SourceName &, bool, Symbol &);
   void CheckCommonBlocks();
   void CheckSaveStmts();
   void CheckEquivalenceSets();
   bool CheckNotInBlock(const char *);
   bool NameIsKnownOrIntrinsic(const parser::Name &);
 
struct {
     bool privateComps{false}; // components are private by default
     bool privateBindings{false}; // bindings are private by default
     bool sawContains{false}; // currently processing bindings
     bool sequence{false}; // is a sequence type
     const Symbol *type{nullptr}; // derived type being defined
   } derivedTypeInfo_;
   // Collect equivalence sets and process at end of specification part
   std::vector<const std::list<parser::EquivalenceObject> *> equivalenceSets_;
-  // Info about common blocks in the current scope
-  struct {
-    Symbol *curr{nullptr}; // common block currently being processed
-    std::set<SourceName> names; // names in any common block of scope
-  } commonBlockInfo_;
+  // Names of all common block objects in the scope
+  std::set<SourceName> commonBlockObjects_;
   // Info about about SAVE statements and attributes in current scope
   struct {
     std::optional<SourceName> saveAll; // "SAVE" without entity list
     std::set<SourceName> entities; // names of entities with save attr
     std::set<SourceName> commons; // names of common blocks with save attr
   } saveInfo_;
   // In a ProcedureDeclarationStmt or ProcComponentDefStmt, this is
   // the interface name, if any.
private:
   std::optional<DerivedTypeSpec> ResolveDerivedType(const parser::Name &);
   std::optional<DerivedTypeSpec> ResolveExtendsType(
       const parser::Name &, const parser::Name *);
   Symbol *MakeTypeSymbol(const SourceName &, Details &&);
   Symbol *MakeTypeSymbol(const parser::Name &, Details &&);
   bool OkToAddComponent(const parser::Name &, const Symbol * = nullptr);
   ParamValue GetParamValue(
       const parser::TypeParamValue &, common::TypeParamAttr attr);
-  Symbol &MakeCommonBlockSymbol(const parser::Name &);
   void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
   std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
   Attrs HandleSaveName(const SourceName &, Attrs);
   void AddSaveName(std::set<SourceName> &, const SourceName &);
   void SetSaveAttr(Symbol &);
   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
   bool IsUplevelReference(const Symbol &);
   const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
   bool CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName);
   void CheckInitialProcTarget(const Symbol &, const parser::Name &, SourceName);
   void Initialization(const parser::Name &, const parser::Initialization &,
       bool inComponentDecl);
   bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
+  bool CheckForHostAssociatedImplicit(const parser::Name &);
 
   // Declare an object or procedure entity.
   // T is one of: EntityDetails, ObjectEntityDetails, ProcEntityDetails
   template <typename T>
   Symbol &DeclareEntity(const parser::Name &name, Attrs attrs) {
     Symbol &symbol{MakeSymbol(name, attrs)};
-    if (symbol.has<T>()) {
-      // OK
+    if (context().HasError(symbol) || symbol.has<T>()) {
+      return symbol; // OK or error already reported
     } else if (symbol.has<UnknownDetails>()) {
       symbol.set_details(T{});
+      return symbol;
     } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
       symbol.set_details(T{std::move(*details)});
+      return symbol;
     } else if (std::is_same_v<EntityDetails, T> &&
         (symbol.has<ObjectEntityDetails>() ||
             symbol.has<ProcEntityDetails>())) {
-      // OK
+      return symbol; // OK
     } else if (auto *details{symbol.detailsIf<UseDetails>()}) {
       Say(name.source,
           "'%s' is use-associated from module '%s' and cannot be re-declared"_err_en_US,
           name.source, GetUsedModule(*details).name());
     } else if (auto *details{symbol.detailsIf<SubprogramNameDetails>()}) {
       if (details->kind() == SubprogramKind::Module) {
         Say2(name,
             "Declaration of '%s' conflicts with its use as module procedure"_err_en_US,
             symbol, "Module procedure definition"_en_US);
       } else if (details->kind() == SubprogramKind::Internal) {
         Say2(name,
             "Declaration of '%s' conflicts with its use as internal procedure"_err_en_US,
             symbol, "Internal procedure definition"_en_US);
       } else {
         DIE("unexpected kind");
       }
     } else if (std::is_same_v<ObjectEntityDetails, T> &&
         symbol.has<ProcEntityDetails>()) {
       SayWithDecl(
           name, symbol, "'%s' is already declared as a procedure"_err_en_US);
     } else if (std::is_same_v<ProcEntityDetails, T> &&
         symbol.has<ObjectEntityDetails>()) {
+      if (InCommonBlock(symbol)) {
+        SayWithDecl(name, symbol,
+            "'%s' may not be a procedure as it is in a COMMON block"_err_en_US);
+      } else {
         SayWithDecl(
             name, symbol, "'%s' is already declared as an object"_err_en_US);
+      }
     } else {
       SayAlreadyDeclared(name, symbol);
     }
+    context().SetError(symbol);
     return symbol;
   }
 };
 
 // Resolve construct entities and statement entities.
 // Check that construct names don't conflict with other names.
 class ConstructVisitor : public virtual DeclarationVisitor {
 public:
public:
   friend void ResolveSpecificationParts(SemanticsContext &, const Symbol &);
 
 private:
   // Kind of procedure we are expecting to see in a ProcedureDesignator
   std::optional<Symbol::Flag> expectedProcFlag_;
   std::optional<SourceName> prevImportStmt_;
 
   void PreSpecificationConstruct(const parser::SpecificationConstruct &);
+  void CreateCommonBlockSymbols(const parser::CommonStmt &);
   void CreateGeneric(const parser::GenericSpec &);
   void FinishSpecificationPart(const std::list<parser::DeclarationConstruct> &);
   void AnalyzeStmtFunctionStmt(const parser::StmtFunctionStmt &);
   void CheckImports();
   void CheckImport(const SourceName &, const SourceName &);
   void HandleCall(Symbol::Flag, const parser::Call &);
   void HandleProcedureName(Symbol::Flag, const parser::Name &);
   bool SetProcFlag(const parser::Name &, Symbol &, Symbol::Flag);
if (isImplicitNoneExternal_) {
     return true;
   } else if (inheritFromParent_) {
     return parent_->isImplicitNoneExternal();
   } else {
     return false; // default if not specified
   }
 }
 
-const DeclTypeSpec *ImplicitRules::GetType(char ch) const {
+const DeclTypeSpec *ImplicitRules::GetType(SourceName name) const {
+  char ch{name.begin()[0]};
   if (isImplicitNoneType_) {
     return nullptr;
   } else if (auto it{map_.find(ch)}; it != map_.end()) {
     return &*it->second;
   } else if (inheritFromParent_) {
-    return parent_->GetType(ch);
+    return parent_->GetType(name);
   } else if (ch >= 'i' && ch <= 'n') {
     return &context_.MakeNumericType(TypeCategory::Integer);
   } else if (ch >= 'a' && ch <= 'z') {
     return &context_.MakeNumericType(TypeCategory::Real);
   } else {
     return nullptr;
   }
 }
bool result{
                        return HandleImplicitNone(y);
                      },
                      [&](const std::list<parser::ImplicitSpec> &) {
                        if (prevImplicitNoneType_) {
                          Say("IMPLICIT statement after IMPLICIT NONE or "
                              "IMPLICIT NONE(TYPE) statement"_err_en_US);
                          return false;
                        }
-                       implicitRules().set_isImplicitNoneType(false);
+                       implicitRules_->set_isImplicitNoneType(false);
                        return true;
                      },
                  },
           x.u)};
   prevImplicit_ = currStmtSource();
   return result;
 }
 
 bool ImplicitRulesVisitor::Pre(const parser::LetterSpec &x) {
   auto loLoc{std::get<parser::Location>(x.t)};
   auto hiLoc{loLoc};
   if (auto hiLocOpt{std::get<std::optional<parser::Location>>(x.t)}) {
     hiLoc = *hiLocOpt;
     if (*hiLoc < *loLoc) {
       Say(hiLoc, "'%s' does not follow '%s' alphabetically"_err_en_US,
           std::string(hiLoc, 1), std::string(loLoc, 1));
       return false;
     }
   }
-  implicitRules().SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
+  implicitRules_->SetTypeMapping(*GetDeclTypeSpec(), loLoc, hiLoc);
   return false;
 }
 
 bool ImplicitRulesVisitor::Pre(const parser::ImplicitSpec &) {
   BeginDeclTypeSpec();
   set_allowForwardReferenceToDerivedType(true);
   return true;
 }
if (prevParameterStmt_) {
     return false;
   }
   prevImplicitNone_ = currStmtSource();
   bool implicitNoneTypeNever{
       context().IsEnabled(common::LanguageFeature::ImplicitNoneTypeNever)};
   if (nameSpecs.empty()) {
     if (!implicitNoneTypeNever) {
       prevImplicitNoneType_ = currStmtSource();
-      implicitRules().set_isImplicitNoneType(true);
+      implicitRules_->set_isImplicitNoneType(true);
       if (prevImplicit_) {
         Say("IMPLICIT NONE statement after IMPLICIT statement"_err_en_US);
         return false;
       }
     }
   } else {
     int sawType{0};
     int sawExternal{0};
     for (const auto noneSpec : nameSpecs) {
       switch (noneSpec) {
       case ImplicitNoneNameSpec::External:
-        implicitRules().set_isImplicitNoneExternal(true);
+        implicitRules_->set_isImplicitNoneExternal(true);
         ++sawExternal;
         break;
       case ImplicitNoneNameSpec::Type:
         if (!implicitNoneTypeNever) {
           prevImplicitNoneType_ = currStmtSource();
-          implicitRules().set_isImplicitNoneType(true);
+          implicitRules_->set_isImplicitNoneType(true);
           if (prevImplicit_) {
             Say("IMPLICIT NONE(TYPE) after IMPLICIT statement"_err_en_US);
             return false;
           }
           ++sawType;
         }
         break;
       }
void ScopeHandler::Say2(const SourceName &name, MessageFixedText &&msg1,
   context().SetError(symbol, msg1.isFatal());
 }
 void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
     Symbol &symbol, MessageFixedText &&msg2) {
   Say2(name.source, std::move(msg1), symbol.name(), std::move(msg2));
   context().SetError(symbol, msg1.isFatal());
 }
 
-Scope &ScopeHandler::InclusiveScope() {
-  for (auto *scope{&currScope()};; scope = &scope->parent()) {
-    if (scope->kind() != Scope::Kind::Block && !scope->IsDerivedType() &&
-        !scope->IsStmtFunction()) {
-      return *scope;
+// T may be `Scope` or `const Scope`
+template <typename T> static T &GetInclusiveScope(T &scope) {
+  for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
+    if (s->kind() != Scope::Kind::Block && !s->IsDerivedType() &&
+        !s->IsStmtFunction()) {
+      return *s;
     }
   }
-  DIE("inclusive scope not found");
+  return scope;
+}
+
+Scope &ScopeHandler::InclusiveScope() { return GetInclusiveScope(currScope()); }
+
+Scope *ScopeHandler::GetHostProcedure() {
+  Scope &parent{InclusiveScope().parent()};
+  return parent.kind() == Scope::Kind::Subprogram ? &parent : nullptr;
 }
 
 Scope &ScopeHandler::NonDerivedTypeScope() {
   return currScope_->IsDerivedType() ? currScope_->parent() : *currScope_;
 }
 
 void ScopeHandler::PushScope(Scope::Kind kind, Symbol *symbol) {
   PushScope(currScope().MakeScope(kind, symbol));
if (NeedsType(symbol)) {
     } else if (!context().HasError(symbol)) {
       Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
       context().SetError(symbol);
     }
   }
 }
 
 const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
-  const DeclTypeSpec *type{implicitRules().GetType(symbol.name().begin()[0])};
+  const auto *type{implicitRulesMap_->at(&GetInclusiveScope(symbol.owner()))
+                       .GetType(symbol.name())};
   if (type) {
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       // Resolve any forward-referenced derived type; a quick no-op else.
       auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
       instantiatable.Instantiate(currScope(), context());
     }
   }
   return type;
Symbol &SubprogramVisitor::PushSubprogramScope(
   if (inInterfaceBlock()) {
     details.set_isInterface();
     if (!isAbstract()) {
       MakeExternal(*symbol);
     }
     if (isGeneric()) {
       GetGenericDetails().AddSpecificProc(*symbol, name.source);
     }
-    implicitRules().set_inheritFromParent(false);
+    set_inheritFromParent(false);
   }
   FindSymbol(name)->set(subpFlag); // PushScope() created symbol
   return *symbol;
 }
 
 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
   if (auto *prev{FindSymbol(name)}) {
     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
if (const auto *typeSpec{GetDeclTypeSpec()}) {
         }
       }
     }
   }
   EndDecl();
 }
 
 void DeclarationVisitor::Post(const parser::DimensionStmt::Declaration &x) {
-  const auto &name{std::get<parser::Name>(x.t)};
-  DeclareObjectEntity(name, Attrs{});
+  DeclareObjectEntity(std::get<parser::Name>(x.t));
 }
 void DeclarationVisitor::Post(const parser::CodimensionDecl &x) {
-  const auto &name{std::get<parser::Name>(x.t)};
-  DeclareObjectEntity(name, Attrs{});
+  DeclareObjectEntity(std::get<parser::Name>(x.t));
 }
 
 bool DeclarationVisitor::Pre(const parser::Initialization &) {
   // Defer inspection of initializers to Initialization() so that the
   // symbol being initialized will be available within the initialization
   // expression.
   return false;
 }
if (!symbol) {
           *name, *symbol, "'%s' is not the name of a namelist group"_err_en_US);
     }
   }
   return true;
 }
 
 bool DeclarationVisitor::Pre(const parser::CommonStmt::Block &x) {
   CheckNotInBlock("COMMON"); // C1107
-  const auto &optName{std::get<std::optional<parser::Name>>(x.t)};
-  parser::Name blankCommon;
-  blankCommon.source =
-      SourceName{currStmtSource().value().begin(), std::size_t{0}};
-  CHECK(!commonBlockInfo_.curr);
-  commonBlockInfo_.curr =
-      &MakeCommonBlockSymbol(optName ? *optName : blankCommon);
   return true;
 }
 
-void DeclarationVisitor::Post(const parser::CommonStmt::Block &) {
-  commonBlockInfo_.curr = nullptr;
-}
-
 bool DeclarationVisitor::Pre(const parser::CommonBlockObject &) {
   BeginArraySpec();
   return true;
 }
 
 void DeclarationVisitor::Post(const parser::CommonBlockObject &x) {
-  CHECK(commonBlockInfo_.curr);
   const auto &name{std::get<parser::Name>(x.t)};
-  auto &symbol{DeclareObjectEntity(name, Attrs{})};
-  ClearArraySpec();
-  ClearCoarraySpec();
-  auto *details{symbol.detailsIf<ObjectEntityDetails>()};
-  if (!details) {
-    return; // error was reported
-  }
-  commonBlockInfo_.curr->get<CommonBlockDetails>().add_object(symbol);
-  auto pair{commonBlockInfo_.names.insert(name.source)};
+  DeclareObjectEntity(name);
+  auto pair{commonBlockObjects_.insert(name.source)};
   if (!pair.second) {
     const SourceName &prev{*pair.first};
     Say2(name.source, "'%s' is already in a COMMON block"_err_en_US, prev,
         "Previous occurrence of '%s' in a COMMON block"_en_US);
-    return;
   }
-  details->set_commonBlock(*commonBlockInfo_.curr);
 }
 
 bool DeclarationVisitor::Pre(const parser::EquivalenceStmt &x) {
   // save equivalence sets to be processed after specification part
   CheckNotInBlock("EQUIVALENCE"); // C1107
   for (const std::list<parser::EquivalenceObject> &set : x.v) {
     equivalenceSets_.push_back(&set);
   }
for (const auto &pair : currScope().commonBlocks()) {
     if (symbol.get<CommonBlockDetails>().objects().empty() &&
         symbol.attrs().test(Attr::BIND_C)) {
       Say(symbol.name(),
           "'%s' appears as a COMMON block in a BIND statement but not in"
           " a COMMON statement"_err_en_US);
     }
   }
   // check objects in common blocks
-  for (const auto &name : commonBlockInfo_.names) {
+  for (const auto &name : commonBlockObjects_) {
     const auto *symbol{currScope().FindSymbol(name)};
     if (!symbol) {
       continue;
     }
     const auto &attrs{symbol->attrs()};
     if (attrs.test(Attr::ALLOCATABLE)) {
       Say(name,
           "ALLOCATABLE object '%s' may not appear in a COMMON block"_err_en_US);
if (attrs.test(Attr::ALLOCATABLE)) {
           Say(name,
               "Derived type '%s' in COMMON block must have the BIND or"
               " SEQUENCE attribute"_err_en_US);
         }
         CheckCommonBlockDerivedType(name, typeSymbol);
       }
     }
   }
-  commonBlockInfo_ = {};
+  commonBlockObjects_ = {};
 }
 
 Symbol &DeclarationVisitor::MakeCommonBlockSymbol(const parser::Name &name) {
   return Resolve(name, currScope().MakeCommonBlock(name.source));
 }
+Symbol &DeclarationVisitor::MakeCommonBlockSymbol(
+    const std::optional<parser::Name> &name) {
+  if (name) {
+    return MakeCommonBlockSymbol(*name);
+  } else {
+    return MakeCommonBlockSymbol(parser::Name{});
+  }
+}
 
 bool DeclarationVisitor::NameIsKnownOrIntrinsic(const parser::Name &name) {
   return FindSymbol(name) || HandleUnrestrictedSpecificIntrinsicFunction(name);
 }
 
 // Check if this derived type can be in a COMMON block.
 void DeclarationVisitor::CheckCommonBlockDerivedType(
     const SourceName &name, const Symbol &typeSymbol) {
void ConstructVisitor::ResolveIndexName(
   if (prev) {
     if (prev->owner().kind() == Scope::Kind::Forall ||
         prev->owner() == currScope()) {
       SayAlreadyDeclared(name, *prev);
       return;
     }
     name.symbol = nullptr;
   }
-  auto &symbol{DeclareObjectEntity(name, {})};
-
+  auto &symbol{DeclareObjectEntity(name)};
   if (symbol.GetType()) {
     // type came from explicit type-spec
   } else if (!prev) {
     ApplyImplicitRules(symbol);
   } else if (!prev->has<ObjectEntityDetails>() && !prev->has<EntityDetails>()) {
     Say2(name, "Index name '%s' conflicts with existing identifier"_err_en_US,
         *prev, "Previous declaration of '%s'"_en_US);
     return;
return std::visit(
           },
       },
       x.u);
 }
 
 // If implicit types are allowed, ensure name is in the symbol table.
 // Otherwise, report an error if it hasn't been declared.
 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
-  if (Symbol * symbol{FindSymbol(name)}) {
+  FindSymbol(name);
+  if (CheckForHostAssociatedImplicit(name)) {
+    return &name;
+  }
+  if (Symbol * symbol{name.symbol}) {
     if (CheckUseError(name)) {
       return nullptr; // reported an error
     }
+    symbol->set(Symbol::Flag::ImplicitOrError, false);
     if (IsUplevelReference(*symbol)) {
       MakeHostAssocSymbol(name, *symbol);
     } else if (IsDummy(*symbol) ||
         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
       ConvertToObjectEntity(*symbol);
       ApplyImplicitRules(*symbol);
     }
     return &name;
Say(name,
         "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
     return nullptr;
   }
   ConvertToObjectEntity(*symbol);
   ApplyImplicitRules(*symbol);
   return &name;
 }
 
+// A specification expression may refer to a symbol in the host procedure that
+// is implicitly typed. Because specification parts are processed before
+// execution parts, this may be the first time we see the symbol. It can't be a
+// local in the current scope (because it's in a specification expression) so
+// either it is implicitly declared in the host procedure or it is an error.
+// We create a symbol in the host assuming it is the former; if that proves to
+// be wrong we report an error later in CheckDeclarations().
+bool DeclarationVisitor::CheckForHostAssociatedImplicit(
+    const parser::Name &name) {
+  if (inExecutionPart_) {
+    return false;
+  }
+  if (name.symbol) {
+    ApplyImplicitRules(*name.symbol);
+  }
+  Symbol *hostSymbol;
+  Scope *host{GetHostProcedure()};
+  if (!host || isImplicitNoneType(*host)) {
+    return false;
+  } else if (!name.symbol) {
+    hostSymbol = &MakeSymbol(*host, name.source, Attrs{});
+    ConvertToObjectEntity(*hostSymbol);
+    ApplyImplicitRules(*hostSymbol);
+    hostSymbol->set(Symbol::Flag::ImplicitOrError);
+  } else if (name.symbol->test(Symbol::Flag::ImplicitOrError)) {
+    hostSymbol = name.symbol;
+  } else {
+    return false;
+  }
+  Symbol &symbol{MakeHostAssocSymbol(name, *hostSymbol)};
+  if (isImplicitNoneType()) {
+    symbol.get<HostAssocDetails>().implicitOrExplicitTypeError = true;
+  } else {
+    symbol.get<HostAssocDetails>().implicitOrSpecExprError = true;
+  }
+  return true;
+}
+
 bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {
   const Scope *symbolUnit{FindProgramUnitContaining(symbol)};
   if (symbolUnit == FindProgramUnitContaining(currScope())) {
     return false;
   } else {
     Scope::Kind kind{DEREF(symbolUnit).kind()};
     return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;
   }
static bool NeedsExplicitType(const Symbol &symbol) {
   } else if (const auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
     return !details->interface().symbol() && !details->interface().type();
   } else {
     return false;
   }
 }
 
 bool ResolveNamesVisitor::Pre(const parser::SpecificationPart &x) {
-  Walk(std::get<0>(x.t));
-  Walk(std::get<1>(x.t));
-  Walk(std::get<2>(x.t));
-  Walk(std::get<3>(x.t));
-  Walk(std::get<4>(x.t));
-  Walk(std::get<5>(x.t));
-  const std::list<parser::DeclarationConstruct> &decls{std::get<6>(x.t)};
+  const auto &[accDecls, ompDecls, compilerDirectives, useStmts, importStmts,
+      implicitPart, decls] = x.t;
+  Walk(accDecls);
+  Walk(ompDecls);
+  Walk(compilerDirectives);
+  Walk(useStmts);
+  Walk(importStmts);
+  Walk(implicitPart);
   for (const auto &decl : decls) {
     if (const auto *spec{
             std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
       PreSpecificationConstruct(*spec);
     }
   }
   Walk(decls);
   FinishSpecificationPart(decls);
   return false;
 }
 
 // Initial processing on specification constructs, before visiting them.
 void ResolveNamesVisitor::PreSpecificationConstruct(
     const parser::SpecificationConstruct &spec) {
   std::visit(
       common::visitors{
-          [&](const Indirection<parser::DerivedTypeDef> &) {},
           [&](const parser::Statement<Indirection<parser::GenericStmt>> &y) {
             CreateGeneric(std::get<parser::GenericSpec>(y.statement.value().t));
           },
           [&](const Indirection<parser::InterfaceBlock> &y) {
             const auto &stmt{std::get<parser::Statement<parser::InterfaceStmt>>(
                 y.value().t)};
-            const auto *spec{std::get_if<std::optional<parser::GenericSpec>>(
-                &stmt.statement.u)};
-            if (spec && *spec) {
-              CreateGeneric(**spec);
+            if (const auto *spec{parser::Unwrap<parser::GenericSpec>(stmt)}) {
+              CreateGeneric(*spec);
+            }
+          },
+          [&](const parser::Statement<parser::OtherSpecificationStmt> &y) {
+            if (const auto *commonStmt{parser::Unwrap<parser::CommonStmt>(y)}) {
+              CreateCommonBlockSymbols(*commonStmt);
             }
           },
           [&](const auto &) {},
       },
       spec.u);
 }
 
+void ResolveNamesVisitor::CreateCommonBlockSymbols(
+    const parser::CommonStmt &commonStmt) {
+  for (const parser::CommonStmt::Block &block : commonStmt.blocks) {
+    const auto &[name, objects] = block.t;
+    Symbol &commonBlock{MakeCommonBlockSymbol(name)};
+    for (const auto &object : objects) {
+      Symbol &obj{DeclareObjectEntity(std::get<parser::Name>(object.t))};
+      if (auto *details{obj.detailsIf<ObjectEntityDetails>()}) {
+        details->set_commonBlock(commonBlock);
+        commonBlock.get<CommonBlockDetails>().add_object(obj);
+      }
+    }
+  }
+}
+
 void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
   auto info{GenericSpecInfo{x}};
   const SourceName &symbolName{info.symbolName()};
   if (IsLogicalConstant(context(), symbolName)) {
     Say(symbolName,
         "Logical constant '%s' may not be used as a defined operator"_err_en_US);
     return;
   }

flang/lib/Semantics/tools.cpp

bool HasAlternateReturns(const Symbol &subprogram) {
   for (const auto *dummyArg : subprogram.get<SubprogramDetails>().dummyArgs()) {
     if (!dummyArg) {
       return true;
     }
   }
   return false;
 }
 
+bool InCommonBlock(const Symbol &symbol) {
+  const auto *details{symbol.detailsIf<ObjectEntityDetails>()};
+  return details && details->commonBlock();
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/block-data01.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 ! 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
   integer :: uninitialized ! ok
-  !ERROR: 'p' may not appear in a BLOCK DATA subprogram
+  !ERROR: 'q' may not appear in a BLOCK DATA subprogram
+  procedure(sin), pointer :: q => cos
+  !ERROR: 'p' may not be a procedure as it is in a COMMON block
   procedure(sin), pointer :: p => cos
-  !ERROR: 'p' is already declared as a procedure
   common /block/ pi, p
   !ERROR: An initialized variable in BLOCK DATA must be in a COMMON block
   integer :: inDataButNotCommon
   data inDataButNotCommon /1/
   integer :: inCommonA, inCommonB
   !ERROR: 'incommona' in COMMON block /a/ must not be storage associated with 'incommonb' in COMMON block /b/ by EQUIVALENCE
   common /a/ inCommonA, /b/ inCommonB
   equivalence(inCommonA, inCommonB)

flang/test/Semantics/implicit11.f90

+! RUN: %S/test_errors.sh %s %t %f18
+
+! Test use of implicitly declared variable in specification expression
+
+subroutine s1()
+  m = 1
+contains
+  subroutine s1a()
+    implicit none
+    !ERROR: No explicit type declared for 'n'
+    real :: a(m, n)
+  end
+  subroutine s1b()
+    !ERROR: Implicitly typed local entity 'n' not allowed in specification expression
+    real :: a(m, n)
+  end
+end
+
+subroutine s2()
+  type :: t(m, n)
+    integer, len :: m
+    integer, len :: n
+  end type
+  n = 1
+contains
+  subroutine s2a()
+    !ERROR: Implicitly typed local entity 'm' not allowed in specification expression
+    type(t(m, n)) :: a
+  end
+  subroutine s2b()
+    implicit none
+    !ERROR: No explicit type declared for 'm'
+    character(m) :: a
+  end
+end
+
+subroutine s3()
+  m = 1
+contains
+  subroutine s3a()
+    implicit none
+    real :: a(m, n)
+    !ERROR: No explicit type declared for 'n'
+    common n
+  end
+  subroutine s3b()
+    ! n is okay here because it is in a common block
+    real :: a(m, n)
+    common n
+  end
+end
+
+subroutine s4()
+  implicit none
+contains
+  subroutine s4a()
+    !ERROR: No explicit type declared for 'n'
+    real :: a(n)
+  end
+end
+

flang/test/Semantics/modfile21.f90

 !  real(4)::a
 !  real(4)::c
 !  real(4)::y
 !  real(4)::z
 !  real(4)::u
 !  real(4)::v
 !  complex(4)::w
 !  real(4)::cb
-!  common/cb2/a,b,c
-!  bind(c)::/cb2/
 !  common//t,w,u,v
 !  common/cb/x,y,z
 !  bind(c, name="CB")::/cb/
+!  common/cb2/a,b,c
+!  bind(c)::/cb2/
 !  common/b/cb
 !end

flang/test/Semantics/resolve42.f90

 ! RUN: %S/test_errors.sh %s %t %f18
 subroutine s1
   !ERROR: Array 'z' without ALLOCATABLE or POINTER attribute must have explicit shape
   common x, y(4), z(:)
 end
 
 subroutine s2
   common /c1/ x, y, z
   !ERROR: 'y' is already in a COMMON block
   common y
 end
 
 subroutine s3
+  !ERROR: 'x' may not be a procedure as it is in a COMMON block
   procedure(real) :: x
-  !ERROR: 'x' is already declared as a procedure
   common x
   common y
-  !ERROR: 'y' is already declared as an object
+  !ERROR: 'y' may not be a procedure as it is in a COMMON block
   procedure(real) :: y
 end
 
 subroutine s5
   integer x(2)
   !ERROR: The dimensions of 'x' have already been declared
   common x(4), y(4)
   !ERROR: The dimensions of 'y' have already been declared