[flang] Symbol representation for dummy SubprogramDetails

[klausler]

Summary

Dummy procedures can be defined as subprograms with explicit
interfaces, e.g.

subroutine subr(dummy)
  interface
    subroutine dummy(x)
      real :: x
    end subroutine
  end interface
  ! ...
end subroutine

but the symbol table had no means of marking such symbols as dummy
arguments, so predicates like IsDummy(dummy) would fail. Add an
isDummy_ flag to SubprogramNameDetails, analogous to the corresponding
flag in EntityDetails, and set/test it as needed.

[jeanPerier]

Thanks Peter, LGTM

flang/include/flang/Semantics/symbol.h

private:
   std::optional<std::string> bindName_;
 };
 
 class SubprogramDetails : public WithBindName {
 public:
   bool isFunction() const { return result_ != nullptr; }
   bool isInterface() const { return isInterface_; }
   void set_isInterface(bool value = true) { isInterface_ = value; }
+  bool isDummy() const { return isDummy_; }
+  void set_isDummy(bool value = true) { isDummy_ = value; }
   Scope *entryScope() { return entryScope_; }
   const Scope *entryScope() const { return entryScope_; }
   void set_entryScope(Scope &scope) { entryScope_ = &scope; }
   const Symbol &result() const {
     CHECK(isFunction());
     return *result_;
   }
   void set_result(Symbol &result) {
     CHECK(!result_);
     result_ = &result;
   }
   const std::vector<Symbol *> &dummyArgs() const { return dummyArgs_; }
   void add_dummyArg(Symbol &symbol) { dummyArgs_.push_back(&symbol); }
   void add_alternateReturn() { dummyArgs_.push_back(nullptr); }
   const MaybeExpr &stmtFunction() const { return stmtFunction_; }
   void set_stmtFunction(SomeExpr &&expr) { stmtFunction_ = std::move(expr); }
 
 private:
   bool isInterface_{false}; // true if this represents an interface-body
+  bool isDummy_{false}; // true when interface of dummy procedure
   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 &);
 };
 

flang/lib/Evaluate/check-expression.cpp

bool IsInitialDataTarget(
   }
   return result;
 }
 
 bool IsInitialProcedureTarget(const semantics::Symbol &symbol) {
   const auto &ultimate{symbol.GetUltimate()};
   return std::visit(
       common::visitors{
-          [](const semantics::SubprogramDetails &) { return true; },
+          [](const semantics::SubprogramDetails &subp) {
+            return !subp.isDummy();
+          },
           [](const semantics::SubprogramNameDetails &) { return true; },
           [&](const semantics::ProcEntityDetails &proc) {
             return !semantics::IsPointer(ultimate) && !proc.isDummy();
           },
           [](const auto &) { return false; },
       },
       ultimate.details());
 }

flang/lib/Evaluate/tools.cpp

bool IsSaved(const Symbol &original) {
   }
 }
 
 bool IsDummy(const Symbol &symbol) {
   return std::visit(
       common::visitors{[](const EntityDetails &x) { return x.isDummy(); },
           [](const ObjectEntityDetails &x) { return x.isDummy(); },
           [](const ProcEntityDetails &x) { return x.isDummy(); },
+          [](const SubprogramDetails &x) { return x.isDummy(); },
           [](const auto &) { return false; }},
       ResolveAssociations(symbol).details());
 }
 
 bool IsFunctionResult(const Symbol &original) {
   const Symbol &symbol{GetAssociationRoot(original)};
   return (symbol.has<ObjectEntityDetails>() &&
              symbol.get<ObjectEntityDetails>().isFuncResult()) ||

flang/lib/Semantics/check-declarations.cpp

if (const Scope * entryScope{details.entryScope()}) {
     if (error) {
       if (auto *msg{messages_.Say(symbol.name(), *error)}) {
         if (subprogram) {
           msg->Attach(subprogram->name(), "Containing subprogram"_en_US);
         }
       }
     }
   }
+  // See comment on the similar check in CheckProcEntity()
+  if (details.isDummy() && symbol.attrs().test(Attr::ELEMENTAL)) {
+    messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
+  }
 }
 
 void CheckHelper::CheckDerivedType(
     const Symbol &derivedType, const DerivedTypeDetails &details) {
   if (details.isForwardReferenced() && !context_.HasError(derivedType)) {
     messages_.Say("The derived type '%s' has not been defined"_err_en_US,
         derivedType.name());
   }

flang/lib/Semantics/resolve-names.cpp

if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
           }
           return *derivedType;
         }
       }
     }
     if (symbol->CanReplaceDetails(details)) {
       // update the existing symbol
       symbol->attrs() |= attrs;
+      if constexpr (std::is_same_v<SubprogramDetails, D>) {
+        // Dummy argument defined by explicit interface
+        details.set_isDummy(IsDummy(*symbol));
+      }
       symbol->set_details(std::move(details));
       return *symbol;
     } else if constexpr (std::is_same_v<UnknownDetails, D>) {
       symbol->attrs() |= attrs;
       return *symbol;
     } else {
       if (!CheckPossibleBadForwardRef(*symbol)) {
         SayAlreadyDeclared(name, *symbol);

 }
 bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
 
 void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
   const auto &name{std::get<parser::Name>(stmt.t)};
   auto &details{PostSubprogramStmt(name)};
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
-      Symbol &dummy{MakeSymbol(*dummyName, EntityDetails(true))};
+      Symbol &dummy{MakeSymbol(*dummyName, EntityDetails{true})};
       details.add_dummyArg(dummy);
     } else {
       details.add_alternateReturn();
     }
   }
 }
 
 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   const auto &name{std::get<parser::Name>(stmt.t)};
   auto &details{PostSubprogramStmt(name)};
   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
