[flang] Fix bug with intrinsic in type declaration stmt

[tskeith]

Summary

When an instrinsic function is declared in a type declaration statement
we need to set the INTRINSIC attribute and (per 8.2(3)) ignore the
specified type.

To simplify the check, add IsIntrinsic utility to BaseVisitor.

Also, intrinsics and external procedures were getting assigned a size
and offset and they shouldn't be.

[klausler]

flang/lib/Semantics/resolve-names.cpp

5737

Can you really ignore the type? Should not INTEGER :: ASIN be an error?

[tskeith]

flang/lib/Semantics/resolve-names.cpp

5737

It explicitly not an error. 8.2(3) says "Specifying a type for a generic intrinsic function name in a type declaration statement has no effect."

All of the compilers that I tried accepted it without comment except for NAG which warned "Type declaration for generic intrinsic ASIN ignored".

[PeteSteinfeld]

All builds, tests, and looks good.

Note that the latest version of clang-format shows diffs on resolve-names.cpp unrelated to your changes.

flang/include/flang/Semantics/symbol.h

 // A procedure pointer, dummy procedure, or external procedure
 class ProcEntityDetails : public EntityDetails, public WithPassArg {
 public:
   ProcEntityDetails() = default;
   explicit ProcEntityDetails(EntityDetails &&d);
 
   const ProcInterface &interface() const { return interface_; }
   ProcInterface &interface() { return interface_; }
-  void set_interface(const ProcInterface &interface) {
-    CHECK(!IsInterfaceSet());
-    interface_ = interface;
-  }
+  void set_interface(const ProcInterface &interface) { interface_ = interface; }
   bool IsInterfaceSet() {
     return interface_.symbol() != nullptr || interface_.type() != nullptr;
   }
   inline bool HasExplicitInterface() const;
 
   // Be advised: !init().has_value() => uninitialized pointer,
   // while *init() == nullptr => explicit NULL() initialization.
   std::optional<const Symbol *> init() const { return init_; }

flang/lib/Semantics/compute-offsets.cpp

auto ComputeOffsetsHelper::GetElementSize(const Symbol &symbol)
     -> SizeAndAlignment {
   const DeclTypeSpec *type{symbol.GetType()};
   if (!type) {
     return {};
   }
   // TODO: The size of procedure pointers is not yet known
   // and is independent of rank (and probably also the number
   // of length type parameters).
-  if (IsDescriptor(symbol) || IsProcedure(symbol)) {
+  if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
     int lenParams{0};
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       lenParams = CountLenParameters(*derived);
     }
     std::size_t size{
         runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
     return {size, maxAlignment};
   }
+  if (IsProcedure(symbol)) {
+    return {};
+  }
   SizeAndAlignment result;
   if (const IntrinsicTypeSpec * intrinsic{type->AsIntrinsic()}) {
     if (auto kind{ToInt64(intrinsic->kind())}) {
       result = GetIntrinsicSizeAndAlignment(intrinsic->category(), *kind);
     }
     if (type->category() == DeclTypeSpec::Character) {
       ParamValue length{type->characterTypeSpec().length()};
       CHECK(length.isExplicit()); // else should be descriptor

flang/lib/Semantics/resolve-names.cpp

public:
   MessageHandler &messageHandler() { return messageHandler_; }
   const std::optional<SourceName> &currStmtSource() {
     return context_->location();
   }
   SemanticsContext &context() const { return *context_; }
   evaluate::FoldingContext &GetFoldingContext() const {
     return context_->foldingContext();
   }
+  bool IsIntrinsic(const SourceName &name) const {
+    return context_->intrinsics().IsIntrinsic(name.ToString());
+  }
 
   // Make a placeholder symbol for a Name that otherwise wouldn't have one.
   // It is not in any scope and always has MiscDetails.
   void MakePlaceholder(const parser::Name &, MiscDetails::Kind);
 
   template <typename T> common::IfNoLvalue<T, T> FoldExpr(T &&expr) {
     return evaluate::Fold(GetFoldingContext(), std::move(expr));
   }
return !symbol.GetType() &&
                        return symbol.test(Symbol::Flag::Function) &&
                            !symbol.attrs().test(Attr::INTRINSIC) &&
                            !p.interface().type() && !p.interface().symbol();
                      },
                      [](const auto &) { return false; },
                  },
           symbol.details());
 }
