[flang] [llvm] [flang] Add runtime and lowering implementation for extended intrinsic PUTENV (PR #134412)
Eugene Epshteyn via llvm-commits
llvm-commits at lists.llvm.org
Fri Apr 4 10:13:39 PDT 2025
https://github.com/eugeneepshteyn updated https://github.com/llvm/llvm-project/pull/134412
>From 81f2070c1ac25b0638442e7c4dfce5ddecdbe015 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 3 Apr 2025 13:53:48 -0400
Subject: [PATCH 1/7] ExecutionEnvironment::SetEnv()
modified: flang-rt/include/flang-rt/runtime/environment.h
modified: flang-rt/lib/runtime/environment.cpp
---
.../include/flang-rt/runtime/environment.h | 5 +++
flang-rt/lib/runtime/environment.cpp | 37 +++++++++++++++++++
2 files changed, 42 insertions(+)
diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h
index ca6c2a7d44484..46b4923b717ec 100644
--- a/flang-rt/include/flang-rt/runtime/environment.h
+++ b/flang-rt/include/flang-rt/runtime/environment.h
@@ -45,6 +45,11 @@ struct ExecutionEnvironment {
const char *GetEnv(
const char *name, std::size_t name_length, const Terminator &terminator);
+ std::int32_t SetEnv(
+ const char *name, std::size_t name_length,
+ const char *value, std::size_t value_length,
+ const Terminator &terminator);
+
int argc{0};
const char **argv{nullptr};
char **envp{nullptr};
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index cf2c65dd4fac0..f6b96013ca21a 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -181,4 +181,41 @@ const char *ExecutionEnvironment::GetEnv(
return std::getenv(cStyleName.get());
}
+
+std::int32_t ExecutionEnvironment::SetEnv(
+ const char *name, std::size_t name_length,
+ const char *value, std::size_t value_length,
+ const Terminator &terminator) {
+
+ RUNTIME_CHECK(terminator, name && name_length && value && value_length);
+
+ OwningPtr<char> cStyleName{
+ SaveDefaultCharacter(name, name_length, terminator)};
+ RUNTIME_CHECK(terminator, cStyleName);
+
+ OwningPtr<char> cStyleValue{
+ SaveDefaultCharacter(value, value_length, terminator)};
+ RUNTIME_CHECK(terminator, cStyleValue);
+
+ std::int32_t status{0};
+
+#ifdef _WIN32
+
+ status = _putenv_s(cStyleName.get(), cStyleValue.get());
+
+#else
+
+ constexpr int overwrite = 1;
+ status = setenv(cStyleName.get(), cStyleValue.get(), overwrite);
+
+#endif
+
+ if (status != 0)
+ {
+ status = errno;
+ }
+
+ return status;
+}
+
} // namespace Fortran::runtime
>From 0012c00298ee64dc1d6e7db430b2b11fd4afc41e Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 3 Apr 2025 14:39:28 -0400
Subject: [PATCH 2/7] ExecutionEnvironment::UnsetEnv() modified:
flang-rt/include/flang-rt/runtime/environment.h modified:
flang-rt/lib/runtime/environment.cpp
---
.../include/flang-rt/runtime/environment.h | 4 +++
flang-rt/lib/runtime/environment.cpp | 31 +++++++++++++++++++
2 files changed, 35 insertions(+)
diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h
index 46b4923b717ec..6e496d383de48 100644
--- a/flang-rt/include/flang-rt/runtime/environment.h
+++ b/flang-rt/include/flang-rt/runtime/environment.h
@@ -50,6 +50,10 @@ struct ExecutionEnvironment {
const char *value, std::size_t value_length,
const Terminator &terminator);
+ std::int32_t UnsetEnv(
+ const char *name, std::size_t name_length,
+ const Terminator &terminator);
+
int argc{0};
const char **argv{nullptr};
char **envp{nullptr};
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index f6b96013ca21a..e40029dcb445d 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -218,4 +218,35 @@ std::int32_t ExecutionEnvironment::SetEnv(
return status;
}
+std::int32_t ExecutionEnvironment::UnsetEnv(
+ const char *name, std::size_t name_length,
+ const Terminator &terminator) {
+
+ RUNTIME_CHECK(terminator, name && name_length);
+
+ OwningPtr<char> cStyleName{
+ SaveDefaultCharacter(name, name_length, terminator)};
+ RUNTIME_CHECK(terminator, cStyleName);
+
+ std::int32_t status{0};
+
+#ifdef _WIN32
+
+ // Passing empty string as value will unset the variable
+ status = _putenv_s(cStyleName.get(), "");
+
+#else
+
+ status = unsetenv(cStyleName.get());
+
+#endif
+
+ if (status != 0)
+ {
+ status = errno;
+ }
+
+ return status;
+}
+
} // namespace Fortran::runtime
>From 104e61d78f381ca80c883e9f68c0287a6d9e391f Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Thu, 3 Apr 2025 18:35:37 -0400
Subject: [PATCH 3/7] Intermediary work modified:
flang-rt/lib/runtime/command.cpp modified:
flang-rt/lib/runtime/environment.cpp modified:
flang/include/flang/Optimizer/Builder/IntrinsicCall.h modified:
flang/include/flang/Optimizer/Builder/Runtime/Command.h modified:
flang/include/flang/Runtime/command.h modified:
flang/lib/Evaluate/intrinsics.cpp modified:
flang/lib/Optimizer/Builder/IntrinsicCall.cpp modified:
flang/lib/Optimizer/Builder/Runtime/Command.cpp
---
flang-rt/lib/runtime/command.cpp | 54 +++++++++++++++++++
flang-rt/lib/runtime/environment.cpp | 8 ++-
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
.../flang/Optimizer/Builder/Runtime/Command.h | 5 ++
flang/include/flang/Runtime/command.h | 4 ++
flang/lib/Evaluate/intrinsics.cpp | 11 +++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 37 +++++++++++++
.../lib/Optimizer/Builder/Runtime/Command.cpp | 14 +++++
8 files changed, 131 insertions(+), 3 deletions(-)
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index b69143bf458ba..aa83b69eb1386 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -309,6 +309,59 @@ std::int32_t RTNAME(Hostnm)(
return status;
}
+std::int32_t RTNAME(PutEnv)(
+ const char *str, size_t str_length, const char *sourceFile, int line) {
+ Terminator terminator{sourceFile, line};
+
+ RUNTIME_CHECK(terminator, str && str_length);
+
+ // Note: don't trim the input string, because the user should be able
+ // to set the value to all spaces if necessary.
+
+ // While Fortran's putenv() extended intrinsic sementics loosly follow
+ // Linux C library putenv(), don't actually use putenv() on Linux, because
+ // it takes the passed string pointer and incorporates it into the
+ // environment without copy. To make this safe, one would have to copy
+ // the passed string into some allocated memory, but then there's no good
+ // way to deallocate it. Instead, use the implementation from
+ // ExecutionEnvironment, which does the right thing for both Windows and
+ // Linux.
+
+ std::printf("EE: %s: str = \"%.*s\", str_lengh = %zu\n", __func__, int{str_length}, str);
+
+ std::int32_t status{0};
+
+ // Split the input string into name and value substrings. Note:
+ // if input string is in "name=value" form, then we set variable "name" with
+ // value "value". If the input string is in "name=" form, then we delete
+ // the variable "name".
+
+ const char *str_end = str + str_length;
+ const char *str_sep = std::find(str, str_end, '=');
+ if (str_sep == str_end) {
+ // No separator, invalid input string
+ status == EINVAL;
+ }
+ else if ((str_sep + 1) == str_end) {
+ // "name=" form, which means we need to delete this variable
+ status = executionEnvironment.UnsetEnv(str, str_sep - str, terminator);
+ }
+ else {
+ // Example: consider str "abc=defg", str_length = 8
+ //
+ // addr: 05 06 07 08 09 10 11 12 13
+ // str at addr: a b c = d e f g ??
+ //
+ // str = 5, str_end = 13, str_sep = 8, name length: str_sep - str = 3
+ // value ptr: str_sep + 1 = 9, value length: 4
+ //
+ status = executionEnvironment.SetEnv(
+ str, str_sep - str, str_sep + 1, str_end - str_sep - 1, terminator);
+ }
+
+ return status;
+}
+
std::int32_t RTNAME(Unlink)(
const char *str, size_t strLength, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
@@ -324,4 +377,5 @@ std::int32_t RTNAME(Unlink)(
return status;
}
+
} // namespace Fortran::runtime
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index e40029dcb445d..5b481f48c0106 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -189,6 +189,8 @@ std::int32_t ExecutionEnvironment::SetEnv(
RUNTIME_CHECK(terminator, name && name_length && value && value_length);
+ std::printf("EE: %s: name = \"%.*s\", name_lengh = %zu, value = \"%.*s\", value_lengh = %zu\n", __func__, int{name_length}, name, int{value_length}, value);
+
OwningPtr<char> cStyleName{
SaveDefaultCharacter(name, name_length, terminator)};
RUNTIME_CHECK(terminator, cStyleName);
@@ -219,11 +221,13 @@ std::int32_t ExecutionEnvironment::SetEnv(
}
std::int32_t ExecutionEnvironment::UnsetEnv(
- const char *name, std::size_t name_length,
- const Terminator &terminator) {
+ const char *name, std::size_t name_length,
+ const Terminator &terminator) {
RUNTIME_CHECK(terminator, name && name_length);
+ std::printf("EE: %s: name = \"%.*s\", name_lengh = %zu\n", __func__, int{name_length}, name);
+
OwningPtr<char> cStyleName{
SaveDefaultCharacter(name, name_length, terminator)};
RUNTIME_CHECK(terminator, cStyleName);
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 29cde05480173..da153b4d3add9 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -378,6 +378,7 @@ struct IntrinsicLibrary {
mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genPutEnv(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 5880a703ed92e..fe19f24d951fd 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -68,6 +68,11 @@ mlir::Value genHostnm(fir::FirOpBuilder &builder, mlir::Location loc,
void genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value string);
+/// Generate a call to the runtime function which implements the PUTENV
+/// intrinsic.
+mlir::Value genPutEnv(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Value str, mlir::Value strLength);
+
/// Generate a call to the Unlink runtime function which implements
/// the UNLINK intrinsic.
mlir::Value genUnlink(fir::FirOpBuilder &builder, mlir::Location loc,
diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h
index 16854c981ca23..19b486094da17 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -64,11 +64,15 @@ std::int32_t RTNAME(GetCwd)(
std::int32_t RTNAME(Hostnm)(
const Descriptor &res, const char *sourceFile, int line);
+std::int32_t RTNAME(PutEnv)(
+ const char *str, size_t str_length, const char *sourceFile, int line);
+
// Calls unlink()
std::int32_t RTNAME(Unlink)(
const char *path, size_t pathLength, const char *sourceFile, int line);
} // extern "C"
+
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_COMMAND_H_
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index e4f82b7fddb02..48aa602250f46 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -842,6 +842,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"present", {{"a", Addressable, Rank::anyOrAssumedRank}}, DefaultLogical,
Rank::scalar, IntrinsicClass::inquiryFunction},
+ {"putenv", {{"str", DefaultChar, Rank::scalar}}, DefaultInt, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
{"radix",
{{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::In, {ArgFlag::canBeMoldNull}}},
@@ -1581,6 +1583,12 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
{"perror", {{"string", DefaultChar, Rank::scalar}}, {}, Rank::elemental,
IntrinsicClass::impureSubroutine},
+ {"putenv",
+ {{"str", DefaultChar, Rank::scalar, Optionality::required,
+ common::Intent::In},
+ {"status", DefaultInt, Rank::scalar, Optionality::optional,
+ common::Intent::Out}},
+ {}, Rank::elemental, IntrinsicClass::impureSubroutine},
{"mvbits",
{{"from", SameIntOrUnsigned}, {"frompos", AnyInt}, {"len", AnyInt},
{"to", SameIntOrUnsigned, Rank::elemental, Optionality::required,
@@ -2812,7 +2820,8 @@ bool IntrinsicProcTable::Implementation::IsDualIntrinsic(
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
static const std::string dualIntrinsic[]{{"chdir"s}, {"etime"s}, {"getcwd"s},
- {"hostnm"s}, {"rename"s}, {"second"s}, {"system"s}, {"unlink"s}};
+ {"hostnm"s}, {"putenv"s}, {"rename"s}, {"second"s}, {"system"s},
+ {"unlink"s}};
return llvm::is_contained(dualIntrinsic, name);
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 2df9349269a69..a924879a20291 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -782,6 +782,10 @@ static constexpr IntrinsicHandler handlers[]{
{"dim", asValue},
{"mask", asBox, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"putenv",
+ &I::genPutEnv,
+ {{{"str", asAddr}, {"status", asAddr, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"random_init",
&I::genRandomInit,
{{{"repeatable", asValue}, {"image_distinct", asValue}}},
@@ -7254,6 +7258,39 @@ IntrinsicLibrary::genProduct(mlir::Type resultType,
"PRODUCT", resultType, args);
}
+// PUTENV
+fir::ExtendedValue
+IntrinsicLibrary::genPutEnv(std::optional<mlir::Type> resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert((resultType.has_value() && args.size() == 1) ||
+ (!resultType.has_value() && args.size() >= 1 && args.size() <= 2));
+
+ mlir::Value str = fir::getBase(args[0]);
+ mlir::Value strLength = fir::getLen(args[0]);
+ mlir::Value statusValue =
+ fir::runtime::genPutEnv(builder, loc, str, strLength);
+
+ if (resultType.has_value()) {
+ // Function form, return status.
+ return builder.createConvert(loc, *resultType, statusValue);
+ }
+
+ // Subroutine form, store status and return none.
+ const fir::ExtendedValue &status = args[1];
+ if (!isStaticallyAbsent(status)) {
+ mlir::Value statusAddr = fir::getBase(status);
+ mlir::Value statusIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, statusAddr);
+ builder.genIfThen(loc, statusIsPresentAtRuntime)
+ .genThen([&]() {
+ builder.createStoreWithConvert(loc, statusValue, statusAddr);
+ })
+ .end();
+ }
+
+ return {};
+}
+
// RANDOM_INIT
void IntrinsicLibrary::genRandomInit(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 2);
diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
index 27ea5961837e6..35aa529a9a727 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -126,6 +126,20 @@ void fir::runtime::genPerror(fir::FirOpBuilder &builder, mlir::Location loc,
builder.create<fir::CallOp>(loc, runtimeFunc, args);
}
+mlir::Value fir::runtime::genPutEnv(fir::FirOpBuilder &builder,
+ mlir::Location loc, mlir::Value str,
+ mlir::Value strLength) {
+ mlir::func::FuncOp func =
+ fir::runtime::getRuntimeFunc<mkRTKey(PutEnv)>(loc, builder);
+ auto runtimeFuncTy = func.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(1));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, str, strLength, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
+
mlir::Value fir::runtime::genUnlink(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value path,
mlir::Value pathLength) {
>From d0b65a5fea424ebc328e3c7006b663f4fa5c944a Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 4 Apr 2025 12:06:15 -0400
Subject: [PATCH 4/7] Fixed compilation issues, removed debug code, tested the
functionality
modified: flang-rt/lib/runtime/command.cpp
modified: flang-rt/lib/runtime/environment.cpp
modified: flang/include/flang/Optimizer/Builder/IntrinsicCall.h
modified: flang/lib/Optimizer/Builder/IntrinsicCall.cpp
---
flang-rt/lib/runtime/command.cpp | 4 +---
flang-rt/lib/runtime/environment.cpp | 4 ----
flang/include/flang/Optimizer/Builder/IntrinsicCall.h | 3 ++-
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 4 ++--
4 files changed, 5 insertions(+), 10 deletions(-)
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index aa83b69eb1386..c0a0dbbf45921 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -327,8 +327,6 @@ std::int32_t RTNAME(PutEnv)(
// ExecutionEnvironment, which does the right thing for both Windows and
// Linux.
- std::printf("EE: %s: str = \"%.*s\", str_lengh = %zu\n", __func__, int{str_length}, str);
-
std::int32_t status{0};
// Split the input string into name and value substrings. Note:
@@ -340,7 +338,7 @@ std::int32_t RTNAME(PutEnv)(
const char *str_sep = std::find(str, str_end, '=');
if (str_sep == str_end) {
// No separator, invalid input string
- status == EINVAL;
+ status = EINVAL;
}
else if ((str_sep + 1) == str_end) {
// "name=" form, which means we need to delete this variable
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index 5b481f48c0106..1030ed615e877 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -189,8 +189,6 @@ std::int32_t ExecutionEnvironment::SetEnv(
RUNTIME_CHECK(terminator, name && name_length && value && value_length);
- std::printf("EE: %s: name = \"%.*s\", name_lengh = %zu, value = \"%.*s\", value_lengh = %zu\n", __func__, int{name_length}, name, int{value_length}, value);
-
OwningPtr<char> cStyleName{
SaveDefaultCharacter(name, name_length, terminator)};
RUNTIME_CHECK(terminator, cStyleName);
@@ -226,8 +224,6 @@ std::int32_t ExecutionEnvironment::UnsetEnv(
RUNTIME_CHECK(terminator, name && name_length);
- std::printf("EE: %s: name = \"%.*s\", name_lengh = %zu\n", __func__, int{name_length}, name);
-
OwningPtr<char> cStyleName{
SaveDefaultCharacter(name, name_length, terminator)};
RUNTIME_CHECK(terminator, cStyleName);
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index da153b4d3add9..c0a15c67de7c2 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -378,7 +378,8 @@ struct IntrinsicLibrary {
mlir::Value genPoppar(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genPresent(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genProduct(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
- fir::ExtendedValue genPutEnv(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genPutenv(std::optional<mlir::Type>,
+ llvm::ArrayRef<fir::ExtendedValue>);
void genRandomInit(llvm::ArrayRef<fir::ExtendedValue>);
void genRandomNumber(llvm::ArrayRef<fir::ExtendedValue>);
void genRandomSeed(llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index a924879a20291..83896dbdd6211 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -783,7 +783,7 @@ static constexpr IntrinsicHandler handlers[]{
{"mask", asBox, handleDynamicOptional}}},
/*isElemental=*/false},
{"putenv",
- &I::genPutEnv,
+ &I::genPutenv,
{{{"str", asAddr}, {"status", asAddr, handleDynamicOptional}}},
/*isElemental=*/false},
{"random_init",
@@ -7260,7 +7260,7 @@ IntrinsicLibrary::genProduct(mlir::Type resultType,
// PUTENV
fir::ExtendedValue
-IntrinsicLibrary::genPutEnv(std::optional<mlir::Type> resultType,
+IntrinsicLibrary::genPutenv(std::optional<mlir::Type> resultType,
llvm::ArrayRef<fir::ExtendedValue> args) {
assert((resultType.has_value() && args.size() == 1) ||
(!resultType.has_value() && args.size() >= 1 && args.size() <= 2));
>From d7918ddef63500d2cae616a93f14eab93c5ef3ea Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 4 Apr 2025 12:20:18 -0400
Subject: [PATCH 5/7] Documentation modified: flang/docs/Intrinsics.md
---
flang/docs/Intrinsics.md | 39 +++++++++++++++++++++++++++++++++++++--
1 file changed, 37 insertions(+), 2 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ecf6fbeabd654..0118f8eb7d913 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1040,6 +1040,41 @@ PROGRAM example_hostnm
END PROGRAM
```
+### Non-Standard Intrinsics: PUTENV
+
+#### Description
+`PUTENV(STR [, STATUS])` sets or deletes environment variable.
+
+This intrinsic is provided in both subroutine and function forms; however, only
+one form can be used in any given program unit.
+
+| ARGUMENT | INTENT | TYPE | KIND | Description |
+|----------|--------|-------------|---------|---------------------------------|
+| `STR` | `IN` | `CHARACTER` | default | String in the form "name=value" (see below) |
+| `STATUS` | `OUT` | `INTEGER` | default | Optional. Returns 0 on success, C's `errno` on failure. |
+
+#### Usage and Info
+
+- **Standard:** extension
+- **Class:** Subroutine, function
+- **Syntax:** `CALL PUTENV(STR [, STATUS])`, `STATUS = PUTENV(STR)`
+
+The passed string can be in the form "name=value" to set environment variable "name" to value "value". It can also be of the form "name=" to delete environment variable "name".
+
+The environment variables set by PUTENV can be read by GET_ENVIRONMENT_VARIABLE.
+
+#### Example
+```Fortran
+ integer :: status
+
+ ! Set variable my_var to value my_value
+ putenv("my_var=my_value", status)
+
+ ! Delete variable my_var
+ putenv("my_var=")
+ end
+```
+
### Non-standard Intrinsics: RENAME
`RENAME(OLD, NEW[, STATUS])` renames/moves a file on the filesystem.
@@ -1094,7 +1129,7 @@ function form.
### Non-Standard Intrinsics: TIME
#### Description
-`TIME()` returns the current time of the system as a INTEGER(8).
+`TIME()` returns the current time of the system as a INTEGER(8).
#### Usage and Info
@@ -1269,7 +1304,7 @@ by `ISIZE`.
`COMPAR` function takes the addresses of element `A` and `B` and must return:
- a negative value if `A` < `B`
- zero if `A` == `B`
-- a positive value otherwise.
+- a positive value otherwise.
#### Usage and Info
>From f789557f89eee9b076a1642d26d875747ffe07e2 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 4 Apr 2025 12:34:42 -0400
Subject: [PATCH 6/7] Added tests
new file: test/Lower/Intrinsics/putenv-func.f90
new file: test/Lower/Intrinsics/putenv-sub.f90
new file: test/Semantics/putenv.f90
---
flang/test/Lower/Intrinsics/putenv-func.f90 | 24 +++++++++
flang/test/Lower/Intrinsics/putenv-sub.f90 | 54 +++++++++++++++++++++
flang/test/Semantics/putenv.f90 | 42 ++++++++++++++++
3 files changed, 120 insertions(+)
create mode 100644 flang/test/Lower/Intrinsics/putenv-func.f90
create mode 100644 flang/test/Lower/Intrinsics/putenv-sub.f90
create mode 100644 flang/test/Semantics/putenv.f90
diff --git a/flang/test/Lower/Intrinsics/putenv-func.f90 b/flang/test/Lower/Intrinsics/putenv-func.f90
new file mode 100644
index 0000000000000..9b28282a0b787
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/putenv-func.f90
@@ -0,0 +1,24 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPputenv_test
+!CHECK-SAME: %[[dummyStr:.*]]: !fir.boxchar<1> {fir.bindc_name = "str"}) -> i32 {
+integer function putenv_test(str)
+CHARACTER(len=255) :: str
+
+!CHECK-DAG: %[[func_result:.*]] = fir.alloca i32 {bindc_name = "putenv_test", uniq_name = "_QFputenv_testEputenv_test"}
+!CHECK-DAG: %[[func_result_decl:.*]]:{{.*}} = hlfir.declare %[[func_result]] {uniq_name = "_QFputenv_testEputenv_test"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+!CHECK-DAG: %[[src_str_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>
+!CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+!CHECK-DAG: %[[str:.*]] = fir.convert {{.*}} (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+!CHECK-DAG: %[[str_len:.*]] = fir.convert {{.*}} : (index) -> i64
+!CHECK-DAG: %[[src_str:.*]] = fir.convert %[[src_str_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+!CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+!CHECK: %[[putenv_result:.*]] = fir.call @_FortranAPutEnv(%[[str]], %[[str_len]], %[[src_str]], %[[line]])
+!CHECK-SAME: -> i32
+
+! Check _FortranAPutEnv result code handling
+!CHECK-DAG: hlfir.assign %[[putenv_result]] to %[[func_result_decl]]#0 : i32, !fir.ref<i32>
+!CHECK-DAG: %[[load_result:.*]] = fir.load %[[func_result_decl]]#0 : !fir.ref<i32>
+!CHECK: return %[[load_result]] : i32
+putenv_test = putenv(str)
+end function putenv_test
diff --git a/flang/test/Lower/Intrinsics/putenv-sub.f90 b/flang/test/Lower/Intrinsics/putenv-sub.f90
new file mode 100644
index 0000000000000..285dbc6fddb19
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/putenv-sub.f90
@@ -0,0 +1,54 @@
+!RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+!CHECK-LABEL: func.func @_QPstr_only
+!CHECK-SAME: %[[dummyStr:.*]]: !fir.boxchar<1> {fir.bindc_name = "str"}) {
+subroutine str_only(str)
+ CHARACTER(len=*) :: str
+ !CHECK-DAG: %[[scope:.*]] = fir.dummy_scope : !fir.dscope
+ !CHECK-DAG: %[[unbox_str:.*]]:2 = fir.unboxchar %[[dummyStr]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-DAG: %[[str_decl:.*]]:2 = hlfir.declare %[[unbox_str]]#0 typeparams %[[unbox_str]]#1 dummy_scope %[[scope]] {uniq_name = "_QFstr_onlyEstr"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-DAG: %[[src_str_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ !CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+ !CHECK-DAG: %[[str:.*]] = fir.convert %[[str_decl]]#1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[str_len:.*]] = fir.convert %[[unbox_str]]#1 : (index) -> i64
+ !CHECK-DAG: %[[src_str:.*]] = fir.convert %[[src_str_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+ !CHECK: fir.call @_FortranAPutEnv(%[[str]], %[[str_len]], %[[src_str]], %[[line]])
+ !CHECK-SAME: : (!fir.ref<i8>, i64, !fir.ref<i8>, i32)
+ !CHECK-SAME: -> i32
+ call putenv(str)
+ !CHECK: return
+end subroutine str_only
+ !CHECK: }
+
+ !CHECK-LABEL: func.func @_QPall_arguments
+ !CHECK-SAME: %[[dummyStr:.*]]: !fir.boxchar<1> {fir.bindc_name = "str"}
+ !CHECK-SAME: %[[dummyStat:.*]]: !fir.ref<i32> {fir.bindc_name = "status"}
+ !CHECK-SAME: ) {
+subroutine all_arguments(str, status)
+ CHARACTER(len=*) :: str
+ INTEGER :: status
+ !CHECK-DAG: %[[scope:.*]] = fir.dummy_scope : !fir.dscope
+ !CHECK-DAG: %[[unbox_str:.*]]:2 = fir.unboxchar %[[dummyStr]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+ !CHECK-DAG: %[[str_decl:.*]]:2 = hlfir.declare %[[unbox_str]]#0 typeparams %[[unbox_str]]#1 dummy_scope %[[scope]] {uniq_name = "_QFall_argumentsEstr"} : (!fir.ref<!fir.char<1,?>>, index, !fir.dscope) -> (!fir.boxchar<1>, !fir.ref<!fir.char<1,?>>)
+ !CHECK-DAG: %[[status_decl:.*]]:2 = hlfir.declare %[[dummyStat]] dummy_scope %[[scope]] {uniq_name = "_QFall_argumentsEstatus"} : (!fir.ref<i32>, !fir.dscope) -> (!fir.ref<i32>, !fir.ref<i32>)
+ !CHECK-DAG: %[[src_str_addr:.*]] = fir.address_of(@_{{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+ !CHECK-DAG: %[[line_value:.*]] = arith.constant {{.*}} : i64
+ !CHECK-DAG: %[[str:.*]] = fir.convert %[[str_decl]]#1 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[str_len:.*]] = fir.convert %[[unbox_str]]#1 : (index) -> i64
+ !CHECK-DAG: %[[src_str:.*]] = fir.convert %[[src_str_addr]] : (!fir.ref<!fir.char<1,{{.*}}>) -> !fir.ref<i8>
+ !CHECK-DAG: %[[line:.*]] = fir.convert %[[line_value]] : (i64) -> i32
+ !CHECK: %[[putenv_result:.*]] = fir.call @_FortranAPutEnv(%[[str]], %[[str_len]], %[[src_str]], %[[line]])
+ !CHECK-SAME: : (!fir.ref<i8>, i64, !fir.ref<i8>, i32)
+ !CHECK-SAME: -> i32
+
+ !CHECK-DAG: %[[status_i64:.*]] = fir.convert %[[status_decl]]#0 : (!fir.ref<i32>) -> i64
+ !CHECK-DAG: %[[c_null:.*]] = arith.constant 0 : i64
+ !CHECK-DAG: %[[cmp_result:.*]] = arith.cmpi ne, %[[status_i64]], %[[c_null]] : i64
+ !CHECK: fir.if %[[cmp_result]] {
+ !CHECK-NEXT: fir.store %[[putenv_result]] to %[[status_decl]]#0 : !fir.ref<i32>
+ !CHECK-NEXT: }
+ call putenv(str, status)
+ !CHECK: return
+end subroutine all_arguments
+ !CHECK: }
diff --git a/flang/test/Semantics/putenv.f90 b/flang/test/Semantics/putenv.f90
new file mode 100644
index 0000000000000..8ec98f01ec7a4
--- /dev/null
+++ b/flang/test/Semantics/putenv.f90
@@ -0,0 +1,42 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Tests for the putenv intrinsics.
+
+subroutine bad_kind_error(str, status)
+ CHARACTER(len=255) :: str
+ INTEGER(2) :: status
+ !ERROR: Actual argument for 'status=' has bad type or kind 'INTEGER(2)'
+ call putenv(str, status)
+end subroutine bad_kind_error
+
+subroutine bad_args_error()
+ !ERROR: missing mandatory 'str=' argument
+ call putenv()
+end subroutine bad_args_error
+
+subroutine bad_function(str)
+ CHARACTER(len=255) :: str
+ INTEGER :: status
+ call putenv(str, status)
+ !ERROR: Cannot call subroutine 'putenv' like a function
+ status = putenv(str)
+end subroutine bad_function
+
+subroutine bad_sub(str)
+ CHARACTER(len=255) :: str
+ INTEGER :: status
+ status = putenv(str)
+ !ERROR: Cannot call function 'putenv' like a subroutine
+ call putenv(str, status)
+end subroutine bad_sub
+
+subroutine good_subroutine(str, status)
+ CHARACTER(len=255) :: str
+ INTEGER :: status
+ call putenv(str, status)
+end subroutine good_subroutine
+
+subroutine good_function(str, status)
+ CHARACTER(len=255) :: str
+ INTEGER :: status
+ status = putenv(str)
+end subroutine good_function
>From a5fbadaccc99a40293eec48fed87f685977368f4 Mon Sep 17 00:00:00 2001
From: Eugene Epshteyn <eepshteyn at nvidia.com>
Date: Fri, 4 Apr 2025 13:13:22 -0400
Subject: [PATCH 7/7] clang-format
---
flang-rt/include/flang-rt/runtime/environment.h | 6 ++----
flang-rt/lib/runtime/command.cpp | 8 +++-----
flang-rt/lib/runtime/environment.cpp | 16 ++++++----------
3 files changed, 11 insertions(+), 19 deletions(-)
diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h
index 6e496d383de48..16258b3bbba9b 100644
--- a/flang-rt/include/flang-rt/runtime/environment.h
+++ b/flang-rt/include/flang-rt/runtime/environment.h
@@ -45,14 +45,12 @@ struct ExecutionEnvironment {
const char *GetEnv(
const char *name, std::size_t name_length, const Terminator &terminator);
- std::int32_t SetEnv(
- const char *name, std::size_t name_length,
+ std::int32_t SetEnv(const char *name, std::size_t name_length,
const char *value, std::size_t value_length,
const Terminator &terminator);
std::int32_t UnsetEnv(
- const char *name, std::size_t name_length,
- const Terminator &terminator);
+ const char *name, std::size_t name_length, const Terminator &terminator);
int argc{0};
const char **argv{nullptr};
diff --git a/flang-rt/lib/runtime/command.cpp b/flang-rt/lib/runtime/command.cpp
index c0a0dbbf45921..a4e8e31ad0274 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -339,12 +339,10 @@ std::int32_t RTNAME(PutEnv)(
if (str_sep == str_end) {
// No separator, invalid input string
status = EINVAL;
- }
- else if ((str_sep + 1) == str_end) {
+ } else if ((str_sep + 1) == str_end) {
// "name=" form, which means we need to delete this variable
status = executionEnvironment.UnsetEnv(str, str_sep - str, terminator);
- }
- else {
+ } else {
// Example: consider str "abc=defg", str_length = 8
//
// addr: 05 06 07 08 09 10 11 12 13
@@ -354,7 +352,7 @@ std::int32_t RTNAME(PutEnv)(
// value ptr: str_sep + 1 = 9, value length: 4
//
status = executionEnvironment.SetEnv(
- str, str_sep - str, str_sep + 1, str_end - str_sep - 1, terminator);
+ str, str_sep - str, str_sep + 1, str_end - str_sep - 1, terminator);
}
return status;
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index 1030ed615e877..1d5304254ed0e 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -182,10 +182,9 @@ const char *ExecutionEnvironment::GetEnv(
return std::getenv(cStyleName.get());
}
-std::int32_t ExecutionEnvironment::SetEnv(
- const char *name, std::size_t name_length,
- const char *value, std::size_t value_length,
- const Terminator &terminator) {
+std::int32_t ExecutionEnvironment::SetEnv(const char *name,
+ std::size_t name_length, const char *value, std::size_t value_length,
+ const Terminator &terminator) {
RUNTIME_CHECK(terminator, name && name_length && value && value_length);
@@ -210,8 +209,7 @@ std::int32_t ExecutionEnvironment::SetEnv(
#endif
- if (status != 0)
- {
+ if (status != 0) {
status = errno;
}
@@ -219,8 +217,7 @@ std::int32_t ExecutionEnvironment::SetEnv(
}
std::int32_t ExecutionEnvironment::UnsetEnv(
- const char *name, std::size_t name_length,
- const Terminator &terminator) {
+ const char *name, std::size_t name_length, const Terminator &terminator) {
RUNTIME_CHECK(terminator, name && name_length);
@@ -241,8 +238,7 @@ std::int32_t ExecutionEnvironment::UnsetEnv(
#endif
- if (status != 0)
- {
+ if (status != 0) {
status = errno;
}
More information about the llvm-commits
mailing list