[flang] Add runtime and lowering implementation for extended intrinsic PUTENV (#134412)
Implement extended intrinsic PUTENV, both function and subroutine forms.
Add PUTENV documentation to flang/docs/Intrinsics.md. Add functional and
semantic unit tests.
diff --git a/flang-rt/include/flang-rt/runtime/environment.h b/flang-rt/include/flang-rt/runtime/environment.h
index ca6c2a7..16258b3 100644
--- a/flang-rt/include/flang-rt/runtime/environment.h
+++ b/flang-rt/include/flang-rt/runtime/environment.h
@@ -45,6 +45,13 @@
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);
+
+ 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/command.cpp b/flang-rt/lib/runtime/command.cpp
index b69143b..a4e8e31 100644
--- a/flang-rt/lib/runtime/command.cpp
+++ b/flang-rt/lib/runtime/command.cpp
@@ -309,6 +309,55 @@
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::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@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 +373,5 @@
return status;
}
+
} // namespace Fortran::runtime
diff --git a/flang-rt/lib/runtime/environment.cpp b/flang-rt/lib/runtime/environment.cpp
index cf2c65d..1d53042 100644
--- a/flang-rt/lib/runtime/environment.cpp
+++ b/flang-rt/lib/runtime/environment.cpp
@@ -181,4 +181,68 @@
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;
+}
+
+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
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ecf6fbe..0118f8e 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -1040,6 +1040,41 @@
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 @@
### 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 @@
`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
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 00b7b69..68617d6 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -382,6 +382,8 @@
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(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/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
index 5880a70..fe19f24 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h
@@ -68,6 +68,11 @@
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 16854c9..19b4860 100644
--- a/flang/include/flang/Runtime/command.h
+++ b/flang/include/flang/Runtime/command.h
@@ -64,11 +64,15 @@
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 997a745..709f2e6 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -856,6 +856,8 @@
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,
@@ -1639,6 +1641,12 @@
{}, 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,
@@ -2874,8 +2882,8 @@
// Collection for some intrinsics with function and subroutine form,
// in order to pass the semantic check.
static const std::string dualIntrinsic[]{{"chdir"}, {"etime"}, {"fseek"},
- {"ftell"}, {"getcwd"}, {"hostnm"}, {"rename"}, {"second"}, {"system"},
- {"unlink"}};
+ {"ftell"}, {"getcwd"}, {"hostnm"}, {"putenv"s}, {"rename"}, {"second"},
+ {"system"}, {"unlink"}};
return llvm::is_contained(dualIntrinsic, name);
}
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 702a55a..93c00b6 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -793,6 +793,10 @@
{"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}}},
@@ -7329,6 +7333,39 @@
"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 27ea596..35aa529 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp
@@ -126,6 +126,20 @@
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) {
diff --git a/flang/test/Lower/Intrinsics/putenv-func.f90 b/flang/test/Lower/Intrinsics/putenv-func.f90
new file mode 100644
index 0000000..9b28282
--- /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 0000000..285dbc6
--- /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 0000000..8ec98f0
--- /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
