[flang] Upstream partial lowering of GET_ENVIRONMENT_VARIABLE intrinsic

[josh.mottley.arm]

Summary

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.

[awarzynski]

LGTM, thanks!

flang/include/flang/Optimizer/Builder/Runtime/Command.h

 /// Note that GET_COMMAND_ARGUMENT intrinsic is split between 2 functions in
 /// implementation; ArgumentValue and ArgumentLength. So we handle each
 /// seperately.
 void genGetCommandArgument(fir::FirOpBuilder &, mlir::Location,
                            mlir::Value number, mlir::Value value,
                            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

flang/lib/Optimizer/Builder/Runtime/Command.cpp

 //===-- Command.cpp -- generate command line runtime API calls ------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "flang/Optimizer/Builder/Runtime/Command.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Runtime/command.h"
 
 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 =
       fir::runtime::getRuntimeFunc<mkRTKey(ArgumentCount)>(loc, builder);
   return builder.create<fir::CallOp>(loc, argumentCountFunc).getResult(0);
 }
 
 void fir::runtime::genGetCommandArgument(fir::FirOpBuilder &builder,
                                          mlir::Location loc, mlir::Value number,
                                          mlir::Value value, mlir::Value length,
                                          mlir::Value status,
                                          mlir::Value errmsg) {
   auto argumentValueFunc =
       fir::runtime::getRuntimeFunc<mkRTKey(ArgumentValue)>(loc, 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 =
         builder.createConvert(loc, statusLoaded.getType(), valueResult);
     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);
     mlir::Value result =
         builder.create<fir::CallOp>(loc, argumentLengthFunc, args).getResult(0);
     const mlir::Value valueLoaded = builder.create<fir::LoadOp>(loc, length);
     mlir::Value resultCast =
         builder.createConvert(loc, valueLoaded.getType(), result);
     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);
+  }
+}

flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp

TEST_F(RuntimeCallTest, genGetCommandArgument) {
   fir::runtime::genGetCommandArgument(
       *firBuilder, loc, number, value, length, status, errmsg);
   checkCallOpFromResultBox(
       value, "_FortranAArgumentValue", /*nbArgs=*/3, /*addLocArgs=*/false);
   mlir::Block *block = firBuilder->getBlock();
   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);
+}

flang/unittests/Optimizer/Builder/Runtime/RuntimeCallTestBase.h

void SetUp() override {
     auto *entryBlock = func.addEntryBlock();
     mod.push_back(mod);
     builder.setInsertionPointToStart(entryBlock);
 
     fir::support::loadDialects(context);
     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();
     i64Ty = firBuilder->getI64Type();
     i128Ty = firBuilder->getIntegerType(128);
 
     f32Ty = firBuilder->getF32Type();
     f64Ty = firBuilder->getF64Type();
void SetUp() override {
     boxTy = fir::BoxType::get(mlir::NoneType::get(firBuilder->getContext()));
   }
 
   mlir::MLIRContext context;
   std::unique_ptr<fir::KindMapping> kindMap;
   std::unique_ptr<fir::FirOpBuilder> firBuilder;
 
   // Commonly used types
+  mlir::Type i1Ty;
   mlir::Type i8Ty;
   mlir::Type i16Ty;
   mlir::Type i32Ty;
   mlir::Type i64Ty;
   mlir::Type i128Ty;
   mlir::Type f32Ty;
   mlir::Type f64Ty;
   mlir::Type f80Ty;