Index: flang/include/flang/Evaluate/characteristics.h =================================================================== --- flang/include/flang/Evaluate/characteristics.h +++ flang/include/flang/Evaluate/characteristics.h @@ -123,9 +123,9 @@ } template static std::optional 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; } Index: flang/include/flang/Evaluate/tools.h =================================================================== --- flang/include/flang/Evaluate/tools.h +++ flang/include/flang/Evaluate/tools.h @@ -262,9 +262,9 @@ } // 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 common::IfNoLvalue, A> ExtractDataRef( const A &, bool intoSubstring, bool intoComplexPart) { Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -3005,6 +3005,44 @@ } } } + } 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); } Index: flang/lib/Semantics/check-call.cpp =================================================================== --- flang/lib/Semantics/check-call.cpp +++ flang/lib/Semantics/check-call.cpp @@ -915,9 +915,9 @@ 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) { Index: flang/test/Semantics/transfer01.f90 =================================================================== --- /dev/null +++ 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 +