-    Symbol &dummy{MakeSymbol(dummyName, EntityDetails(true))};
+    Symbol &dummy{MakeSymbol(dummyName, EntityDetails{true})};
     details.add_dummyArg(dummy);
   }
   const parser::Name *funcResultName;
   if (funcInfo_.resultName && funcInfo_.resultName->source != name.source) {
     // Note that RESULT is ignored if it has the same name as the function.
     funcResultName = funcInfo_.resultName;
   } else {
     EraseSymbol(name); // was added by PushSubprogramScope
void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
       Symbol *dummy{FindSymbol(*dummyName)};
       if (dummy) {
         std::visit(
             common::visitors{[](EntityDetails &x) { x.set_isDummy(); },
                 [](ObjectEntityDetails &x) { x.set_isDummy(); },
                 [](ProcEntityDetails &x) { x.set_isDummy(); },
+                [](SubprogramDetails &x) { x.set_isDummy(); },
                 [&](const auto &) {
                   Say2(dummyName->source,
                       "ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US,
                       dummy->name(), "Previous declaration of '%s'"_en_US);
                 }},
             dummy->details());
       } else {
         dummy = &MakeSymbol(*dummyName, EntityDetails{true});
return std::visit(
       common::visitors{
           [=](const parser::Name &y) { return ResolveName(y); },
           [=](const Indirection<parser::StructureComponent> &y) {
             return ResolveStructureComponent(y.value());
           },
           [&](const Indirection<parser::ArrayElement> &y) {
             Walk(y.value().subscripts);
             const parser::Name *name{ResolveDataRef(y.value().base)};
-            if (!name) {
-            } else if (!name->symbol->has<ProcEntityDetails>()) {
+            if (name && name->symbol) {
+              if (!IsProcedure(*name->symbol)) {
                 ConvertToObjectEntity(*name->symbol);
               } else if (!context().HasError(*name->symbol)) {
                 SayWithDecl(*name, *name->symbol,
                     "Cannot reference function '%s' as data"_err_en_US);
               }
+            }
             return name;
           },
           [&](const Indirection<parser::CoindexedNamedObject> &y) {
             Walk(y.value().imageSelector);
             return ResolveDataRef(y.value().base);
           },
       },
       x.u);

flang/lib/Semantics/symbol.cpp

void ModuleDetails::set_scope(const Scope *scope) {
   bool scopeIsSubmodule{scope->parent().kind() == Scope::Kind::Module};
   CHECK(isSubmodule_ == scopeIsSubmodule);
   scope_ = scope;
 }
 
 llvm::raw_ostream &operator<<(
     llvm::raw_ostream &os, const SubprogramDetails &x) {
   DumpBool(os, "isInterface", x.isInterface_);
+  DumpBool(os, "dummy", x.isDummy_);
   DumpOptional(os, "bindName", x.bindName());
   if (x.result_) {
     DumpType(os << " result:", x.result());
     os << x.result_->name();
     if (!x.result_->attrs().empty()) {
       os << ", " << x.result_->attrs();
     }
   }

flang/test/Semantics/call02.f90

 ! RUN: %S/test_errors.sh %s %t %flang_fc1
 ! REQUIRES: shell
 ! 15.5.1 procedure reference constraints and restrictions
 
 subroutine s01(elem, subr)
   interface
+    !ERROR: A dummy procedure may not be ELEMENTAL
     elemental real function elem(x)
       real, intent(in), value :: x
     end function
     subroutine subr(dummy)
       procedure(sin) :: dummy
     end subroutine
     subroutine badsubr(dummy)
       import :: elem