[flang-commits] [flang] 860ed6c - [flang] Warn about dangerous TRANSFER()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Feb 13 15:41:44 PST 2023
Author: Peter Klausler
Date: 2023-02-13T15:41:35-08:00
New Revision: 860ed6c078b4f04aa364ae3bc0648259e626ce4f
URL: https://github.com/llvm/llvm-project/commit/860ed6c078b4f04aa364ae3bc0648259e626ce4f
DIFF: https://github.com/llvm/llvm-project/commit/860ed6c078b4f04aa364ae3bc0648259e626ce4f.diff
LOG: [flang] Warn about dangerous TRANSFER()
When the source or mold of a reference to the intrinsic function TRANSFER()
has a derived type with a direct component that contains a descriptor,
such as an allocatable or a pointer, emit a warning. User programs
should never access descriptors directly.
Differential Revision: https://reviews.llvm.org/D143823
Added:
Modified:
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/transfer01.f90
Removed:
################################################################################
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 9a1062d0478a..7e8285a8a8d1 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2753,7 +2753,7 @@ static bool CheckAtomicDefineAndRef(FoldingContext &context,
// Applies any semantic checks peculiar to an intrinsic.
// TODO: Move the rest of these checks to Semantics/check-call.cpp, which is
-// where ASSOCIATED() is now validated.
+// where ASSOCIATED() and TRANSFER() are now validated.
static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
bool ok{true};
const std::string &name{call.specificIntrinsic.name};
@@ -2929,44 +2929,6 @@ static bool ApplySpecificChecks(SpecificCall &call, FoldingContext &context) {
}
}
}
- } else if (name == "transfer") { // 16.9.193
- if (call.arguments.size() >= 2) {
- auto source{characteristics::TypeAndShape::Characterize(
- call.arguments[0], context)};
- auto mold{characteristics::TypeAndShape::Characterize(
- call.arguments[1], context)};
- if (source && mold && mold->Rank() > 0 &&
- evaluate::ToInt64(
- evaluate::Fold(
- context, mold->MeasureElementSizeInBytes(context, false)))
- .value_or(1) == 0) {
- if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(
- context, source->MeasureSizeInBytes(context)))}) {
- if (*sourceSize > 0) {
- context.messages().Say(
- "Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
- ok = false;
- }
- } else {
- context.messages().Say(
- "Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
- }
- }
- if (call.arguments.size() > 2) {
- if (const Symbol *whole{
- UnwrapWholeSymbolOrComponentDataRef(call.arguments[2])}) {
- if (IsOptional(*whole)) {
- context.messages().Say(
- "SIZE= argument may not be the optional dummy argument '%s'"_err_en_US,
- whole->name());
- ok = false;
- } else if (IsAllocatableOrPointer(*whole)) {
- context.messages().Say(
- "SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
- }
- }
- }
- }
} else if (name == "ucobound") {
return CheckDimAgainstCorank(call, context);
}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 6228950cc1ef..07d79aeb22b1 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1083,11 +1083,73 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
}
}
+// TRANSFER (16.9.193)
+static void CheckTransferOperandType(parser::ContextualMessages &messages,
+ const evaluate::DynamicType &type, const char *which) {
+ if (type.IsPolymorphic()) {
+ messages.Say("%s of TRANSFER is polymorphic"_warn_en_US, which);
+ } else if (!type.IsUnlimitedPolymorphic() &&
+ type.category() == TypeCategory::Derived) {
+ DirectComponentIterator directs{type.GetDerivedTypeSpec()};
+ if (auto bad{std::find_if(directs.begin(), directs.end(), IsDescriptor)};
+ bad != directs.end()) {
+ evaluate::SayWithDeclaration(messages, *bad,
+ "%s of TRANSFER contains allocatable or pointer component %s"_warn_en_US,
+ which, bad.BuildResultDesignatorName());
+ }
+ }
+}
+
+static void CheckTransfer(evaluate::ActualArguments &arguments,
+ evaluate::FoldingContext &context, const Scope *scope) {
+ if (arguments.size() >= 2) {
+ if (auto source{characteristics::TypeAndShape::Characterize(
+ arguments[0], context)}) {
+ CheckTransferOperandType(context.messages(), source->type(), "Source");
+ if (auto mold{characteristics::TypeAndShape::Characterize(
+ arguments[1], context)}) {
+ CheckTransferOperandType(context.messages(), mold->type(), "Mold");
+ if (mold->Rank() > 0 &&
+ evaluate::ToInt64(
+ evaluate::Fold(
+ context, mold->MeasureElementSizeInBytes(context, false)))
+ .value_or(1) == 0) {
+ if (auto sourceSize{evaluate::ToInt64(evaluate::Fold(
+ context, source->MeasureSizeInBytes(context)))}) {
+ if (*sourceSize > 0) {
+ context.messages().Say(
+ "Element size of MOLD= array may not be zero when SOURCE= is not empty"_err_en_US);
+ }
+ } else {
+ context.messages().Say(
+ "Element size of MOLD= array may not be zero unless SOURCE= is empty"_warn_en_US);
+ }
+ }
+ }
+ }
+ if (arguments.size() > 2) { // SIZE=
+ if (const Symbol *
+ whole{UnwrapWholeSymbolOrComponentDataRef(arguments[2])}) {
+ if (IsOptional(*whole)) {
+ context.messages().Say(
+ "SIZE= argument may not be the optional dummy argument '%s'"_err_en_US,
+ whole->name());
+ } else if (IsAllocatableOrPointer(*whole)) {
+ context.messages().Say(
+ "SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning"_warn_en_US);
+ }
+ }
+ }
+ }
+}
+
static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
evaluate::FoldingContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic &intrinsic) {
if (intrinsic.name == "associated") {
CheckAssociated(arguments, context, scope);
+ } else if (intrinsic.name == "transfer") {
+ CheckTransfer(arguments, context, scope);
}
}
diff --git a/flang/test/Semantics/transfer01.f90 b/flang/test/Semantics/transfer01.f90
index 70c738c903d9..6cd8288e225c 100644
--- a/flang/test/Semantics/transfer01.f90
+++ b/flang/test/Semantics/transfer01.f90
@@ -6,6 +6,10 @@ subroutine subr(o)
type empty
end type
type(empty) :: empty1(1)
+ type hasdescriptor
+ real, allocatable :: allocatable
+ end type
+ type(hasdescriptor) hasDesc
real :: empty2(0)
character(0) :: empty3(1)
integer, pointer :: source(:)
@@ -27,5 +31,6 @@ subroutine subr(o)
print *, transfer(1., empty2, size=ia)
!WARNING: SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning
print *, transfer(1., empty2, size=ip)
+ !WARNING: Source of TRANSFER contains allocatable or pointer component %allocatable
+ print *, transfer(hasDesc, 1)
end
-
More information about the flang-commits
mailing list