added error for duplicate external attributes

8 files changed, 98 insertions, 17 deletions

diff --git a/include/flang/AST/ASTContext.h b/include/flang/AST/ASTContext.h
index 509926d80d..d9b04d7448 100644
--- a/include/flang/AST/ASTContext.h
+++ b/include/flang/AST/ASTContext.h
@@ -177,6 +177,7 @@ public:
   }
 
   // Builtin Types: [R404]
+  QualType VoidTy;
   QualType IntegerTy;
   QualType RealTy;
   QualType DoublePrecisionTy;
diff --git a/include/flang/AST/Type.h b/include/flang/AST/Type.h
index 01615660a8..4bbb4ded5d 100644
--- a/include/flang/AST/Type.h
+++ b/include/flang/AST/Type.h
@@ -518,6 +518,8 @@ public:
   /// Helper methods to distinguish type categories. All type predicates
   /// operate on the canonical type ignoring qualifiers.
 
+  bool isVoidType() const;
+
   /// isBuiltinType - returns true if the type is a builtin type.
   bool isBuiltinType() const;
   bool isIntegerType() const;
@@ -539,6 +541,18 @@ public:
   static bool classof(const Type *) { return true; }
 };
 
+/// VoidType
+class VoidType : public Type {
+protected:
+  friend class ASTContext;      // ASTContext creates these.
+  VoidType()
+    : Type(Void, QualType()) {}
+
+public:
+  static bool classof(const Type *T) { return T->getTypeClass() == Void; }
+  static bool classof(const VoidType *) { return true; }
+};
+
 /// BuiltinType - Intrinsic Fortran types.
 class BuiltinType : public Type {
 public:
@@ -885,6 +899,9 @@ inline QualType QualType::getSelfOrArrayElementType() const {
   return *this;
 }
 
+inline bool Type::isVoidType() const {
+  return isa<VoidType>(CanonicalType);
+}
 inline bool Type::isBuiltinType() const {
   return isa<BuiltinType>(CanonicalType);
 }
diff --git a/include/flang/AST/TypeNodes.def b/include/flang/AST/TypeNodes.def
index 8ebb5d6e25..1856db4457 100644
--- a/include/flang/AST/TypeNodes.def
+++ b/include/flang/AST/TypeNodes.def
@@ -15,6 +15,7 @@
   #define BUILTIN_TYPE(Name)
 #endif
 
+TYPE(Void, Type)
 TYPE(Builtin, Type)
 BUILTIN_TYPE(Integer)
 BUILTIN_TYPE(Real)
diff --git a/lib/AST/ASTContext.cpp b/lib/AST/ASTContext.cpp
index 9110152969..22cf8882ce 100644
--- a/lib/AST/ASTContext.cpp
+++ b/lib/AST/ASTContext.cpp
@@ -39,6 +39,7 @@ void ASTContext::InitBuiltinType(QualType &R, BuiltinType::TypeSpec K) {
 
 void ASTContext::InitBuiltinTypes() {
   // [R404]
+  VoidTy = QualType(new (*this, TypeAlignment) VoidType(), 0);
   InitBuiltinType(IntegerTy,         BuiltinType::Integer);
   InitBuiltinType(RealTy,            BuiltinType::Real);
   DoublePrecisionTy = getExtQualType(RealTy.getTypePtr(), Qualifiers(),
diff --git a/lib/CodeGen/CGABI.cpp b/lib/CodeGen/CGABI.cpp
index c570ad8a95..374ca8a559 100644
--- a/lib/CodeGen/CGABI.cpp
+++ b/lib/CodeGen/CGABI.cpp
@@ -22,7 +22,7 @@ ABIArgInfo FortranABI::GetArgABI(QualType ArgType) {
 }
 
 ABIRetInfo FortranABI::GetRetABI(QualType RetType) {
-  if(RetType.isNull())
+  if(RetType.isNull() || RetType->isVoidType())
     return ABIRetInfo(ABIRetInfo::Nothing);
   if(RetType->isCharacterType())
     return ABIRetInfo(ABIRetInfo::CharacterValueAsArg);
diff --git a/lib/Sema/Sema.cpp b/lib/Sema/Sema.cpp
index 97702bbe01..d16e86a7e9 100644
--- a/lib/Sema/Sema.cpp
+++ b/lib/Sema/Sema.cpp
@@ -279,23 +279,12 @@ void Sema::ActOnEndMainProgram(SourceLocation Loc) {
 
 bool Sema::IsValidFunctionType(QualType Type) {
   if(Type->isIntegerType() || Type->isRealType() || Type->isComplexType() ||
-     Type->isCharacterType() || Type->isLogicalType() || Type->isRecordType())
+     Type->isCharacterType() || Type->isLogicalType() || Type->isRecordType() ||
+     Type->isVoidType())
     return true;
   return false;
 }
 
-void Sema::SetFunctionType(FunctionDecl *Function, QualType Type,
-                           SourceLocation DiagLoc, SourceRange DiagRange) {
-  if(!IsValidFunctionType(Type)) {
-    Diags.Report(DiagLoc, diag::err_func_invalid_type)
-      << Function->getIdentifier(); // FIXME: add diag range.
-    return;
-  }
-  Function->setType(Type);
-  if(Function->hasResult())
-    Function->getResult()->setType(Type);
-}
-
 FunctionDecl *Sema::ActOnSubProgram(ASTContext &C, SubProgramScope &Scope,
                                     bool IsSubRoutine, SourceLocation IDLoc,
                                     const IdentifierInfo *IDInfo, DeclSpec &ReturnTypeDecl,
diff --git a/lib/Sema/SemaDecl.cpp b/lib/Sema/SemaDecl.cpp
index 444bcb5034..c0bd4682d9 100644
--- a/lib/Sema/SemaDecl.cpp
+++ b/lib/Sema/SemaDecl.cpp
@@ -171,11 +171,47 @@ QualType Sema::ActOnTypeName(ASTContext &C, DeclSpec &DS) {
 // Entity declarations.
 //
 
+static Qualifiers getDeclQualifiers(const Decl *D) {
+  if(auto Value = dyn_cast<ValueDecl>(D))
+    return Value->getType().split().second;
+  return Qualifiers();
+}
+
+static QualType getTypeWithAttribute(ASTContext &C, QualType T, Qualifiers::AS AS) {
+  auto Split = T.split();
+  if(Split.second.hasAttributeSpec(AS))
+    return T;
+  QualifierCollector QC(Split.second);
+  QC.addAttributeSpecs(AS);
+  return C.getQualifiedType(T, QC);
+}
+
+void Sema::SetFunctionType(FunctionDecl *Function, QualType Type,
+                           SourceLocation DiagLoc, SourceRange DiagRange) {
+  if(Function->isExternal())
+    Type = getTypeWithAttribute(Context, Type, Qualifiers::AS_external);
+  if(!IsValidFunctionType(Type)) {
+    Diags.Report(DiagLoc, diag::err_func_invalid_type)
+      << Function->getIdentifier(); // FIXME: add diag range.
+    return;
+  }
+  Function->setType(Type);
+  if(Function->hasResult())
+    Function->getResult()->setType(Type);
+}
+
 Decl *Sema::ActOnExternalEntityDecl(ASTContext &C, QualType T,
                                     SourceLocation IDLoc, const IdentifierInfo *IDInfo) {
   SourceLocation TypeLoc;
   VarDecl *ArgumentExternal = nullptr;
   if (auto Prev = LookupIdentifier(IDInfo)) {
+    auto Quals = getDeclQualifiers(Prev);
+    if(Quals.hasAttributeSpec(Qualifiers::AS_external)) {
+      Diags.Report(IDLoc, diag::err_duplicate_attr_spec)
+        << DeclSpec::getSpecifierName(Qualifiers::AS_external);
+      return Prev;
+    }
+
     // apply EXTERNAL to an unused symbol or an argument.
     auto VD = dyn_cast<VarDecl>(Prev);
     if(VD && (VD->isUnusedSymbol() || VD->isArgument()) ) {
@@ -189,13 +225,14 @@ Decl *Sema::ActOnExternalEntityDecl(ASTContext &C, QualType T,
       return nullptr;
     }
   }
+  if(T.isNull())
+    T = C.VoidTy;
 
   DeclarationNameInfo DeclName(IDInfo,IDLoc);
   auto Decl = FunctionDecl::Create(C, ArgumentExternal? FunctionDecl::ExternalArgument :
                                                         FunctionDecl::External,
                                    CurContext, DeclName, T);
-  if(!T.isNull())
-    SetFunctionType(Decl, T, TypeLoc, SourceRange()); //FIXME: proper loc, and range
+  SetFunctionType(Decl, T, TypeLoc, SourceRange()); //FIXME: proper loc, and range
   CurContext->addDecl(Decl);
   if(ArgumentExternal)
     ArgumentExternal->setType(C.getFunctionType(Decl));
@@ -213,6 +250,13 @@ Decl *Sema::ActOnIntrinsicEntityDecl(ASTContext &C, QualType T,
 
   QualType Type = T.isNull()? C.RealTy : T;
   if (auto Prev = LookupIdentifier(IDInfo)) {
+    auto Quals = getDeclQualifiers(Prev);
+    if(Quals.hasAttributeSpec(Qualifiers::AS_intrinsic)) {
+      Diags.Report(IDLoc, diag::err_duplicate_attr_spec)
+        << DeclSpec::getSpecifierName(Qualifiers::AS_intrinsic);
+      return Prev;
+    }
+
     auto VD = dyn_cast<VarDecl>(Prev);
     if(VD && VD->isUnusedSymbol()) {
       Type = VD->getType();
@@ -294,7 +338,7 @@ Decl *Sema::ActOnEntityDecl(ASTContext &C, const QualType &T,
     }
 
     if(FD && (FD->isNormalFunction() || FD->isExternal())) {
-      if(FD->getType().isNull()) {
+      if(FD->getType().isNull() || FD->getType()->isVoidType()) {
         SetFunctionType(FD, T, IDLoc, SourceRange()); //Fixme: proper loc and range
         return FD;
       } else {
diff --git a/test/Sema/external.f95 b/test/Sema/external.f95
index e81ea71fd2..2bff9ed51c 100644
--- a/test/Sema/external.f95
+++ b/test/Sema/external.f95
@@ -24,3 +24,31 @@ PROGRAM exttest
   C = F4(I) ! CHECK: c = f4(i)
 
 END PROGRAM
+
+subroutine abc1()
+   external a
+   external a ! expected-error {{duplicate 'external' attribute specifier}}
+end
+
+subroutine abc2()
+   integer, external :: a
+   external a ! expected-error {{duplicate 'external' attribute specifier}}
+end
+
+subroutine abc3()
+   external a
+   integer a
+   external a ! expected-error {{duplicate 'external' attribute specifier}}
+end
+
+subroutine abc4()
+  external a
+  integer, external :: a ! expected-error {{duplicate 'external' attribute specifier}}
+end
+
+subroutine abc5()
+  integer, external :: a
+  integer, external :: a ! expected-error {{duplicate 'external' attribute specifier}}
+end
+
+