improved spec sema

17 files changed, 486 insertions, 142 deletions

diff --git a/include/flang/AST/Decl.h b/include/flang/AST/Decl.h
index db5e183a5a..cbe8698894 100644
--- a/include/flang/AST/Decl.h
+++ b/include/flang/AST/Decl.h
@@ -120,6 +120,10 @@ private:
   /// the implementation rather than explicitly written by the user.
   unsigned Implicit    : 1;
 
+  /// ImplicitType - Whether this declaration had the type that was
+  /// set using the implicit typing rules rather than explicit ones.
+  unsigned ImplicitType : 1;
+
 protected:
 
   /// the kind of a sub declaration this is
@@ -133,6 +137,7 @@ protected:
   Decl(Kind DK, DeclContext *DC, SourceLocation L)
     : NextDeclInContext(0), DeclCtx(DC), Loc(L), DeclKind(DK),
       InvalidDecl(false), HasAttrs(false), Implicit(false),
+      ImplicitType(0),
       SubDeclKind(0) {}
 
   virtual ~Decl();
@@ -175,6 +180,11 @@ public:
   bool isImplicit() const { return Implicit; }
   void setImplicit(bool I = true) { Implicit = I; }
 
+  /// isTypeImplicit - Indicates whether the type of this declaration
+  /// set using the implicit typing rules.
+  bool isTypeImplicit() const { return ImplicitType; }
+  bool setTypeImplicit(bool I = true) { ImplicitType = I; }
+
   void dump() const;
   void dump(llvm::raw_ostream &OS) const;
 
@@ -610,8 +620,13 @@ protected:
             DeclarationName N, QualType T)
     : NamedDecl(DK, DC, L, N), DeclType(T) {}
 public:
+
   QualType getType() const { return DeclType; }
-  void setType(QualType newType) { DeclType = newType; }
+
+  void setType(QualType newType) {
+    DeclType = newType;
+    setTypeImplicit(false);
+  }
 
   // Implement isa/cast/dyncast/etc.
   static bool classof(const Decl *D) { return classofKind(D->getKind()); }
@@ -988,6 +1003,19 @@ public:
   static bool classofKind(Kind K) { return K == FileScopeAsm; }
 };
 
