[flang-commits] [flang] 97e3f60 - [flang] Don't allow non-standard data conversions of potentially abse… (#87391)

[via flang-commits]

Author: Peter Klausler
Date: 2024-04-08T11:56:36-07:00
New Revision: 97e3f605d5b574899d9f012032349bbf84c4dcfb

URL: https://github.com/llvm/llvm-project/commit/97e3f605d5b574899d9f012032349bbf84c4dcfb
DIFF: https://github.com/llvm/llvm-project/commit/97e3f605d5b574899d9f012032349bbf84c4dcfb.diff

LOG: [flang] Don't allow non-standard data conversions of potentially abse… (#87391)

…nt arguments

Arguments to the intrinsic functions MAX and MIN after the first two are
optional. When these actual arguments might not be present at run time,
emit a compilation time error if they require data conversion (a
non-standard but nearly universal language extension); such a conversion
would crash if the argument was absent.

Other compilers either disallow data conversions entirely on MAX/MIN or
crash at run time if a converted argument is absent.

Fixes https://github.com/llvm/llvm-project/issues/87046.

Added: 
    flang/test/Semantics/intrinsics04.f90

Modified: 
    flang/docs/Extensions.md
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index d44242de17d567..4c3847291a3f3b 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 51a16ee155fabb..bd2f755855172a 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 00000000000000..a7d646e5c016e7
--- /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