[flang] Upstream partial lowering of GET_ENVIRONMENT_VARIABLE intrinsic

This patch adds partial lowering of the "GET_ENVIRONMENT_VARIABLE" intrinsic
to the backend runtime hook implemented in patches D111394 and D112698.
It also renames the `isPresent` lambda to `isAbsent` and moves it out to
its own function in `Command.cpp`. Corresponding comment fixes for this
are also modified. Lastly it adds the i1 type to
`RuntimeCallTestBash.h`.

Differential Revision: https://reviews.llvm.org/D118984

diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index fd6332b..7cd168b 100644 (file)
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -32,5 +32,14 @@ void genGetCommandArgument(fir::FirOpBuilder &, mlir::Location,
                            mlir::Value length, mlir::Value status,
                            mlir::Value errmsg);
 
+/// Generate call to GET_ENVIRONMENT_VARIABLE intrinsic runtime routine.
+/// Note that GET_ENVIRONMENT_ARGUMENT intrinsic is split between 2 functions in
+/// implementation; EnvVariableValue and EnvVariableLength. So we handle each
+/// seperately.
+void genGetEnvironmentVariable(fir::FirOpBuilder &, mlir::Location,
+                               mlir::Value number, mlir::Value value,
+                               mlir::Value length, mlir::Value status,
+                               mlir::Value trimName, mlir::Value errmsg);
+
 } // namespace fir::runtime
 #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H

diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index e3fc363..bfa390b 100644 (file)
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -13,6 +13,18 @@
 
 using namespace Fortran::runtime;
 