+class CommonBlockDecl : public NamedDecl {
+  CommonBlockDecl(DeclContext *DC,
+                  SourceLocation IDLoc, const IdentifierInfo *IDInfo)
+    : NamedDecl(CommonBlock, DC, IDLoc, DeclarationName(IDInfo)) {}
+public:
+  static CommonBlockDecl *Create(ASTContext &C, DeclContext *DC,
+                                 SourceLocation IDLoc, const IdentifierInfo *IDInfo);
+
+  static bool classof(const Decl *D) { return classofKind(D->getKind()); }
+  static bool classof(const CommonBlockDecl *D) { return true; }
+  static bool classofKind(Kind K) { return K == CommonBlock; }
+};
+
 static inline llvm::raw_ostream &operator<<(llvm::raw_ostream &O,
                                             const VarDecl &V) {
   return O << V.getIdentifier()->getName();
diff --git a/include/flang/AST/EquivalenceSet.h b/include/flang/AST/EquivalenceSet.h
deleted file mode 100644
index a9082b7526..0000000000
--- a/include/flang/AST/EquivalenceSet.h
+++ /dev/null
@@ -1,53 +0,0 @@
-//===--- EquivalenceSet.h - A set of objects from one EQUIVALENCE block ---===//
-//
-//                     The LLVM Compiler Infrastructure
-//
-// This file is distributed under the University of Illinois Open Source
-// License. See LICENSE.TXT for details.
-//
-//===----------------------------------------------------------------------===//
-//
-//  This file defines a set of objects which share the same memory block.
-//
-//===----------------------------------------------------------------------===//
-
-#ifndef FLANG_AST_EQUIVALENCESET_H
-#define FLANG_AST_EQUIVALENCESET_H
-
-#include "flang/Basic/LLVM.h"
-
-namespace flang {
-
-class ASTContext;
-class VarDecl;
-class Expr;
-
-class EquivalenceSet {
-public:
-  class Object {
-  public:
-    VarDecl *Var;
-    const Expr *E;
-
-    Object() {}
-    Object(VarDecl *var, const Expr *e)
-      : Var(var), E(e) {}
-  };
-
-private:
-  Object *Objects;
-  unsigned ObjectCount;
-
-  EquivalenceSet(ASTContext &C, ArrayRef<Object> objects);
-public:
-
-  static EquivalenceSet *Create(ASTContext &C, ArrayRef<Object> Objects);
-
-  ArrayRef<Object> getObjects() const {
-    return ArrayRef<Object>(Objects, ObjectCount);
-  }
-};
-
-} // end flang namespace
-
-#endif
diff --git a/include/flang/AST/StorageSet.h b/include/flang/AST/StorageSet.h
new file mode 100644
index 0000000000..1e454761b4
--- /dev/null
+++ b/include/flang/AST/StorageSet.h
@@ -0,0 +1,109 @@
+//===--- StorageSet.h - A set of objects in a specific storage unit ------===//
+//
+//                     The LLVM Compiler Infrastructure
+//
+// This file is distributed under the University of Illinois Open Source
+// License. See LICENSE.TXT for details.
+//
+//===----------------------------------------------------------------------===//
+//
+//  This file defines EquivalenceSet and CommonBlockSet.
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FLANG_AST_STORAGESET_H
+#define FLANG_AST_STORAGESET_H
+
+#include "flang/Basic/LLVM.h"
+
+namespace flang {
+
+class ASTContext;
+class VarDecl;
+class Expr;
+
+/// StorageSet - A
+class StorageSet {
+public:
+  enum StorageSetClass {
+    NoStorageSetClass = 0,
+    EquivalenceSetClass,
+    CommonBlockSetClass
+  };
+
+private:
+  StorageSetClass ID;
+protected:
+  StorageSet(StorageSetClass Class) : ID(Class) {}
+public:
+
+  StorageSetClass getStorageSetClass() const { return ID; }
+  static bool classof(const StorageSet*) { return true; }
+};
+
+/// EquivalenceSet - Contains a set of objects which share the same memory block.
+class EquivalenceSet : public StorageSet {
+public:
+  class Object {
+  public:
+    VarDecl *Var;
+    const Expr *E;
+
+    Object() {}
+    Object(VarDecl *var, const Expr *e)
+      : Var(var), E(e) {}
+  };
+
+private:
+  Object *Objects;
+  unsigned ObjectCount;
+
+  EquivalenceSet(ASTContext &C, ArrayRef<Object> objects);
+public:
+
+  static EquivalenceSet *Create(ASTContext &C, ArrayRef<Object> Objects);
+
+  ArrayRef<Object> getObjects() const {
+    return ArrayRef<Object>(Objects, ObjectCount);
+  }
+
+  static bool classof(const StorageSet* S) {
+    return S->getStorageSetClass() == EquivalenceSetClass;
+  }
+};
+
+/// CommonBlockSet - Contains a set of objects that are shared in the program
+/// using one common block.
+class CommonBlockSet : public StorageSet {
+public:
+  class Object {
+  public:
+    VarDecl *Var;
+    EquivalenceSet *Equiv;
+
+    Object() {}
+    Object(VarDecl *V)
+      : Var(V), Equiv(nullptr) {}
+  };
+
+private:
+  Object *Objects;
+  unsigned ObjectCount;
+
+  CommonBlockSet(ASTContext &C, ArrayRef<Object> objects);
+public:
+
+  static CommonBlockSet *Create(ASTContext &C, ArrayRef<Object> Objects);
+
+  ArrayRef<Object> getObjects() const {
+    return ArrayRef<Object>(Objects, ObjectCount);
+  }
+
+  static bool classof(const StorageSet* S) {
+    return S->getStorageSetClass() == CommonBlockSetClass;
+  }
+};
+
+} // end flang namespace
+
+#endif
diff --git a/include/flang/Basic/DeclNodes.td b/include/flang/Basic/DeclNodes.td
index 147814b083..b4effc88e7 100644
--- a/include/flang/Basic/DeclNodes.td
+++ b/include/flang/Basic/DeclNodes.td
@@ -38,4 +38,5 @@ def Named : Decl<1>;
       def Field : DDecl<Declarator>;
       def Var : DDecl<Declarator>;
       def Self : DDecl<Declarator>;
+  def CommonBlock : DDecl<Named>;
 def FileScopeAsm : Decl;
diff --git a/include/flang/Sema/Scope.h b/include/flang/Sema/Scope.h
index 5798f77a77..d95c3d47e4 100644
--- a/include/flang/Sema/Scope.h
+++ b/include/flang/Sema/Scope.h
@@ -26,6 +26,8 @@ namespace flang {
 class Decl;
 class DeclContext;
 class UsingDirectiveDecl;
+class CommonBlockDecl;
+class Sema;
 
 /// BlockStmtBuilder - Constructs bodies for statements and program units.
 class BlockStmtBuilder {
@@ -302,6 +304,77 @@ public:
   void CreateEquivalenceSets(ASTContext &C);
 };
 
+/// CommonBlockScope - This is a component of a scope which assists with
+/// semantic analysis for the COMMON statement and storage unit
+/// association for the variables that are influenced by the COMMON
+/// statement.
+///
+class CommonBlockScope {
+  CommonBlockDecl *UnnamedBlock;
+  llvm::SmallDenseMap<const IdentifierInfo*, CommonBlockDecl*> Blocks;
+public:
+
+  CommonBlockDecl *findOrInsert(ASTContext &C, DeclContext *DC,
+                                SourceLocation IDLoc,
+                                const IdentifierInfo *IDInfo);
+};
+
+/// The scope which helps to apply specification statements
+class SpecificationScope {
+
+  struct StoredDimensionSpec {
+    SourceLocation Loc, IDLoc;
+    const IdentifierInfo *IDInfo;
+    unsigned Offset, Size;
+  };
+  SmallVector<StoredDimensionSpec, 8> DimensionSpecs;
+  SmallVector<ArraySpec*, 32> Dimensions;
+
+  struct StoredSaveSpec {
+    SourceLocation Loc, IDLoc;
+    const IdentifierInfo *IDInfo;
+  };
+
+  SmallVector<StoredSaveSpec, 4> SaveSpecs;
+
+  struct StoredCommonSpec {
+    SourceLocation Loc, IDLoc;
+    const IdentifierInfo *IDInfo;
+    CommonBlockDecl *Block;
+  };
+  struct StoredSaveCommonBlockSpec {
+    SourceLocation Loc, IDLoc;
+    CommonBlockDecl *Block;
+  };
+
+  SmallVector<StoredCommonSpec, 4> CommonSpecs;
+  SmallVector<StoredSaveCommonBlockSpec, 4> SaveCommonBlockSpecs;
+
+public:
+
+  void AddDimensionSpec(SourceLocation Loc, SourceLocation IDLoc,
+                        const IdentifierInfo *IDInfo,
+                        ArrayRef<ArraySpec*> Dims);
+
+  bool IsDimensionAppliedTo(const IdentifierInfo *IDInfo) const;
+
+  void ApplyDimensionSpecs(Sema &Visitor);
+
+  void AddSaveSpec(SourceLocation Loc, SourceLocation IDLoc,
+                   const IdentifierInfo *IDInfo = nullptr);
+
+  void AddSaveSpec(SourceLocation Loc, SourceLocation IDLoc,
+                   CommonBlockDecl *Block);
+
+  void ApplySaveSpecs(Sema &Visitor);
+
+  void AddCommonSpec(SourceLocation Loc, SourceLocation IDLoc,
+                     const IdentifierInfo *IDInfo,
+                     CommonBlockDecl *Block);
+
+  void ApplyCommonSpecs(Sema &Visitor);
+};
+
 /// The scope of a translation unit (a single file)
 class TranslationUnitScope {
 public:
@@ -316,7 +389,9 @@ public:
   ConstructNameScope NamedConstructs;
   ImplicitTypingScope ImplicitTypingRules;
   EquivalenceScope EquivalenceAssociations;
+  CommonBlockScope CommonBlocks;
   BlockStmtBuilder Body;
+  SpecificationScope Specs;
 };
 
 /// The scope of a main program
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index a7eb4813a2..fb98e237b9 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -64,6 +64,12 @@ class Sema {
   /// \brief The equivalence scope for the current program unit.
   EquivalenceScope *CurEquivalenceScope;
 
+  /// \brief The common block scope for the current program unit.
+  CommonBlockScope *CurCommonBlockScope;
+
+  /// \brief The specification scope for the current program unit.
+  SpecificationScope *CurSpecScope;
+
   /// \brief Represents the do loop variable currently being used.
   SmallVector<const VarExpr*, 8> CurLoopVars;
 
@@ -85,8 +91,6 @@ class Sema {
   /// \brief The mapping
   intrinsic::FunctionMapping IntrinsicFunctionMapping;
 
-
-
 public:
   typedef Expr ExprTy;
 
@@ -123,6 +127,10 @@ public:
     return CurEquivalenceScope;
   }
 
+  CommonBlockScope *getCurrentCommonBlockScope() const {
+    return CurCommonBlockScope;
+  }
+
   BlockStmtBuilder *getCurrentBody() const {
     return CurExecutableStmts;
   }
@@ -187,9 +195,22 @@ public:
   VarDecl *GetVariableForSpecification(SourceLocation StmtLoc, const IdentifierInfo *IDInfo,
                                        SourceLocation IDLoc,
                                        bool CanBeArgument = true);
-  bool ApplySpecification(SourceLocation StmtLoc, const DimensionStmt *S);
-  bool ApplySpecification(SourceLocation StmtLoc, const SaveStmt *S);
-  bool ApplySpecification(SourceLocation StmtLoc, const SaveStmt *S, VarDecl *VD);
+
+  bool ApplyDimensionSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                   const IdentifierInfo *IDInfo,
+                                   ArrayRef<ArraySpec*> Dims);
+
+  bool ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                              const IdentifierInfo *IDInfo);
+
+  bool ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc, VarDecl *VD);
+
+  bool ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                              CommonBlockDecl *Block);
+
+  bool ApplyCommonSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                const IdentifierInfo *IDInfo,
+                                CommonBlockDecl *Block);
 
   QualType ActOnTypeName(ASTContext &C, DeclSpec &DS);
   VarDecl *ActOnKindSelector(ASTContext &C, SourceLocation IDLoc,
@@ -226,6 +247,9 @@ public:
   void ActOnTypeDeclSpec(ASTContext &C, SourceLocation Loc,
                          const IdentifierInfo *IDInfo, DeclSpec &DS);
 
+  VarDecl *CreateImplicitEntityDecl(ASTContext &C, SourceLocation IDLoc,
+                                    const IdentifierInfo *IDInfo);
+
   Decl *ActOnExternalEntityDecl(ASTContext &C, QualType T,
                                 SourceLocation IDLoc, const IdentifierInfo *IDInfo);
 
diff --git a/lib/AST/Decl.cpp b/lib/AST/Decl.cpp
index ed21b535c3..9ce1773d31 100644
--- a/lib/AST/Decl.cpp
+++ b/lib/AST/Decl.cpp
@@ -368,6 +368,16 @@ void VarDecl::MarkUsedAsVariable (SourceLocation Loc) {
 }
 
 //===----------------------------------------------------------------------===//
+// CommonBlockDecl Implementation
+//===----------------------------------------------------------------------===//
+
+CommonBlockDecl * CommonBlockDecl::Create(ASTContext &C, DeclContext *DC,
+                                          SourceLocation IDLoc,
+                                          const IdentifierInfo *IDInfo) {
+  return new(C) CommonBlockDecl(DC, IDLoc, IDInfo);
+}
+
+//===----------------------------------------------------------------------===//
 // Creation and Destruction of StoredDeclsMaps
 //===----------------------------------------------------------------------===//
 
diff --git a/lib/AST/Stmt.cpp b/lib/AST/Stmt.cpp
index e00ff31803..8d80506e65 100644
--- a/lib/AST/Stmt.cpp
+++ b/lib/AST/Stmt.cpp
@@ -13,7 +13,7 @@
 
 #include "flang/AST/Stmt.h"
 #include "flang/AST/Expr.h"
-#include "flang/AST/EquivalenceSet.h"
+#include "flang/AST/StorageSet.h"
 #include "flang/AST/ASTContext.h"
 #include "flang/Basic/IdentifierTable.h"
 #include "llvm/ADT/StringRef.h"
@@ -286,7 +286,8 @@ EquivalenceStmt *EquivalenceStmt::Create(ASTContext &C, SourceLocation Loc,
   return new(C) EquivalenceStmt(C, Loc, Objects, StmtLabel);
 }
 
-EquivalenceSet::EquivalenceSet(ASTContext &C, ArrayRef<Object> objects) {
+EquivalenceSet::EquivalenceSet(ASTContext &C, ArrayRef<Object> objects)
+  : StorageSet(EquivalenceSetClass) {
   ObjectCount = objects.size();
   Objects = new(C) Object[ObjectCount];
   for(size_t I = 0; I < ObjectCount; ++I)
diff --git a/lib/CodeGen/CGDecl.cpp b/lib/CodeGen/CGDecl.cpp
index b9599ed839..8a2cd310ce 100644
--- a/lib/CodeGen/CGDecl.cpp
+++ b/lib/CodeGen/CGDecl.cpp
@@ -16,7 +16,7 @@
 #include "flang/AST/Decl.h"
 #include "flang/AST/DeclVisitor.h"
 #include "flang/AST/Expr.h"
-#include "flang/AST/EquivalenceSet.h"
+#include "flang/AST/StorageSet.h"
 
 namespace flang {
 namespace CodeGen {
diff --git a/lib/Sema/Scope.cpp b/lib/Sema/Scope.cpp
index c769c3770a..4b05c7b94e 100644
--- a/lib/Sema/Scope.cpp
+++ b/lib/Sema/Scope.cpp
@@ -153,4 +153,21 @@ Decl *InnerScope::Resolve(const IdentifierInfo *IDInfo) const {
   return Result? Result : (Parent? Parent->Resolve(IDInfo) : nullptr);
 }
 
+
+CommonBlockDecl *CommonBlockScope::findOrInsert(ASTContext &C, DeclContext *DC,
+                                                SourceLocation IDLoc,
+                                                const IdentifierInfo *IDInfo) {
+  if(!IDInfo) {
+    if(!UnnamedBlock)
+      UnnamedBlock = CommonBlockDecl::Create(C, DC, IDLoc, IDInfo);
+    return UnnamedBlock;
+  }
+  auto Result = Blocks.find(IDInfo);
+  if(Result != Blocks.end())
+    return Result->second;
+  auto Block = CommonBlockDecl::Create(C, DC, IDLoc, IDInfo);
+  Blocks.insert(std::make_pair(IDInfo, Block));
+  return Block;
+}
+
 } // end namespace flang
diff --git a/lib/Sema/Sema.cpp b/lib/Sema/Sema.cpp
index a8a8ab589d..2d034ab2a4 100644
--- a/lib/Sema/Sema.cpp
+++ b/lib/Sema/Sema.cpp
@@ -33,7 +33,10 @@ Sema::Sema(ASTContext &ctxt, DiagnosticsEngine &D)
     CurExecutableStmts(nullptr),
     CurStmtLabelScope(nullptr),
     CurNamedConstructs(nullptr),
-    CurImplicitTypingScope(nullptr) {
+    CurImplicitTypingScope(nullptr),
+    CurSpecScope(nullptr),
+    CurEquivalenceScope(nullptr),
+    CurCommonBlockScope(nullptr) {
 }
 
 Sema::~Sema() {}
@@ -90,7 +93,11 @@ void Sema::PushExecutableProgramUnit(ExecutableProgramUnitScope &Scope) {
   // Enter new equivalence association scope
   CurEquivalenceScope = &Scope.EquivalenceAssociations;
 
+  // Enter new common block scope
+  CurCommonBlockScope = &Scope.CommonBlocks;
+
   CurExecutableStmts = &Scope.Body;
+  CurSpecScope = &Scope.Specs;
 }
 
 void Sema::PopExecutableProgramUnit(SourceLocation Loc) {
@@ -144,6 +151,10 @@ void Sema::PopExecutableProgramUnit(SourceLocation Loc) {
 
   CurEquivalenceScope->CreateEquivalenceSets(Context);
   CurEquivalenceScope = nullptr;
+
+  CurCommonBlockScope = nullptr;
+
+  CurSpecScope = nullptr;
 }
 
 void BlockStmtBuilder::Enter(Entry S) {
@@ -403,10 +414,10 @@ void Sema::ActOnEndSubProgram(ASTContext &C, SourceLocation Loc) {
 bool Sema::IsValidStatementFunctionIdentifier(const IdentifierInfo *IDInfo) {
   if (auto Prev = LookupIdentifier(IDInfo)) {
     if(auto VD = dyn_cast<VarDecl>(Prev))
-      return VD->isUnusedSymbol();
+      return VD->isUnusedSymbol() && !CurSpecScope->IsDimensionAppliedTo(IDInfo);
     return false;
   }
-  return true;
+  return !CurSpecScope->IsDimensionAppliedTo(IDInfo);
 }
 
 FunctionDecl *Sema::ActOnStatementFunction(ASTContext &C,
@@ -748,11 +759,21 @@ StmtResult Sema::ActOnDIMENSION(ASTContext &C, SourceLocation Loc,
                                 const IdentifierInfo *IDInfo,
                                 ArrayRef<ArraySpec*> Dims,
                                 Expr *StmtLabel) {
+  CurSpecScope->AddDimensionSpec(Loc, IDLoc, IDInfo, Dims);
+
   auto Result = DimensionStmt::Create(C, IDLoc, IDInfo, Dims, StmtLabel);
   if(StmtLabel) DeclareStatementLabel(StmtLabel, Result);
   return Result;
 }
 
+void Sema::ActOnCOMMON(ASTContext &C, SourceLocation Loc, SourceLocation BlockLoc,
+                       SourceLocation IDLoc, const IdentifierInfo *BlockID,
+                       const IdentifierInfo *IDInfo, ArrayRef<ArraySpec*> Dimensions) {
+  CurSpecScope->AddDimensionSpec(Loc, IDLoc, IDInfo, Dimensions);
+  auto Block = CurCommonBlockScope->findOrInsert(C, CurContext, BlockLoc, BlockID);
+  CurSpecScope->AddCommonSpec(Loc, IDLoc, IDInfo, Block);
+}
+
 StmtResult Sema::ActOnEXTERNAL(ASTContext &C, SourceLocation Loc,
                                SourceLocation IDLoc, const IdentifierInfo *IDInfo,
                                Expr *StmtLabel) {
@@ -775,6 +796,8 @@ StmtResult Sema::ActOnINTRINSIC(ASTContext &C, SourceLocation Loc,
 }
 
 StmtResult Sema::ActOnSAVE(ASTContext &C, SourceLocation Loc, Expr *StmtLabel) {
+  CurSpecScope->AddSaveSpec(Loc, Loc);
+
   auto Result = SaveStmt::Create(C, Loc, nullptr, StmtLabel);
   if(StmtLabel) DeclareStatementLabel(StmtLabel, Result);
   return Result;
@@ -784,6 +807,8 @@ StmtResult Sema::ActOnSAVE(ASTContext &C, SourceLocation Loc,
                            SourceLocation IDLoc,
                            const IdentifierInfo *IDInfo,
                            Expr *StmtLabel) {
+  CurSpecScope->AddSaveSpec(Loc, IDLoc, IDInfo);
+
   auto Result = SaveStmt::Create(C, IDLoc, IDInfo, StmtLabel);
   if(StmtLabel) DeclareStatementLabel(StmtLabel, Result);
   return Result;
diff --git a/lib/Sema/SemaDecl.cpp b/lib/Sema/SemaDecl.cpp
index ddb059a159..1197cf5f48 100644
--- a/lib/Sema/SemaDecl.cpp
+++ b/lib/Sema/SemaDecl.cpp
@@ -193,6 +193,21 @@ QualType Sema::ActOnTypeName(ASTContext &C, DeclSpec &DS) {
 // Entity declarations.
 //
 
+VarDecl *Sema::CreateImplicitEntityDecl(ASTContext &C, SourceLocation IDLoc,
+                                        const IdentifierInfo *IDInfo) {
+  auto Type = ResolveImplicitType(IDInfo);
+  if(Type.isNull()) {
+    Diags.Report(IDLoc, diag::err_undeclared_var_use)
+      << IDInfo;
+    return nullptr;
+  }
+  auto VD = VarDecl::Create(C, CurContext, IDLoc, IDInfo, Type);
+  // FIXME: type checks?
+  VD->setTypeImplicit(true);
+  CurContext->addDecl(VD);
+  return VD;
+}
+
 static Qualifiers getDeclQualifiers(const Decl *D) {
   if(auto Value = dyn_cast<ValueDecl>(D))
     return Value->getType().split().second;
@@ -395,12 +410,6 @@ Decl *Sema::ActOnEntityDecl(ASTContext &C, DeclSpec &DS, SourceLocation IDLoc,
   return ActOnEntityDecl(C, T, IDLoc, IDInfo);
 }
 
-void Sema::ActOnCOMMON(ASTContext &C, SourceLocation Loc, SourceLocation BlockLoc,
-                       SourceLocation IDLoc, const IdentifierInfo *BlockID,
-                       const IdentifierInfo *IDInfo, ArrayRef<ArraySpec*> Dimensions) {
-
-}
-
 //
 // derived types
 //
diff --git a/lib/Sema/SemaEquivalence.cpp b/lib/Sema/SemaEquivalence.cpp
index 6add96ae0d..9a72ec41cd 100644
--- a/lib/Sema/SemaEquivalence.cpp
+++ b/lib/Sema/SemaEquivalence.cpp
@@ -19,7 +19,7 @@
 #include "flang/AST/Decl.h"
 #include "flang/AST/Expr.h"
 #include "flang/AST/Stmt.h"
-#include "flang/AST/EquivalenceSet.h"
+#include "flang/AST/StorageSet.h"
 #include "flang/AST/ExprVisitor.h"
 #include "flang/Basic/Diagnostic.h"
 
diff --git a/lib/Sema/Spec.cpp b/lib/Sema/Spec.cpp
index 254707a133..9f8131191e 100644
--- a/lib/Sema/Spec.cpp
+++ b/lib/Sema/Spec.cpp
@@ -49,107 +49,122 @@ void Sema::ActOnFunctionSpecificationPart() {
   }
 }
 
-/// Applies the specification statements to the declarations.
-void Sema::ActOnSpecificationPart() {
-  ActOnFunctionSpecificationPart();
-  auto Body = getCurrentBody()->getDeclStatements();
-
-  for(ArrayRef<Stmt*>::iterator I = Body.begin(), End = Body.end();
-      I != End; ++I) {
-    ArrayRef<Stmt*> StmtList;
-
-    auto StmtLoc = (*I)->getLocation();
-    if (const CompoundStmt *BundledStmt = dyn_cast<CompoundStmt>(*I)) {
-      StmtList = BundledStmt->getBody();
-      StmtLoc = BundledStmt->getLocation();
-    }
-    else StmtList = ArrayRef<Stmt*>(*I);
-    for(auto S : StmtList) {
-      if (const DimensionStmt *DimStmt = dyn_cast<DimensionStmt>(S)){
-        ApplySpecification(StmtLoc, DimStmt);
-      }
-      else if(const SaveStmt *SavStmt = dyn_cast<SaveStmt>(S)) {
-        ApplySpecification(StmtLoc, SavStmt);
-      }
-    }
-  }
-}
-
 VarDecl *Sema::GetVariableForSpecification(SourceLocation StmtLoc,
                                            const IdentifierInfo *IDInfo,
                                            SourceLocation IDLoc,
                                            bool CanBeArgument) {
   auto Declaration = LookupIdentifier(IDInfo);
-  if(Declaration) {
-    auto VD = dyn_cast<VarDecl>(Declaration);
-    if(VD && !(VD->isParameter() || (!CanBeArgument && VD->isArgument())))
-      return VD;
-    Diags.Report(StmtLoc, CanBeArgument? diag::err_spec_requires_local_var_arg : diag::err_spec_requires_local_var)
-      << IDInfo << getTokenRange(IDLoc);
-    if(VD) {
-      Diags.Report(Declaration->getLocation(), diag::note_previous_definition_kind)
-          << IDInfo << (VD->isArgument()? 0 : 1)
-          << getTokenRange(Declaration->getLocation());
-    } else
-      Diags.Report(Declaration->getLocation(), diag::note_previous_definition);
-  } else {
-    Diags.Report(IDLoc, diag::err_undeclared_var_use)
-     << IDInfo << getTokenRange(IDLoc);
-  }
-
+  if(!Declaration)
+    return CreateImplicitEntityDecl(Context, IDLoc, IDInfo);
+  auto VD = dyn_cast<VarDecl>(Declaration);
+  if(VD && !(VD->isParameter() || (!CanBeArgument && VD->isArgument()) || VD->isFunctionResult()))
+    return VD;
+  Diags.Report(StmtLoc, CanBeArgument? diag::err_spec_requires_local_var_arg : diag::err_spec_requires_local_var)
+    << IDInfo << getTokenRange(IDLoc);
+  if(VD) {
+    Diags.Report(Declaration->getLocation(), diag::note_previous_definition_kind)
+        << IDInfo << (VD->isArgument()? 0 : 1)
+        << getTokenRange(Declaration->getLocation());
+  } else
+    Diags.Report(Declaration->getLocation(), diag::note_previous_definition);
   return nullptr;
 }
 
-bool Sema::ApplySpecification(SourceLocation StmtLoc, const DimensionStmt *S) {
-  auto VD = GetVariableForSpecification(StmtLoc,
-                                        S->getVariableName(),
-                                        S->getLocation());
+void SpecificationScope::AddDimensionSpec(SourceLocation Loc, SourceLocation IDLoc,
+                                          const IdentifierInfo *IDInfo,
+                                          ArrayRef<ArraySpec*> Dims) {
+  if(Dims.empty())
+    return;
+  auto Start = Dimensions.size();
+  Dimensions.append(Dims.begin(), Dims.end());
+  StoredDimensionSpec Spec = { Loc, IDLoc, IDInfo, Start, Dims.size() };
+  DimensionSpecs.push_back(Spec);
+}
+
+ bool SpecificationScope::IsDimensionAppliedTo(const IdentifierInfo *IDInfo) const {
+   for(auto Spec : DimensionSpecs) {
+     if(Spec.IDInfo == IDInfo) return true;
+   }
+   return false;
+ }
+
+void SpecificationScope::ApplyDimensionSpecs(Sema &Visitor) {
+  for(auto Spec : DimensionSpecs)
+    Visitor.ApplyDimensionSpecification(Spec.Loc, Spec.IDLoc, Spec.IDInfo,
+      llvm::makeArrayRef(Dimensions.begin()+Spec.Offset, Spec.Size));
+}
+
+bool Sema::ApplyDimensionSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                       const IdentifierInfo *IDInfo,
+                                       ArrayRef<ArraySpec*> Dims) {
+  auto VD = GetVariableForSpecification(Loc, IDInfo, IDLoc);
   if(!VD) return true;
   if(isa<ArrayType>(VD->getType())) {
-    Diags.Report(StmtLoc,
+    Diags.Report(Loc,
                  diag::err_spec_dimension_already_array)
-      << S->getVariableName() << getTokenRange(S->getLocation());
+      << VD->getIdentifier();
     return true;
   }
-  else {
-    auto T = ActOnArraySpec(Context, VD->getType(), S->getIDList());
-    VD->setType(T);
-    if(T->isArrayType()) {
-      CheckArrayTypeDeclarationCompability(T->asArrayType(), VD);
-      VD->MarkUsedAsVariable(S->getLocation());
-    }
+
+  auto T = ActOnArraySpec(Context, VD->getType(), Dims);
+  bool IsTypeImplicit = VD->isTypeImplicit();
+  VD->setType(T);
+  if(T->isArrayType()) {
+    CheckArrayTypeDeclarationCompability(T->asArrayType(), VD);
+    VD->MarkUsedAsVariable(Loc);
   }
+  VD->setTypeImplicit(IsTypeImplicit);
   return false;
 }
 
-bool Sema::ApplySpecification(SourceLocation StmtLoc, const SaveStmt *S) {
-  if(!S->getIdentifier()) {
+void SpecificationScope::AddSaveSpec(SourceLocation Loc, SourceLocation IDLoc,
+                                     const IdentifierInfo *IDInfo) {
+  StoredSaveSpec Spec = { Loc, IDLoc, IDInfo };
+  SaveSpecs.push_back(Spec);
+}
+
+void SpecificationScope::AddSaveSpec(SourceLocation Loc, SourceLocation IDLoc,
+                                     CommonBlockDecl *Block) {
+  StoredSaveCommonBlockSpec Spec = { Loc, IDLoc, Block };
+  SaveCommonBlockSpecs.push_back(Spec);
+}
+
+void SpecificationScope::ApplySaveSpecs(Sema &Visitor) {
+  for(auto Spec : SaveSpecs)
+    Visitor.ApplySaveSpecification(Spec.Loc, Spec.IDLoc,
+                                   Spec.IDInfo);
+  for(auto Spec : SaveCommonBlockSpecs)
+    Visitor.ApplySaveSpecification(Spec.Loc, Spec.IDLoc,
+                                   Spec.Block);
+}
+
+bool Sema::ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                  const IdentifierInfo *IDInfo) {
+  if(!IDInfo) {
     for(DeclContext::decl_iterator I = CurContext->decls_begin(),
         End = CurContext->decls_end(); I != End; ++I) {
       auto VD = dyn_cast<VarDecl>(*I);
-      if(VD && !(VD->isParameter() || VD->isArgument())) {
-        ApplySpecification(StmtLoc, S, VD);
+      if(VD && !(VD->isParameter() || VD->isArgument() || VD->isFunctionResult())) {
+        ApplySaveSpecification(Loc, SourceLocation(), VD);
       }
     }
     return false;
   }
-  auto VD = GetVariableForSpecification(StmtLoc,
-                                        S->getIdentifier(),
-                                        S->getLocation(),
-                                        false);
+  auto VD = GetVariableForSpecification(Loc, IDInfo, IDLoc, false);
   if(!VD) return true;
-  return ApplySpecification(StmtLoc, S, VD);
+  return ApplySaveSpecification(Loc, IDLoc, VD);
 }
 
-bool Sema::ApplySpecification(SourceLocation StmtLoc, const SaveStmt *S, VarDecl *VD) {
+bool Sema::ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                  VarDecl *VD) {
   auto Type = VD->getType();
   auto Quals = Type.getQualifiers();
   if(Quals.hasAttributeSpec(Qualifiers::AS_save)) {
-    if(S->getIdentifier()) {
-      Diags.Report(StmtLoc, diag::err_spec_qual_reapplication)
-        << "save" << VD->getIdentifier() << getTokenRange(S->getLocation());
+    if(IDLoc.isValid()) {
+      Diags.Report(Loc, diag::err_spec_qual_reapplication)
+        << "save" << VD->getIdentifier() << getTokenRange(IDLoc);
     } else {
-      Diags.Report(StmtLoc, diag::err_spec_qual_reapplication)
+      Diags.Report(Loc, diag::err_spec_qual_reapplication)
         << "save" << VD->getIdentifier();
     }
     return true;
@@ -159,4 +174,39 @@ bool Sema::ApplySpecification(SourceLocation StmtLoc, const SaveStmt *S, VarDecl
   return false;
 }
 
+bool Sema::ApplySaveSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                  CommonBlockDecl *Block) {
+  return false;
+}
+
+void SpecificationScope::AddCommonSpec(SourceLocation Loc, SourceLocation IDLoc,
+                                       const IdentifierInfo *IDInfo,
+                                       CommonBlockDecl *Block) {
+  StoredCommonSpec Spec = { Loc, IDLoc, IDInfo, Block };
+  CommonSpecs.push_back(Spec);
+}
+
+void SpecificationScope::ApplyCommonSpecs(Sema &Visitor) {
+  for(auto Spec : CommonSpecs)
+    Visitor.ApplyCommonSpecification(Spec.Loc, Spec.IDLoc,
+                                     Spec.IDInfo, Spec.Block);
+}
+
+bool Sema::ApplyCommonSpecification(SourceLocation Loc, SourceLocation IDLoc,
+                                    const IdentifierInfo *IDInfo,
+                                    CommonBlockDecl *Block) {
+  auto VD = GetVariableForSpecification(Loc, IDInfo, IDLoc);
+  if(!VD) return true;
+  return false;
+}
+
+/// Applies the specification statements to the declarations.
+void Sema::ActOnSpecificationPart() {
+  ActOnFunctionSpecificationPart();
+
+  CurSpecScope->ApplyDimensionSpecs(*this);
+  CurSpecScope->ApplyCommonSpecs(*this);
+  CurSpecScope->ApplySaveSpecs(*this);
+}
+
 } // namespace flang
diff --git a/test/Sema/common.f95 b/test/Sema/common.f95
new file mode 100644
index 0000000000..051d46ef6c
--- /dev/null
+++ b/test/Sema/common.f95
@@ -0,0 +1,18 @@
+! RUN: %flang -fsyntax-only -verify < %s
+
+program test
+  integer x,y,z,w
+  integer i_arr
+  common x,y, /a/ z,w
+  common i,r,c
+  common i_arr(22)
+
+  complex c
+
+end program
+
+program sub1
+  dimension i(10)
+  ! FIXME: proper diagnostic
+  common i(10) ! expected-error {{the specification statement 'dimension' cannot be applied to the array variable 'i'}}
+end
diff --git a/test/Sema/dimension.f95 b/test/Sema/dimension.f95
index ec918dc10f..c4e652df25 100644
--- a/test/Sema/dimension.f95
+++ b/test/Sema/dimension.f95
@@ -1,4 +1,6 @@
 ! RUN: %flang -fsyntax-only -verify < %s
+! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
+
 PROGRAM dimtest
   IMPLICIT NONE
 
@@ -23,3 +25,20 @@ PROGRAM dimtest
   DIMENSION A(10), FOO(5:100) ! expected-error {{use of undeclared identifier 'foo'}}
 
 ENDPROGRAM
+
+subroutine sub1
+  dimension i(10)
+  i(1) = 2.0 ! CHECK: i(1) = int(2)
+end
+
+subroutine sub2
+  dimension i(10)
+  complex i
+  i(1) = 1 ! CHECK: i(1) = cmplx(1)
+end
+
+subroutine sub3
+  real i
+  dimension i(10)
+  i(1) = 1 ! CHECK: i(1) = real(1)
+end
diff --git a/test/Sema/save.f95 b/test/Sema/save.f95
index ce37d92d4e..fe1368d6f3 100644
--- a/test/Sema/save.f95
+++ b/test/Sema/save.f95
@@ -1,4 +1,5 @@
 ! RUN: %flang -verify -fsyntax-only < %s
+! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
 
 SUBROUTINE FOO
   INTEGER I
@@ -28,3 +29,13 @@ SUBROUTINE FEZ()
   SAVE var
   SAVE ! expected-error {{the specification statement 'save' cannot be applied to the variable 'var' more than once}}
 END
+
+subroutine sub1
+  save i
+  i = 1.0 ! CHECK: i = int(1)
+end
+
+subroutine sub2
+  implicit none
+  save i ! expected-error {{use of undeclared identifier 'i'}}
+end