[flang] Semantics for ENTRY

initial test passes

Move some checks to check-declarations

Fix bugs found in testing

Get tests all passing

Allow declaration statements for function result to follow ENTRY

Fix another bug

Original-commit: flang-compiler/f18@e82cfee432
Reviewed-on: https://github.com/flang-compiler/f18/pull/1086

flang/include/flang/Semantics/symbol.h

@@ -61,6 +61,9 @@ public:
   bool isFunction() const { return result_ != nullptr; }
   bool isInterface() const { return isInterface_; }
   void set_isInterface(bool value = true) { isInterface_ = value; }
+  Scope *entryScope() { return entryScope_; }
+  const Scope *entryScope() const { return entryScope_; }
+  void set_entryScope(Scope &scope) { entryScope_ = &scope; }
   MaybeExpr bindName() const { return bindName_; }
   void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
   const Symbol &result() const {
@@ -82,8 +85,10 @@ private:
   MaybeExpr bindName_;
   std::vector<Symbol *> dummyArgs_;  // nullptr -> alternate return indicator
   Symbol *result_{nullptr};
+  Scope *entryScope_{nullptr};  // if ENTRY, points to subprogram's scope
   MaybeExpr stmtFunction_;
-  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const SubprogramDetails &);
+  friend llvm::raw_ostream &operator<<(
+      llvm::raw_ostream &, const SubprogramDetails &);
 };
 
 // For SubprogramNameDetails, the kind indicates whether it is the name
@@ -115,17 +120,19 @@ public:
   void set_type(const DeclTypeSpec &);
   void ReplaceType(const DeclTypeSpec &);
   bool isDummy() const { return isDummy_; }
+  void set_isDummy(bool value = true) { isDummy_ = value; }
   bool isFuncResult() const { return isFuncResult_; }
   void set_funcResult(bool x) { isFuncResult_ = x; }
   MaybeExpr bindName() const { return bindName_; }
   void set_bindName(MaybeExpr &&expr) { bindName_ = std::move(expr); }
 
 private:
-  bool isDummy_;
+  bool isDummy_{false};
   bool isFuncResult_{false};
   const DeclTypeSpec *type_{nullptr};
   MaybeExpr bindName_;
-  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const EntityDetails &);
+  friend llvm::raw_ostream &operator<<(
+      llvm::raw_ostream &, const EntityDetails &);
 };
 
 // Symbol is associated with a name or expression in a SELECT TYPE or ASSOCIATE.
@@ -180,7 +187,8 @@ private:
   ArraySpec shape_;
   ArraySpec coshape_;
   const Symbol *commonBlock_{nullptr};  // common block this object is in
-  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ObjectEntityDetails &);
+  friend llvm::raw_ostream &operator<<(
+      llvm::raw_ostream &, const ObjectEntityDetails &);
 };
 
 // Mixin for details with passed-object dummy argument.
@@ -217,7 +225,8 @@ public:
 private:
   ProcInterface interface_;
   std::optional<const Symbol *> init_;
-  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ProcEntityDetails &);
+  friend llvm::raw_ostream &operator<<(
+      llvm::raw_ostream &, const ProcEntityDetails &);
 };
 
 // These derived type details represent the characteristics of a derived
@@ -263,7 +272,8 @@ private:
   std::list<SourceName> componentNames_;
   bool sequence_{false};
   bool isForwardReferenced_{false};
