[flang] Special-case handling of INTRINSIC in type-decl-stmt #86518
Conversation
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Fortran allows the INTRINSIC attribute to be specified with a distinct attribute statement, and also as part of the attribute list of a type-declaration-stmt. This is an odd case (especially as the declared type is mandated to be ignored if it doesn't match the type of the intrinsic function) that can lead to odd error messages and crashes, since the rest of name resolution expects that intrinsics with explicit declarations will have been declared with INTRINSIC attribute statements. Resolve by handling an "inline" INTRINSIC attribute as a special case while processing a type-declaration-stmt, so that real, intrinsic :: acos, asin, atan is processed exactly as if it had been intrinsic acos, asin, atan; real acos, asin, atan Fixes llvm#86382.
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics @llvm/pr-subscribers-flang-parser Author: Peter Klausler (klausler) ChangesFortran allows the INTRINSIC attribute to be specified with a distinct attribute statement, and also as part of the attribute list of a type-declaration-stmt. This is an odd case (especially as the declared type is mandated to be ignored if it doesn't match the type of the intrinsic function) that can lead to odd error messages and crashes, since the rest of name resolution expects that intrinsics with explicit declarations will have been declared with INTRINSIC attribute statements. Resolve by handling an "inline" INTRINSIC attribute as a special case while processing a type-declaration-stmt, so that real, intrinsic :: acos, asin, atan is processed exactly as if it had been intrinsic acos, asin, atan; real acos, asin, atan Fixes #86382. Full diff: https://github.com/llvm/llvm-project/pull/86518.diff 5 Files Affected:
diff --git a/flang/include/flang/Parser/tools.h b/flang/include/flang/Parser/tools.h
index 1e347fab6461a3..f1ead11734fa0d 100644
--- a/flang/include/flang/Parser/tools.h
+++ b/flang/include/flang/Parser/tools.h
@@ -40,6 +40,7 @@ const Name &GetFirstName(const ProcedureDesignator &);
const Name &GetFirstName(const Call &);
const Name &GetFirstName(const FunctionReference &);
const Name &GetFirstName(const Variable &);
+const Name &GetFirstName(const EntityDecl &);
// When a parse tree node is an instance of a specific type wrapped in
// layers of packaging, return a pointer to that object.
diff --git a/flang/lib/Parser/tools.cpp b/flang/lib/Parser/tools.cpp
index 899fb0f069a935..6e5f1ed2fc66f0 100644
--- a/flang/lib/Parser/tools.cpp
+++ b/flang/lib/Parser/tools.cpp
@@ -123,6 +123,10 @@ const Name &GetFirstName(const Variable &x) {
x.u);
}
+const Name &GetFirstName(const EntityDecl &x) {
+ return std::get<ObjectName>(x.t);
+}
+
const CoindexedNamedObject *GetCoindexedNamedObject(const DataRef &base) {
return common::visit(
common::visitors{
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b13674573fe07e..66a92ce0d2931a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -955,7 +955,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
void Post(const parser::TargetStmt &) { objectDeclAttr_ = std::nullopt; }
void Post(const parser::DimensionStmt::Declaration &);
void Post(const parser::CodimensionDecl &);
- bool Pre(const parser::TypeDeclarationStmt &) { return BeginDecl(); }
+ bool Pre(const parser::TypeDeclarationStmt &);
void Post(const parser::TypeDeclarationStmt &);
void Post(const parser::IntegerTypeSpec &);
void Post(const parser::IntrinsicTypeSpec::Real &);
@@ -1202,6 +1202,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
bool MustBeScalar(const Symbol &symbol) const {
return mustBeScalar_.find(symbol) != mustBeScalar_.end();
}
+ void DeclareIntrinsic(const parser::Name &);
};
// Resolve construct entities and statement entities.
@@ -4550,6 +4551,20 @@ void DeclarationVisitor::CheckAccessibility(
}
}
+bool DeclarationVisitor::Pre(const parser::TypeDeclarationStmt &x) {
+ BeginDecl();
+ // If INTRINSIC appears as an attr-spec, handle it now as if the
+ // names had appeared on an INTRINSIC attribute statement beforehand.
+ for (const auto &attr : std::get<std::list<parser::AttrSpec>>(x.t)) {
+ if (std::holds_alternative<parser::Intrinsic>(attr.u)) {
+ for (const auto &decl : std::get<std::list<parser::EntityDecl>>(x.t)) {
+ DeclareIntrinsic(parser::GetFirstName(decl));
+ }
+ break;
+ }
+ }
+ return true;
+}
void DeclarationVisitor::Post(const parser::TypeDeclarationStmt &) {
EndDecl();
}
@@ -4571,6 +4586,7 @@ bool DeclarationVisitor::Pre(const parser::Initialization &) {
void DeclarationVisitor::Post(const parser::EntityDecl &x) {
const auto &name{std::get<parser::ObjectName>(x.t)};
Attrs attrs{attrs_ ? HandleSaveName(name.source, *attrs_) : Attrs{}};
+ attrs.set(Attr::INTRINSIC, false); // dealt with in Pre(TypeDeclarationStmt)
Symbol &symbol{DeclareUnknownEntity(name, attrs)};
symbol.ReplaceName(name.source);
SetCUDADataAttr(name.source, symbol, cudaDataAttr());
@@ -4811,45 +4827,47 @@ bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
HandleAttributeStmt(IntentSpecToAttr(intentSpec), names);
}
bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
- HandleAttributeStmt(Attr::INTRINSIC, x.v);
for (const auto &name : x.v) {
- if (!IsIntrinsic(name.source, std::nullopt)) {
- Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
- }
- auto &symbol{DEREF(FindSymbol(name))};
- if (symbol.has<GenericDetails>()) {
- // Generic interface is extending intrinsic; ok
- } else if (!ConvertToProcEntity(symbol)) {
- SayWithDecl(
- name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
- } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
+ DeclareIntrinsic(name);
+ }
+ return false;
+}
+void DeclarationVisitor::DeclareIntrinsic(const parser::Name &name) {
+ HandleAttributeStmt(Attr::INTRINSIC, name);
+ if (!IsIntrinsic(name.source, std::nullopt)) {
+ Say(name.source, "'%s' is not a known intrinsic procedure"_err_en_US);
+ }
+ auto &symbol{DEREF(FindSymbol(name))};
+ if (symbol.has<GenericDetails>()) {
+ // Generic interface is extending intrinsic; ok
+ } else if (!ConvertToProcEntity(symbol)) {
+ SayWithDecl(
+ name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
+ } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
+ Say(symbol.name(),
+ "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
+ symbol.name());
+ } else {
+ if (symbol.GetType()) {
+ // These warnings are worded so that they should make sense in either
+ // order.
Say(symbol.name(),
- "Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
- symbol.name());
- } else {
- if (symbol.GetType()) {
- // These warnings are worded so that they should make sense in either
- // order.
- Say(symbol.name(),
- "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
- symbol.name())
- .Attach(name.source,
- "INTRINSIC statement for explicitly-typed '%s'"_en_US,
- name.source);
- }
- if (!symbol.test(Symbol::Flag::Function) &&
- !symbol.test(Symbol::Flag::Subroutine)) {
- if (context().intrinsics().IsIntrinsicFunction(
- name.source.ToString())) {
- symbol.set(Symbol::Flag::Function);
- } else if (context().intrinsics().IsIntrinsicSubroutine(
- name.source.ToString())) {
- symbol.set(Symbol::Flag::Subroutine);
- }
+ "Explicit type declaration ignored for intrinsic function '%s'"_warn_en_US,
+ symbol.name())
+ .Attach(name.source,
+ "INTRINSIC statement for explicitly-typed '%s'"_en_US,
+ name.source);
+ }
+ if (!symbol.test(Symbol::Flag::Function) &&
+ !symbol.test(Symbol::Flag::Subroutine)) {
+ if (context().intrinsics().IsIntrinsicFunction(name.source.ToString())) {
+ symbol.set(Symbol::Flag::Function);
+ } else if (context().intrinsics().IsIntrinsicSubroutine(
+ name.source.ToString())) {
+ symbol.set(Symbol::Flag::Subroutine);
}
}
}
- return false;
}
bool DeclarationVisitor::Pre(const parser::OptionalStmt &x) {
return CheckNotInBlock("OPTIONAL") && // C1107
diff --git a/flang/test/Semantics/init01.f90 b/flang/test/Semantics/init01.f90
index f85feef097cdca..65d524b16a23a2 100644
--- a/flang/test/Semantics/init01.f90
+++ b/flang/test/Semantics/init01.f90
@@ -158,8 +158,10 @@ subroutine notObjects
real, external :: x1 = 1.
!ERROR: 'x2' is not a pointer but is initialized like one
real, external :: x2 => sin
+!ERROR: 'x3' is not a known intrinsic procedure
!ERROR: 'x3' is not an object that can be initialized
real, intrinsic :: x3 = 1.
+!ERROR: 'x4' is not a known intrinsic procedure
!ERROR: 'x4' is not a pointer but is initialized like one
real, intrinsic :: x4 => cos
end subroutine
diff --git a/flang/test/Semantics/resolve81.f90 b/flang/test/Semantics/resolve81.f90
index 2a0b961d48e5c3..87901fd7d2efcb 100644
--- a/flang/test/Semantics/resolve81.f90
+++ b/flang/test/Semantics/resolve81.f90
@@ -28,6 +28,7 @@ module m
!WARNING: Attribute 'EXTERNAL' cannot be used more than once
real, external, external :: externFunc
!WARNING: Attribute 'INTRINSIC' cannot be used more than once
+ !ERROR: An interface name with BIND attribute must be specified if the BIND attribute is specified in a procedure declaration statement
real, intrinsic, bind(c), intrinsic :: cos
!WARNING: Attribute 'BIND(C)' cannot be used more than once
integer, bind(c), volatile, bind(c) :: bindVar
|
|
✅ With the latest revision this PR passed the C/C++ code formatter. |
|
✅ With the latest revision this PR passed the Python code formatter. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
Fortran allows the INTRINSIC attribute to be specified with a distinct attribute statement, and also as part of the attribute list of a type-declaration-stmt. This is an odd case (especially as the declared type is mandated to be ignored if it doesn't match the type of the intrinsic function) that can lead to odd error messages and crashes, since the rest of name resolution expects that intrinsics with explicit declarations will have been declared with INTRINSIC attribute statements. Resolve by handling an "inline" INTRINSIC attribute as a special case while processing a type-declaration-stmt, so that
real, intrinsic :: acos, asin, atan
is processed exactly as if it had been
intrinsic acos, asin, atan; real acos, asin, atan
Fixes #86382.