[flang-commits] [flang] 2577cb7 - [flang] Check restrictions on TRANSFER()
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sun Dec 4 15:29:25 PST 2022
Author: Peter Klausler
Date: 2022-12-04T15:29:12-08:00
New Revision: 2577cb7a20c20186c8e64d43b21a597f40565f59
URL: https://github.com/llvm/llvm-project/commit/2577cb7a20c20186c8e64d43b21a597f40565f59
DIFF: https://github.com/llvm/llvm-project/commit/2577cb7a20c20186c8e64d43b21a597f40565f59.diff
LOG: [flang] Check restrictions on TRANSFER()
Enforce detectable compilation-time violations of restrictions on the
arguments to the TRANSFER() intrinsic function (16.9.163) with
error messages, and mark other potential problems with warnings.
Differential Revision: https://reviews.llvm.org/D139157
Added:
flang/test/Semantics/transfer01.f90
Modified:
flang/include/flang/Evaluate/characteristics.h
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Semantics/check-call.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index aebb210582e7..dd5bd4747380 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -123,9 +123,9 @@ class TypeAndShape {
}
template <typename A>
static std::optional<TypeAndShape> Characterize(
- const A *p, FoldingContext &context) {
- if (p) {
- return Characterize(*p, context);
+ A *ptr, FoldingContext &context) {
+ if (ptr) {
+ return Characterize(std::as_const(*ptr), context);
} else {
return std::nullopt;
}
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index a8b783e3719f..bedc5c453bc8 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -262,9 +262,9 @@ template <typename A> const Symbol *ExtractBareLenParameter(const A &expr) {
}
// If an expression simply wraps a DataRef, extract and return it.
-// The Boolean argument controls the handling of Substring and ComplexPart
+// The Boolean arguments control the handling of Substring and ComplexPart
// references: when true (not default), it extracts the base DataRef
-// of a substring or complex part, if it has one.
+// of a substring or complex part.
template <typename A>
common::IfNoLvalue<std::optional<DataRef>, A> ExtractDataRef(
const A &, bool intoSubstring, bool intoComplexPart) {
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 865aae574d99..a944217ed22c 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3054,6 +3054,44 @@ 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 9fa8e995273e..f151dfaa7477 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -929,9 +929,9 @@ static parser::Messages CheckExplicitInterface(
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
RearrangeArguments(proc, actuals, messages);
+ evaluate::FoldingContext localContext{context, messages};
if (buffer.empty()) {
int index{0};
- evaluate::FoldingContext localContext{context, messages};
for (auto &actual : actuals) {
const auto &dummy{proc.dummyArguments.at(index++)};
if (actual) {
diff --git a/flang/test/Semantics/transfer01.f90 b/flang/test/Semantics/transfer01.f90
new file mode 100644
index 000000000000..70c738c903d9
--- /dev/null
+++ b/flang/test/Semantics/transfer01.f90
@@ -0,0 +1,31 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check errors in TRANSFER()
+
+subroutine subr(o)
+ integer, intent(in), optional :: o
+ type empty
+ end type
+ type(empty) :: empty1(1)
+ real :: empty2(0)
+ character(0) :: empty3(1)
+ integer, pointer :: source(:)
+ integer, allocatable :: ia
+ integer, pointer :: ip
+ !ERROR: Element size of MOLD= array may not be zero when SOURCE= is not empty
+ print *, transfer(1., empty1)
+ print *, transfer(1., empty2) ! ok
+ !ERROR: Element size of MOLD= array may not be zero when SOURCE= is not empty
+ print *, transfer(1., empty3)
+ !WARNING: Element size of MOLD= array may not be zero unless SOURCE= is empty
+ print *, transfer(source, empty1)
+ print *, transfer(source, empty2) ! ok
+ !WARNING: Element size of MOLD= array may not be zero unless SOURCE= is empty
+ print *, transfer(source, empty3)
+ !ERROR: SIZE= argument may not be the optional dummy argument 'o'
+ print *, transfer(1., empty2, size=o)
+ !WARNING: SIZE= argument that is allocatable or pointer must be present at execution; parenthesize to silence this warning
+ 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)
+end
+
More information about the flang-commits
mailing list