diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index d44242de17d5..4c3847291a3f 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -346,6 +346,10 @@ end * A `NAMELIST` input group may begin with either `&` or `$`. * A comma in a fixed-width numeric input field terminates the field rather than signaling an invalid character error. +* Arguments to the intrinsic functions `MAX` and `MIN` are converted + when necessary to the type of the result. + An `OPTIONAL`, `POINTER`, or `ALLOCATABLE` argument after + the first two cannot be converted, as it may not be present. ### Extensions supported when enabled by options diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index 51a16ee155fa..bd2f75585517 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -1466,6 +1466,29 @@ static void CheckImage_Index(evaluate::ActualArguments &arguments, } } +// Ensure that any optional argument that might be absent at run time +// does not require data conversion. +static void CheckMaxMin(const characteristics::Procedure &proc, + evaluate::ActualArguments &arguments, + parser::ContextualMessages &messages) { + if (proc.functionResult) { + if (const auto *typeAndShape{proc.functionResult->GetTypeAndShape()}) { + for (std::size_t j{2}; j < arguments.size(); ++j) { + if (arguments[j]) { + if (const auto *expr{arguments[j]->UnwrapExpr()}; + expr && evaluate::MayBePassedAsAbsentOptional(*expr)) { + if (auto thisType{expr->GetType()}; + thisType && *thisType != typeAndShape->type()) { + messages.Say(arguments[j]->sourceLocation(), + "An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE"_err_en_US); + } + } + } + } + } + } +} + // MOVE_ALLOC (F'2023 16.9.147) static void CheckMove_Alloc(evaluate::ActualArguments &arguments, parser::ContextualMessages &messages) { @@ -1733,13 +1756,15 @@ static void CheckTransfer(evaluate::ActualArguments &arguments, } } -static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments, - SemanticsContext &context, const Scope *scope, - const evaluate::SpecificIntrinsic &intrinsic) { +static void CheckSpecificIntrinsic(const characteristics::Procedure &proc, + evaluate::ActualArguments &arguments, SemanticsContext &context, + const Scope *scope, const evaluate::SpecificIntrinsic &intrinsic) { if (intrinsic.name == "associated") { CheckAssociated(arguments, context, scope); } else if (intrinsic.name == "image_index") { CheckImage_Index(arguments, context.foldingContext().messages()); + } else if (intrinsic.name == "max" || intrinsic.name == "min") { + CheckMaxMin(proc, arguments, context.foldingContext().messages()); } else if (intrinsic.name == "move_alloc") { CheckMove_Alloc(arguments, context.foldingContext().messages()); } else if (intrinsic.name == "present") { @@ -1790,7 +1815,7 @@ static parser::Messages CheckExplicitInterface( CheckElementalConformance(messages, proc, actuals, foldingContext); } if (intrinsic) { - CheckSpecificIntrinsic(actuals, context, scope, *intrinsic); + CheckSpecificIntrinsic(proc, actuals, context, scope, *intrinsic); } return buffer; } diff --git a/flang/test/Semantics/intrinsics04.f90 b/flang/test/Semantics/intrinsics04.f90 new file mode 100644 index 000000000000..a7d646e5c016 --- /dev/null +++ b/flang/test/Semantics/intrinsics04.f90 @@ -0,0 +1,25 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! A potentially absent actual argument cannot require data type conversion. +subroutine s(o,a,p) + integer(2), intent(in), optional :: o + integer(2), intent(in), allocatable :: a + integer(2), intent(in), pointer :: p + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, max(1, 2, o) + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, max(1, 2, a) + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, max(1, 2, p) + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, min(1, 2, o) + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, min(1, 2, a) + !ERROR: An actual argument to MAX/MIN requiring data conversion may not be OPTIONAL, POINTER, or ALLOCATABLE + print *, min(1, 2, p) + print *, max(1_2, 2_2, o) ! ok + print *, max(1_2, 2_2, a) ! ok + print *, max(1_2, 2_2, p) ! ok + print *, min(1_2, 2_2, o) ! ok + print *, min(1_2, 2_2, a) ! ok + print *, min(1_2, 2_2, p) ! ok +end