-  friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const DerivedTypeDetails &);
+  friend llvm::raw_ostream &operator<<(
+      llvm::raw_ostream &, const DerivedTypeDetails &);
 };
 
 class ProcBindingDetails : public WithPassArg {
@@ -570,7 +580,6 @@ public:
   bool IsFuncResult() const;
   bool IsObjectArray() const;
   bool IsSubprogram() const;
-  bool IsSeparateModuleProc() const;
   bool IsFromModFile() const;
   bool HasExplicitInterface() const {
     return std::visit(
@@ -662,7 +671,8 @@ private:
   Symbol() {}  // only created in class Symbols
   const std::string GetDetailsName() const;
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
-  friend llvm::raw_ostream &DumpForUnparse(llvm::raw_ostream &, const Symbol &, bool);
+  friend llvm::raw_ostream &DumpForUnparse(
+      llvm::raw_ostream &, const Symbol &, bool);
 
   // If a derived type's symbol refers to an extended derived type,
   // return the parent component's symbol.  The scope of the derived type

flang/include/flang/Semantics/tools.h

@@ -108,6 +108,7 @@ bool IsSaved(const Symbol &);
 bool CanBeTypeBoundProc(const Symbol *);
 bool IsInitialized(const Symbol &);
 bool HasIntrinsicTypeName(const Symbol &);
+bool IsSeparateModuleProcedureInterface(const Symbol *);
 
 // Return an ultimate component of type that matches predicate, or nullptr.
 const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,
@@ -164,7 +165,7 @@ inline bool IsAssumedRankArray(const Symbol &symbol) {
   return details && details->IsAssumedRank();
 }
 bool IsAssumedLengthCharacter(const Symbol &);
-bool IsAssumedLengthExternalCharacterFunction(const Symbol &);
+bool IsExternal(const Symbol &);
 // Is the symbol modifiable in this scope
 std::optional<parser::MessageFixedText> WhyNotModifiable(
     const Symbol &, const Scope &);
@@ -200,6 +201,11 @@ std::list<SourceName> OrderParameterNames(const Symbol &);
 const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
     SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
 
+// When a subprogram defined in a submodule defines a separate module
+// procedure whose interface is defined in an ancestor (sub)module,
+// returns a pointer to that interface, else null.
+const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
+
 // Determines whether an object might be visible outside a
 // pure function (C1594); returns a non-null Symbol pointer for
 // diagnostic purposes if so.

flang/lib/Semantics/check-declarations.cpp

@@ -24,6 +24,7 @@ namespace Fortran::semantics {
 using evaluate::characteristics::DummyArgument;
 using evaluate::characteristics::DummyDataObject;
 using evaluate::characteristics::DummyProcedure;
+using evaluate::characteristics::FunctionResult;
 using evaluate::characteristics::Procedure;
 
 class CheckHelper {
@@ -109,6 +110,7 @@ private:
       }
     }
   }
+  bool IsResultOkToDiffer(const FunctionResult &);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -208,7 +210,8 @@ void CheckHelper::Check(const Symbol &symbol) {
   }
   if (type) {  // Section 7.2, paragraph 7
     bool canHaveAssumedParameter{IsNamedConstant(symbol) ||
-        IsAssumedLengthExternalCharacterFunction(symbol) ||  // C722
+        (IsAssumedLengthCharacter(symbol) &&  // C722
+            IsExternal(symbol)) ||
         symbol.test(Symbol::Flag::ParentComp)};
     if (!IsStmtFunctionDummy(symbol)) {  // C726
       if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
@@ -239,7 +242,7 @@ void CheckHelper::Check(const Symbol &symbol) {
       }
     }
   }
-  if (IsAssumedLengthExternalCharacterFunction(symbol)) {  // C723
+  if (IsAssumedLengthCharacter(symbol) && IsExternal(symbol)) {  // C723
     if (symbol.attrs().test(Attr::RECURSIVE)) {
       messages_.Say(
           "An assumed-length CHARACTER(*) function cannot be RECURSIVE"_err_en_US);
@@ -270,6 +273,16 @@ void CheckHelper::Check(const Symbol &symbol) {
       symbol.Rank() == 0) {  // C830
     messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
   }
+  if (IsDummy(symbol)) {
+    if (IsNamedConstant(symbol)) {
+      messages_.Say(
+          "A dummy argument may not also be a named constant"_err_en_US);
+    }
+    if (IsSaved(symbol)) {
+      messages_.Say(
+          "A dummy argument may not have the SAVE attribute"_err_en_US);
+    }
+  }
 }
 
 void CheckHelper::CheckValue(
@@ -600,12 +613,66 @@ private:
   SemanticsContext &context;
 };
 
+// 15.6.2.6 para 3 - can the result of an ENTRY differ from its function?
+bool CheckHelper::IsResultOkToDiffer(const FunctionResult &result) {
+  if (result.attrs.test(FunctionResult::Attr::Allocatable) ||
+      result.attrs.test(FunctionResult::Attr::Pointer)) {
+    return false;
+  }
+  const auto *typeAndShape{result.GetTypeAndShape()};
+  if (!typeAndShape || typeAndShape->Rank() != 0) {
+    return false;
+  }
+  auto category{typeAndShape->type().category()};
+  if (category == TypeCategory::Character ||
+      category == TypeCategory::Derived) {
+    return false;
+  }
+  int kind{typeAndShape->type().kind()};
+  return kind == context_.GetDefaultKind(category) ||
+      (category == TypeCategory::Real &&
+          kind == context_.doublePrecisionKind());
+}
+
 void CheckHelper::CheckSubprogram(
-    const Symbol &symbol, const SubprogramDetails &) {
-  const Scope &scope{symbol.owner()};
-  if (symbol.attrs().test(Attr::MODULE) && scope.IsSubmodule()) {
-    if (const Symbol * iface{scope.parent().FindSymbol(symbol.name())}) {
-      SubprogramMatchHelper{context_}.Check(symbol, *iface);
+    const Symbol &symbol, const SubprogramDetails &details) {
+  if (const Symbol * iface{FindSeparateModuleSubprogramInterface(&symbol)}) {
+    SubprogramMatchHelper{context_}.Check(symbol, *iface);
+  }
+  if (const Scope * entryScope{details.entryScope()}) {
+    // ENTRY 15.6.2.6, esp. C1571
+    std::optional<parser::MessageFixedText> error;
+    const Symbol *subprogram{entryScope->symbol()};
+    const SubprogramDetails *subprogramDetails{nullptr};
+    if (subprogram) {
+      subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
+    }
+    if (entryScope->kind() != Scope::Kind::Subprogram) {
+      error = "ENTRY may appear only in a subroutine or function"_err_en_US;
+    } else if (!(entryScope->parent().IsGlobal() ||
+                   entryScope->parent().IsModule() ||
+                   entryScope->parent().IsSubmodule())) {
+      error = "ENTRY may not appear in an internal subprogram"_err_en_US;
+    } else if (FindSeparateModuleSubprogramInterface(subprogram)) {
+      error = "ENTRY may not appear in a separate module procedure"_err_en_US;
+    } else if (subprogramDetails && details.isFunction() &&
+        subprogramDetails->isFunction()) {
+      auto result{FunctionResult::Characterize(
+          details.result(), context_.intrinsics())};
+      auto subpResult{FunctionResult::Characterize(
+          subprogramDetails->result(), context_.intrinsics())};
+      if (result && subpResult && *result != *subpResult &&
+          (!IsResultOkToDiffer(*result) || !IsResultOkToDiffer(*subpResult))) {
+        error =
+            "Result of ENTRY is not compatible with result of containing function"_err_en_US;
+      }
+    }
+    if (error) {
+      if (auto *msg{messages_.Say(symbol.name(), *error)}) {
+        if (subprogram) {
+          msg->Attach(subprogram->name(), "Containing subprogram"_en_US);
+        }
+      }
     }
   }
 }

flang/lib/Semantics/expression.cpp

@@ -1889,7 +1889,7 @@ void ExpressionAnalyzer::CheckForBadRecursion(
       if (proc.attrs().test(semantics::Attr::NON_RECURSIVE)) {  // 15.6.2.1(3)
         msg = Say("NON_RECURSIVE procedure '%s' cannot call itself"_err_en_US,
             callSite);
-      } else if (IsAssumedLengthExternalCharacterFunction(proc)) {
+      } else if (IsAssumedLengthCharacter(proc) && IsExternal(proc)) {
         msg = Say(  // 15.6.2.1(3)
             "Assumed-length CHARACTER(*) function '%s' cannot call itself"_err_en_US,
             callSite);
@@ -2046,7 +2046,8 @@ static bool IsExternalCalledImplicitly(
   if (const auto *symbol{proc.GetSymbol()}) {
     return symbol->has<semantics::SubprogramDetails>() &&
         symbol->owner().IsGlobal() &&
-        !symbol->scope()->sourceRange().Contains(callSite);
+        (!symbol->scope() /*ENTRY*/ ||
+            !symbol->scope()->sourceRange().Contains(callSite));
   } else {
     return false;
   }

flang/lib/Semantics/mod-file.cpp

@@ -69,8 +69,8 @@ static std::string CheckSum(const std::string_view &);
 // Collect symbols needed for a subprogram interface
 class SubprogramSymbolCollector {
 public:
-  SubprogramSymbolCollector(const Symbol &symbol)
-    : symbol_{symbol}, scope_{DEREF(symbol.scope())} {}
+  SubprogramSymbolCollector(const Symbol &symbol, const Scope &scope)
+    : symbol_{symbol}, scope_{scope} {}
   const SymbolVector &symbols() const { return need_; }
   const std::set<SourceName> &imports() const { return imports_; }
   void Collect();
@@ -335,12 +335,14 @@ void ModFileWriter::PutSubprogram(const Symbol &symbol) {
   }
   os << '\n';
 
-  // walk symbols, collect ones needed
-  ModFileWriter writer{context_};
+  // walk symbols, collect ones needed for interface
+  const Scope &scope{
+      details.entryScope() ? *details.entryScope() : DEREF(symbol.scope())};
+  SubprogramSymbolCollector collector{symbol, scope};
+  collector.Collect();
   std::string typeBindingsBuf;
   llvm::raw_string_ostream typeBindings{typeBindingsBuf};
-  SubprogramSymbolCollector collector{symbol};
-  collector.Collect();
+  ModFileWriter writer{context_};
   for (const Symbol &need : collector.symbols()) {
     writer.PutSymbol(typeBindings, need);
   }

flang/lib/Semantics/semantics.cpp

@@ -112,10 +112,23 @@ private:
   SemanticsContext &context_;
 };
 
+class EntryChecker : public virtual BaseChecker {
+public:
+  explicit EntryChecker(SemanticsContext &context) : context_{context} {}
+  void Leave(const parser::EntryStmt &) {
+    if (!context_.constructStack().empty()) {  // C1571
+      context_.Say("ENTRY may not appear in an executable construct"_err_en_US);
+    }
+  }
+
+private:
+  SemanticsContext &context_;
+};
+
 using StatementSemanticsPass1 = ExprChecker;
 using StatementSemanticsPass2 = SemanticsVisitor<AllocateChecker,
     ArithmeticIfStmtChecker, AssignmentChecker, CoarrayChecker, DataChecker,
-    DeallocateChecker, DoForallChecker, IfStmtChecker, IoChecker,
+    DeallocateChecker, DoForallChecker, EntryChecker, IfStmtChecker, IoChecker,
     NamelistChecker, NullifyChecker, OmpStructureChecker, PurityChecker,
     ReturnStmtChecker, StopChecker>;
 

flang/lib/Semantics/symbol.cpp

@@ -92,6 +92,12 @@ llvm::raw_ostream &operator<<(
       os << ", " << x.result_->attrs();
     }
   }
+  if (x.entryScope_) {
+    os << " entry";
+    if (x.entryScope_->symbol()) {
+      os << " in " << x.entryScope_->symbol()->name();
+    }
+  }
   char sep{'('};
   os << ' ';
   for (const Symbol *arg : x.dummyArgs_) {
@@ -318,15 +324,6 @@ bool Symbol::IsSubprogram() const {
       details_);
 }
 
-bool Symbol::IsSeparateModuleProc() const {
-  if (attrs().test(Attr::MODULE)) {
-    if (auto *details{detailsIf<SubprogramDetails>()}) {
-      return details->isInterface();
-    }
-  }
-  return false;
-}
-
 bool Symbol::IsFromModFile() const {
   return test(Flag::ModFile) ||
       (!owner_->IsGlobal() && owner_->symbol()->IsFromModFile());

flang/lib/Semantics/tools.cpp

@@ -690,6 +690,15 @@ bool HasIntrinsicTypeName(const Symbol &symbol) {
   }
 }
 
+bool IsSeparateModuleProcedureInterface(const Symbol *symbol) {
+  if (symbol && symbol->attrs().test(Attr::MODULE)) {
+    if (auto *details{symbol->detailsIf<SubprogramDetails>()}) {
+      return details->isInterface();
+    }
+  }
+  return false;
+}
+
 bool IsFinalizable(const Symbol &symbol) {
   if (const DeclTypeSpec * type{symbol.GetType()}) {
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
@@ -729,11 +738,9 @@ bool IsAssumedLengthCharacter(const Symbol &symbol) {
 
 // C722 and C723:  For a function to be assumed length, it must be external and
 // of CHARACTER type
-bool IsAssumedLengthExternalCharacterFunction(const Symbol &symbol) {
-  return IsAssumedLengthCharacter(symbol) &&
-      ((symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
-          (symbol.test(Symbol::Flag::Function) &&
-              symbol.attrs().test(Attr::EXTERNAL)));
+bool IsExternal(const Symbol &symbol) {
+  return (symbol.has<SubprogramDetails>() && symbol.owner().IsGlobal()) ||
+      symbol.attrs().test(Attr::EXTERNAL);
 }
 
 const Symbol *IsExternalInPureContext(
@@ -1022,6 +1029,22 @@ const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
   return type;
 }
 
+const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) {
+  if (proc) {
+    if (const Symbol * submodule{proc->owner().symbol()}) {
+      if (const auto *details{submodule->detailsIf<ModuleDetails>()}) {
+        if (const Scope * ancestor{details->ancestor()}) {
+          const Symbol *iface{ancestor->FindSymbol(proc->name())};
+          if (IsSeparateModuleProcedureInterface(iface)) {
+            return iface;
+          }
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
 // ComponentIterator implementation
 
 template<ComponentKind componentKind>

flang/test/Semantics/assign04.f90

@@ -14,6 +14,7 @@ end
 
 ! C901
 subroutine s2(x)
+  !ERROR: A dummy argument may not also be a named constant
   real, parameter :: x = 0.0
   real, parameter :: a(*) = [1, 2, 3]
   character, parameter :: c(2) = "ab"

flang/test/Semantics/entry01.f90

@@ -0,0 +1,184 @@
+! RUN: %S/test_errors.sh %s %flang %t
+! Tests valid and invalid ENTRY statements
+
+module m1
+  !ERROR: ENTRY may appear only in a subroutine or function
+  entry badentryinmodule
+  interface
+    module subroutine separate
+    end subroutine
+  end interface
+ contains
+  subroutine modproc
+    entry entryinmodproc ! ok
+    block
+      !ERROR: ENTRY may not appear in an executable construct
+      entry badentryinblock ! C1571
+    end block
+    if (.true.) then
+      !ERROR: ENTRY may not appear in an executable construct
+      entry ibadconstr() ! C1571
+    end if
+   contains
+    subroutine internal
+      !ERROR: ENTRY may not appear in an internal subprogram
+      entry badentryininternal ! C1571
+    end subroutine
+  end subroutine
+end module
+
+submodule(m1) m1s1
+ contains
+  module procedure separate
+    !ERROR: ENTRY may not appear in a separate module procedure
+    entry badentryinsmp ! 1571
+  end procedure
+end submodule
+
+program main
+  !ERROR: ENTRY may appear only in a subroutine or function
+  entry badentryinprogram ! C1571
+end program
+
+block data bd1
+  !ERROR: ENTRY may appear only in a subroutine or function
+  entry badentryinbd ! C1571
+end block data
+
+subroutine subr(goodarg1)
+  real, intent(in) :: goodarg1
+  real :: goodarg2
+  !ERROR: A dummy argument may not also be a named constant
+  integer, parameter :: badarg1 = 1
+  type :: badarg2
+  end type
+  common /badarg3/ x
+  namelist /badarg4/ x
+  !ERROR: A dummy argument may not have the SAVE attribute
+  integer :: badarg5 = 2
+  entry okargs(goodarg1, goodarg2)
+  !ERROR: RESULT(br1) may appear only in a function
+  entry badresult() result(br1) ! C1572
+  !ERROR: ENTRY dummy argument 'badarg2' is previously declared as an item that may not be used as a dummy argument
+  !ERROR: ENTRY dummy argument 'badarg4' is previously declared as an item that may not be used as a dummy argument
+  entry badargs(badarg1,badarg2,badarg3,badarg4,badarg5)
+end subroutine
+
+function ifunc()
+  integer :: ifunc
+  integer :: ibad1
+  type :: ibad2
+  end type
+  save :: ibad3
+  real :: weird1
+  double precision :: weird2
+  complex :: weird3
+  logical :: weird4
+  character :: weird5
+  type(ibad2) :: weird6
+  integer :: iarr(1)
+  integer, allocatable :: alloc
+  integer, pointer :: ptr
+  entry iok1()
+  !ERROR: ENTRY name 'ibad1' may not be declared when RESULT() is present
+  entry ibad1() result(ibad1res) ! C1570
+  !ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
+  entry ibad2()
+  !ERROR: ENTRY in a function may not have an alternate return dummy argument
+  entry ibadalt(*) ! C1573
+  !ERROR: RESULT(ifunc) may not have the same name as the function
+  entry isameres() result(ifunc) ! C1574
+  entry iok()
+  !ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
+  entry isameres2() result(iok) ! C1574
+  entry isameres3() result(iok2) ! C1574
+  entry iok2()
+  !These cases are all acceptably incompatible
+  entry iok3() result(weird1)
+  entry iok4() result(weird2)
+  entry iok5() result(weird3)
+  entry iok6() result(weird4)
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry ibadt1() result(weird5)
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry ibadt2() result(weird6)
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry ibadt3() result(iarr)
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry ibadt4() result(alloc)
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry ibadt5() result(ptr)
+  call isubr
+  !ERROR: 'isubr' was previously called as a subroutine
+  entry isubr()
+  continue ! force transition to execution part
+  entry implicit()
+  implicit = 666 ! ok, just ensure that it works
+end function
+
+function chfunc() result(chr)
+  character(len=1) :: chr
+  character(len=2) :: chr1
+  !ERROR: Result of ENTRY is not compatible with result of containing function
+  entry chfunc1() result(chr1)
+end function
+
+subroutine externals
+  !ERROR: 'subr' is already defined as a global identifier
+  entry subr
+  !ERROR: 'ifunc' is already defined as a global identifier
+  entry ifunc
+  !ERROR: 'm1' is already defined as a global identifier
+  entry m1
+  !ERROR: 'iok1' is already defined as a global identifier
+  entry iok1
+  integer :: ix
+  ix = iproc()
+  !ERROR: 'iproc' was previously called as a function
+  entry iproc
+end subroutine
+
+module m2
+  external m2entry2
+ contains
+  subroutine m2subr1
+    entry m2entry1 ! ok
+    entry m2entry2 ! ok
+    entry m2entry3 ! ok
+  end subroutine
+end module
+
+subroutine usem2
+  use m2
+  interface
+    subroutine simplesubr
+    end subroutine
+  end interface
+  procedure(simplesubr), pointer :: p
+  p => m2subr1 ! ok
+  p => m2entry1 ! ok
+  p => m2entry2 ! ok
+  p => m2entry3 ! ok
+end subroutine
+
+module m3
+  interface
+    module subroutine m3entry1
+    end subroutine
+  end interface
+ contains
+  subroutine m3subr1
+    !ERROR: 'm3entry1' is already declared in this scoping unit
+    entry m3entry1
+  end subroutine
+end module
+
+function inone
+  implicit none
+  integer :: inone
+  !ERROR: No explicit type declared for 'implicitbad1'
+  entry implicitbad1
+  inone = 0 ! force transition to execution part
+  !ERROR: No explicit type declared for 'implicitbad2'
+  entry implicitbad2
+end