[flang-commits] [flang] 2c662f3 - [flang] Fix bug with intrinsic in type declaration stmt
Tim Keith via flang-commits
flang-commits at lists.llvm.org
Wed Jul 29 07:23:41 PDT 2020
Author: Tim Keith
Date: 2020-07-29T07:23:31-07:00
New Revision: 2c662f3d3d957365ad86f35eee0bea05e4cf0188
URL: https://github.com/llvm/llvm-project/commit/2c662f3d3d957365ad86f35eee0bea05e4cf0188
DIFF: https://github.com/llvm/llvm-project/commit/2c662f3d3d957365ad86f35eee0bea05e4cf0188.diff
LOG: [flang] Fix bug with intrinsic in type declaration stmt
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.
Differential Revision: https://reviews.llvm.org/D84702
Added:
flang/test/Semantics/symbol18.f90
Modified:
flang/include/flang/Semantics/symbol.h
flang/lib/Semantics/compute-offsets.cpp
flang/lib/Semantics/resolve-names.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 3000a39c3b58..c0a50364b63d 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -219,10 +219,7 @@ class ProcEntityDetails : public EntityDetails, public WithPassArg {
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;
}
diff --git a/flang/lib/Semantics/compute-offsets.cpp b/flang/lib/Semantics/compute-offsets.cpp
index bcc4c0caf46a..8b24f6a1f3ea 100644
--- a/flang/lib/Semantics/compute-offsets.cpp
+++ b/flang/lib/Semantics/compute-offsets.cpp
@@ -257,7 +257,7 @@ auto ComputeOffsetsHelper::GetElementSize(const Symbol &symbol)
// 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);
@@ -266,6 +266,9 @@ auto ComputeOffsetsHelper::GetElementSize(const Symbol &symbol)
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())}) {
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index c1aef4b9b34c..50ea735d81d5 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -156,6 +156,9 @@ class BaseVisitor {
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.
@@ -2046,14 +2049,14 @@ static bool NeedsType(const Symbol &symbol) {
},
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)) {
@@ -2062,6 +2065,7 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
}
}
}
+
const DeclTypeSpec *ScopeHandler::GetImplicitType(Symbol &symbol) {
const DeclTypeSpec *type{implicitRules().GetType(symbol.name().begin()[0])};
if (type) {
@@ -3284,8 +3288,7 @@ bool DeclarationVisitor::HandleAttributeStmt(
}
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)};
@@ -5700,7 +5703,7 @@ void ResolveNamesVisitor::HandleProcedureName(
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 {
@@ -5729,7 +5732,11 @@ void ResolveNamesVisitor::HandleProcedureName(
// 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
}
diff --git a/flang/test/Semantics/symbol18.f90 b/flang/test/Semantics/symbol18.f90
new file mode 100644
index 000000000000..b7269b70be0a
--- /dev/null
+++ b/flang/test/Semantics/symbol18.f90
@@ -0,0 +1,21 @@
+! 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
More information about the flang-commits
mailing list