+// Certain runtime intrinsics should only be run when select parameters of the
+// intrisic are supplied. In certain cases one of these parameters may not be
+// given, however the intrinsic needs to be run due to another required
+// parameter being supplied. In this case the missing parameter is assigned to
+// have an "absent" value. This typically happens in IntrinsicCall.cpp. For this
+// reason the extra indirection with `isAbsent` is needed for testing whether a
+// given parameter is actually present (so that parameters with "value" absent
+// are not considered as present).
+inline bool isAbsent(mlir::Value val) {
+  return mlir::isa_and_nonnull<fir::AbsentOp>(val.getDefiningOp());
+}
+
 mlir::Value fir::runtime::genCommandArgumentCount(fir::FirOpBuilder &builder,
                                                   mlir::Location loc) {
   auto argumentCountFunc =
@@ -30,26 +42,17 @@ void fir::runtime::genGetCommandArgument(fir::FirOpBuilder &builder,
   auto argumentLengthFunc =
       fir::runtime::getRuntimeFunc<mkRTKey(ArgumentLength)>(loc, builder);
 
-  auto isPresent = [&](mlir::Value val) -> bool {
-    return !mlir::isa_and_nonnull<fir::AbsentOp>(val.getDefiningOp());
-  };
-
   mlir::Value valueResult;
-  // Run `ArgumentValue` intrisc only if we have either "value", "status" or
-  // "errmsg" `ArgumentValue` "requires" existing values for its arguments
-  // "value" and "errmsg". So in the case they aren't given, but the user has
-  // requested "status", we have to assign "absent" values to them before
-  // calling `ArgumentValue`. This happens in IntrinsicCall.cpp. For this reason
-  // we need extra indirection with `isPresent` for testing whether "value" or
-  // "errmsg" is present.
-  if (isPresent(value) || status || isPresent(errmsg)) {
+  // Run `ArgumentValue` intrinsic only if we have a "value" in either "VALUE",
+  // "STATUS" or "ERRMSG" parameters.
+  if (!isAbsent(value) || status || !isAbsent(errmsg)) {
     llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
         builder, loc, argumentValueFunc.getType(), number, value, errmsg);
     valueResult =
         builder.create<fir::CallOp>(loc, argumentValueFunc, args).getResult(0);
   }
 
-  // Only save result of ArgumentValue if "status" parameter has been given
+  // Only save result of `ArgumentValue` if "STATUS" parameter has been given
   if (status) {
     const mlir::Value statusLoaded = builder.create<fir::LoadOp>(loc, status);
     mlir::Value resultCast =
@@ -57,6 +60,7 @@ void fir::runtime::genGetCommandArgument(fir::FirOpBuilder &builder,
     builder.create<fir::StoreOp>(loc, resultCast, status);
   }
 
+  // Only run `ArgumentLength` intrinsic if "LENGTH" parameter provided
   if (length) {
     llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
         builder, loc, argumentLengthFunc.getType(), number);
@@ -68,3 +72,55 @@ void fir::runtime::genGetCommandArgument(fir::FirOpBuilder &builder,
     builder.create<fir::StoreOp>(loc, resultCast, length);
   }
 }
+
+void fir::runtime::genGetEnvironmentVariable(
+    fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value name,
+    mlir::Value value, mlir::Value length, mlir::Value status,
+    mlir::Value trimName, mlir::Value errmsg) {
+  auto valueFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(EnvVariableValue)>(loc, builder);
+  auto lengthFunc =
+      fir::runtime::getRuntimeFunc<mkRTKey(EnvVariableLength)>(loc, builder);
+
+  mlir::Value sourceFile;
+  mlir::Value sourceLine;
+  // We only need `sourceFile` and `sourceLine` variables when calling either
+  // `EnvVariableValue` or `EnvVariableLength` below.
+  if (!isAbsent(value) || status || !isAbsent(errmsg) || length) {
+    sourceFile = fir::factory::locationToFilename(builder, loc);
+    sourceLine = fir::factory::locationToLineNo(
+        builder, loc, valueFunc.getType().getInput(5));
+  }
+
+  mlir::Value valueResult;
+  // Run `EnvVariableValue` intrinsic only if we have a "value" in either
+  // "VALUE", "STATUS" or "ERRMSG" parameters.
+  if (!isAbsent(value) || status || !isAbsent(errmsg)) {
+    llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+        builder, loc, valueFunc.getType(), name, value, trimName, errmsg,
+        sourceFile, sourceLine);
+    valueResult =
+        builder.create<fir::CallOp>(loc, valueFunc, args).getResult(0);
+  }
+
+  // Only save result of `EnvVariableValue` if "STATUS" parameter provided
+  if (status) {
+    const mlir::Value statusLoaded = builder.create<fir::LoadOp>(loc, status);
+    mlir::Value resultCast =
+        builder.createConvert(loc, statusLoaded.getType(), valueResult);
+    builder.create<fir::StoreOp>(loc, resultCast, status);
+  }
+
+  // Only run `EnvVariableLength` intrinsic if "LENGTH" parameter provided
+  if (length) {
+    llvm::SmallVector<mlir::Value> args =
+        fir::runtime::createArguments(builder, loc, lengthFunc.getType(), name,
+                                      trimName, sourceFile, sourceLine);
+    mlir::Value result =
+        builder.create<fir::CallOp>(loc, lengthFunc, args).getResult(0);
+    const mlir::Value lengthLoaded = builder.create<fir::LoadOp>(loc, length);
+    mlir::Value resultCast =
+        builder.createConvert(loc, lengthLoaded.getType(), result);
+    builder.create<fir::StoreOp>(loc, resultCast, length);
+  }
+}

diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
index 1b19789..1e48cfa 100644 (file)
--- a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
+++ b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp
@@ -36,3 +36,24 @@ TEST_F(RuntimeCallTest, genGetCommandArgument) {
   EXPECT_TRUE(block) << "Failed to retrieve the block!";
   checkBlockForCallOp(block, "_FortranAArgumentLength", /*nbArgs=*/1);
 }
+
+TEST_F(RuntimeCallTest, genGetEnvironmentVariable) {
+  mlir::Location loc = firBuilder->getUnknownLoc();
+  mlir::Type intTy = firBuilder->getDefaultIntegerType();
+  mlir::Type charTy = fir::BoxType::get(firBuilder->getNoneType());
+  mlir::Value number = firBuilder->create<fir::UndefOp>(loc, intTy);
+  mlir::Value value = firBuilder->create<fir::UndefOp>(loc, charTy);
+  mlir::Value trimName = firBuilder->create<fir::UndefOp>(loc, i1Ty);
+  mlir::Value errmsg = firBuilder->create<fir::UndefOp>(loc, charTy);
+  // genGetCommandArgument expects `length` and `status` to be memory references
+  mlir::Value length = firBuilder->create<fir::AllocaOp>(loc, intTy);
+  mlir::Value status = firBuilder->create<fir::AllocaOp>(loc, intTy);
+
+  fir::runtime::genGetEnvironmentVariable(
+      *firBuilder, loc, number, value, length, status, trimName, errmsg);
+  checkCallOpFromResultBox(
+      value, "_FortranAEnvVariableValue", /*nbArgs=*/6, /*addLocArgs=*/false);
+  mlir::Block *block = firBuilder->getBlock();
+  EXPECT_TRUE(block) << "Failed to retrieve the block!";
+  checkBlockForCallOp(block, "_FortranAEnvVariableLength", /*nbArgs=*/4);
+}

diff --git a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h
index 8736151..264ae20 100644 (file)
--- a/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h
+++ b/flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h
@@ -33,6 +33,7 @@ public:
     kindMap = std::make_unique<fir::KindMapping>(&context);
     firBuilder = std::make_unique<fir::FirOpBuilder>(mod, *kindMap);
 
+    i1Ty = firBuilder->getI1Type();
     i8Ty = firBuilder->getI8Type();
     i16Ty = firBuilder->getIntegerType(16);
     i32Ty = firBuilder->getI32Type();
@@ -58,6 +59,7 @@ public:
   std::unique_ptr<fir::FirOpBuilder> firBuilder;
 
   // Commonly used types
+  mlir::Type i1Ty;
   mlir::Type i8Ty;
   mlir::Type i16Ty;
   mlir::Type i32Ty;