+
 void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
   if (NeedsType(symbol)) {
     if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
       symbol.set(Symbol::Flag::Implicit);
       symbol.SetType(*type);
     } else if (symbol.has<ProcEntityDetails>() &&
-        !symbol.attrs().test(Attr::EXTERNAL) &&
-        context().intrinsics().IsIntrinsic(symbol.name().ToString())) {
+        !symbol.attrs().test(Attr::EXTERNAL) && IsIntrinsic(symbol.name())) {
       // type will be determined in expression semantics
       symbol.attrs().set(Attr::INTRINSIC);
     } 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])};
   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());
     }
bool DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const std::list<parser::Name> &names) {
   for (const auto &name : names) {
     HandleAttributeStmt(attr, name);
   }
   return false;
 }
 Symbol &DeclarationVisitor::HandleAttributeStmt(
     Attr attr, const parser::Name &name) {
-  if (attr == Attr::INTRINSIC &&
-      !context().intrinsics().IsIntrinsic(name.source.ToString())) {
+  if (attr == Attr::INTRINSIC && !IsIntrinsic(name.source)) {
     Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
   }
   auto *symbol{FindInScope(currScope(), name)};
   if (attr == Attr::ASYNCHRONOUS || attr == Attr::VOLATILE) {
     // these can be set on a symbol that is host-assoc or use-assoc
     if (!symbol &&
         (currScope().kind() == Scope::Kind::Subprogram ||
             currScope().kind() == Scope::Kind::Block)) {
void ResolveNamesVisitor::HandleCall(
   Walk(std::get<std::list<parser::ActualArgSpec>>(call.t));
 }
 
 void ResolveNamesVisitor::HandleProcedureName(
     Symbol::Flag flag, const parser::Name &name) {
   CHECK(flag == Symbol::Flag::Function || flag == Symbol::Flag::Subroutine);
   auto *symbol{FindSymbol(NonDerivedTypeScope(), name)};
   if (!symbol) {
-    if (context().intrinsics().IsIntrinsic(name.source.ToString())) {
+    if (IsIntrinsic(name.source)) {
       symbol =
           &MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC});
     } else {
       symbol = &MakeSymbol(context().globalScope(), name.source, Attrs{});
     }
     Resolve(name, *symbol);
     if (symbol->has<ModuleDetails>()) {
       SayWithDecl(name, *symbol,
if (!symbol) {
     ConvertToProcEntity(*symbol);
     SetProcFlag(name, *symbol, flag);
   } else if (symbol->has<UnknownDetails>()) {
     DIE("unexpected UnknownDetails");
   } else if (CheckUseError(name)) {
     // error was reported
   } else {
     symbol = &Resolve(name, symbol)->GetUltimate();
-    ConvertToProcEntity(*symbol);
+    if (ConvertToProcEntity(*symbol) && IsIntrinsic(symbol->name())) {
+      symbol->attrs().set(Attr::INTRINSIC);
+      // 8.2(3): ignore type from intrinsic in type-declaration-stmt
+      symbol->get<ProcEntityDetails>().set_interface(ProcInterface{});
+    }
     if (!SetProcFlag(name, *symbol, flag)) {
       return; // reported error
     }
     if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
         symbol->has<ObjectEntityDetails>() ||
         symbol->has<AssocEntityDetails>()) {
       // Symbols with DerivedTypeDetails, ObjectEntityDetails and
       // AssocEntityDetails are accepted here as procedure-designators because

flang/test/Semantics/symbol18.f90

+! RUN: %S/test_symbols.sh %s %t %f18
+
+! Intrinsic function in type declaration statement: type is ignored
+
+!DEF: /p1 MainProgram
+program p1
+ !DEF: /p1/cos INTRINSIC (Function) ProcEntity
+ integer cos
+ !DEF: /p1/y (Implicit) ObjectEntity REAL(4)
+ !REF: /p1/cos
+ !DEF: /p1/x (Implicit) ObjectEntity REAL(4)
+ y = cos(x)
+ !REF: /p1/y
+ !DEF: /p1/sin INTRINSIC (Function) ProcEntity
+ !REF: /p1/x
+ y = sin(x)
+ !REF: /p1/y
+ !DEF: /f EXTERNAL (Function, Implicit) ProcEntity REAL(4)
+ !REF: /p1/x
+ y = f(x)
+end program