diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Command.h b/flang/include/flang/Optimizer/Builder/Runtime/Command.h --- a/flang/include/flang/Optimizer/Builder/Runtime/Command.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Command.h @@ -39,21 +39,15 @@ mlir::Value number, mlir::Value value, mlir::Value length, mlir::Value errmsg); -/// Generate a call to EnvVariableValue runtime function which implements -/// the part of GET_ENVIRONMENT_ARGUMENT related to VALUE, ERRMSG, and STATUS. -/// \p value and \p errmsg must be fir.box that can be absent (but not null -/// mlir values). The status value is returned. \p name must be a fir.box. -/// and \p trimName a boolean value. -mlir::Value genEnvVariableValue(fir::FirOpBuilder &, mlir::Location, - mlir::Value name, mlir::Value value, - mlir::Value trimName, mlir::Value errmsg); - -/// Generate a call to EnvVariableLength runtime function which implements -/// the part of GET_ENVIRONMENT_ARGUMENT related to LENGTH. -/// It returns the length of the \p number command arguments. -/// \p name must be a fir.box and \p trimName a boolean value. -mlir::Value genEnvVariableLength(fir::FirOpBuilder &, mlir::Location, - mlir::Value name, mlir::Value trimName); +/// Generate a call to GetEnvVariable runtime function which implements +/// the GET_ENVIRONMENT_VARIABLE intrinsic. +/// \p value, \p length and \p errmsg must be fir.box that can be absent (but +/// not null mlir values). The status value is returned. \p name must be a +/// fir.box and \p trimName a boolean value. +mlir::Value genGetEnvVariable(fir::FirOpBuilder &, mlir::Location, + mlir::Value name, mlir::Value value, + mlir::Value length, mlir::Value trimName, + mlir::Value errmsg); } // namespace fir::runtime #endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_COMMAND_H diff --git a/flang/include/flang/Runtime/command.h b/flang/include/flang/Runtime/command.h --- a/flang/include/flang/Runtime/command.h +++ b/flang/include/flang/Runtime/command.h @@ -40,20 +40,12 @@ int line = 0); // 16.9.84 GET_ENVIRONMENT_VARIABLE -// We're breaking up the interface into several different functions, since most -// of the parameters are optional. - // Try to get the value of the environment variable specified by NAME. // Returns a STATUS as described in the standard. -std::int32_t RTNAME(EnvVariableValue)(const Descriptor &name, - const Descriptor *value = nullptr, bool trim_name = true, - const Descriptor *errmsg = nullptr, const char *sourceFile = nullptr, - int line = 0); - -// Try to get the significant length of the environment variable specified by -// NAME. Returns 0 if it doesn't manage. -std::int64_t RTNAME(EnvVariableLength)(const Descriptor &name, - bool trim_name = true, const char *sourceFile = nullptr, int line = 0); +std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name, + const Descriptor *value = nullptr, const Descriptor *length = nullptr, + bool trim_name = true, const Descriptor *errmsg = nullptr, + const char *sourceFile = nullptr, int line = 0); } } // namespace Fortran::runtime diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -598,9 +598,9 @@ &I::genGetEnvironmentVariable, {{{"name", asBox}, {"value", asBox, handleDynamicOptional}, - {"length", asAddr}, - {"status", asAddr}, - {"trim_name", asAddr}, + {"length", asBox, handleDynamicOptional}, + {"status", asAddr, handleDynamicOptional}, + {"trim_name", asAddr, handleDynamicOptional}, {"errmsg", asBox, handleDynamicOptional}}}, /*isElemental=*/false}, {"iachar", &I::genIchar}, @@ -3203,6 +3203,14 @@ const fir::ExtendedValue &trimName = args[4]; const fir::ExtendedValue &errmsg = args[5]; + if (!name) + fir::emitFatalError(loc, "expected NAME parameter"); + + // If none of the optional parameters are present, do nothing. + if (!isStaticallyPresent(value) && !isStaticallyPresent(length) && + !isStaticallyPresent(status) && !isStaticallyPresent(errmsg)) + return; + // Handle optional TRIM_NAME argument mlir::Value trim; if (isStaticallyAbsent(trimName)) { @@ -3227,39 +3235,27 @@ .getResults()[0]; } - if (isStaticallyPresent(value) || isStaticallyPresent(status) || - isStaticallyPresent(errmsg)) { - mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); - mlir::Value valBox = - isStaticallyPresent(value) - ? fir::getBase(value) - : builder.create(loc, boxNoneTy).getResult(); - mlir::Value errBox = - isStaticallyPresent(errmsg) - ? fir::getBase(errmsg) - : builder.create(loc, boxNoneTy).getResult(); - mlir::Value stat = fir::runtime::genEnvVariableValue(builder, loc, name, - valBox, trim, errBox); - if (isStaticallyPresent(status)) { - mlir::Value statAddr = fir::getBase(status); - mlir::Value statIsPresentAtRuntime = - builder.genIsNotNullAddr(loc, statAddr); - builder.genIfThen(loc, statIsPresentAtRuntime) - .genThen( - [&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) - .end(); - } - } - - if (isStaticallyPresent(length)) { - mlir::Value lenAddr = fir::getBase(length); - mlir::Value lenIsPresentAtRuntime = builder.genIsNotNullAddr(loc, lenAddr); - builder.genIfThen(loc, lenIsPresentAtRuntime) - .genThen([&]() { - mlir::Value len = - fir::runtime::genEnvVariableLength(builder, loc, name, trim); - builder.createStoreWithConvert(loc, len, lenAddr); - }) + mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType()); + mlir::Value valBox = + isStaticallyPresent(value) + ? fir::getBase(value) + : builder.create(loc, boxNoneTy).getResult(); + mlir::Value lenBox = + isStaticallyPresent(length) + ? fir::getBase(length) + : builder.create(loc, boxNoneTy).getResult(); + mlir::Value errBox = + isStaticallyPresent(errmsg) + ? fir::getBase(errmsg) + : builder.create(loc, boxNoneTy).getResult(); + mlir::Value stat = fir::runtime::genGetEnvVariable(builder, loc, name, valBox, + lenBox, trim, errBox); + if (isStaticallyPresent(status)) { + mlir::Value statAddr = fir::getBase(status); + mlir::Value statIsPresentAtRuntime = + builder.genIsNotNullAddr(loc, statAddr); + builder.genIfThen(loc, statIsPresentAtRuntime) + .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); }) .end(); } } diff --git a/flang/lib/Optimizer/Builder/Runtime/Command.cpp b/flang/lib/Optimizer/Builder/Runtime/Command.cpp --- a/flang/lib/Optimizer/Builder/Runtime/Command.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Command.cpp @@ -63,32 +63,20 @@ return builder.create(loc, runtimeFunc, args).getResult(0); } -mlir::Value fir::runtime::genEnvVariableValue( - fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value name, - mlir::Value value, mlir::Value trimName, mlir::Value errmsg) { - auto valueFunc = - fir::runtime::getRuntimeFunc(loc, builder); - mlir::FunctionType valueFuncTy = valueFunc.getFunctionType(); - mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); - mlir::Value sourceLine = - fir::factory::locationToLineNo(builder, loc, valueFuncTy.getInput(5)); - llvm::SmallVector args = - fir::runtime::createArguments(builder, loc, valueFuncTy, name, value, - trimName, errmsg, sourceFile, sourceLine); - return builder.create(loc, valueFunc, args).getResult(0); -} - -mlir::Value fir::runtime::genEnvVariableLength(fir::FirOpBuilder &builder, - mlir::Location loc, - mlir::Value name, - mlir::Value trimName) { - auto lengthFunc = - fir::runtime::getRuntimeFunc(loc, builder); - mlir::FunctionType lengthFuncTy = lengthFunc.getFunctionType(); +mlir::Value fir::runtime::genGetEnvVariable(fir::FirOpBuilder &builder, + mlir::Location loc, + mlir::Value name, mlir::Value value, + mlir::Value length, + mlir::Value trimName, + mlir::Value errmsg) { + auto runtimeFunc = + fir::runtime::getRuntimeFunc(loc, builder); + mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); mlir::Value sourceLine = - fir::factory::locationToLineNo(builder, loc, lengthFuncTy.getInput(3)); + fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(6)); llvm::SmallVector args = fir::runtime::createArguments( - builder, loc, lengthFuncTy, name, trimName, sourceFile, sourceLine); - return builder.create(loc, lengthFunc, args).getResult(0); + builder, loc, runtimeFuncTy, name, value, length, trimName, errmsg, + sourceFile, sourceLine); + return builder.create(loc, runtimeFunc, args).getResult(0); } diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp --- a/flang/runtime/command.cpp +++ b/flang/runtime/command.cpp @@ -226,45 +226,42 @@ return s + 1; } -static const char *GetEnvVariableValue( - const Descriptor &name, bool trim_name, const char *sourceFile, int line) { - std::size_t nameLength{ - trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()}; - if (nameLength == 0) { - return nullptr; - } - +std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name, + const Descriptor *value, const Descriptor *length, bool trim_name, + const Descriptor *errmsg, const char *sourceFile, int line) { Terminator terminator{sourceFile, line}; - const char *value{executionEnvironment.GetEnv( - name.OffsetElement(), nameLength, terminator)}; - return value; -} -std::int32_t RTNAME(EnvVariableValue)(const Descriptor &name, - const Descriptor *value, bool trim_name, const Descriptor *errmsg, - const char *sourceFile, int line) { - if (IsValidCharDescriptor(value)) { + if (value) { + RUNTIME_CHECK(terminator, IsValidCharDescriptor(value)); FillWithSpaces(*value); } - const char *rawValue{GetEnvVariableValue(name, trim_name, sourceFile, line)}; + // Store 0 in case we error out later on. + if (length) { + RUNTIME_CHECK(terminator, IsValidIntDescriptor(length)); + StoreLengthToDescriptor(length, 0, terminator); + } + + const char *rawValue{nullptr}; + std::size_t nameLength{ + trim_name ? LengthWithoutTrailingSpaces(name) : name.ElementBytes()}; + if (nameLength != 0) { + rawValue = executionEnvironment.GetEnv( + name.OffsetElement(), nameLength, terminator); + } if (!rawValue) { return ToErrmsg(errmsg, StatMissingEnvVariable); } - if (IsValidCharDescriptor(value)) { - return CopyToDescriptor(*value, rawValue, StringLength(rawValue), errmsg); + std::int64_t varLen{StringLength(rawValue)}; + if (length && FitsInDescriptor(length, varLen, terminator)) { + StoreLengthToDescriptor(length, varLen, terminator); } + if (value) { + return CopyToDescriptor(*value, rawValue, varLen, errmsg); + } return StatOk; } -std::int64_t RTNAME(EnvVariableLength)( - const Descriptor &name, bool trim_name, const char *sourceFile, int line) { - const char *value{GetEnvVariableValue(name, trim_name, sourceFile, line)}; - if (!value) { - return 0; - } - return StringLength(value); -} } // namespace Fortran::runtime diff --git a/flang/test/Lower/Intrinsics/get_environment_variable-optional.f90 b/flang/test/Lower/Intrinsics/get_environment_variable-optional.f90 --- a/flang/test/Lower/Intrinsics/get_environment_variable-optional.f90 +++ b/flang/test/Lower/Intrinsics/get_environment_variable-optional.f90 @@ -3,58 +3,54 @@ ! CHECK-LABEL: func @_QPtest( -! CHECK-SAME: %[[VAL_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "name", fir.optional}, -! CHECK-SAME: %[[VAL_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "value", fir.optional}, -! CHECK-SAME: %[[VAL_2:.*]]: !fir.ref {fir.bindc_name = "length", fir.optional}, -! CHECK-SAME: %[[VAL_3:.*]]: !fir.ref {fir.bindc_name = "status", fir.optional}, -! CHECK-SAME: %[[VAL_4:.*]]: !fir.ref> {fir.bindc_name = "trim_name", fir.optional}, -! CHECK-SAME: %[[VAL_5:.*]]: !fir.boxchar<1> {fir.bindc_name = "errmsg", fir.optional}) { -subroutine test(name, value, length, status, trim_name, errmsg) +! CHECK-SAME: %[[ARG_0:.*]]: !fir.boxchar<1> {fir.bindc_name = "name", fir.optional}, +! CHECK-SAME: %[[ARG_1:.*]]: !fir.boxchar<1> {fir.bindc_name = "value", fir.optional}, +! CHECK-SAME: %[[ARG_2:.*]]: !fir.ref {fir.bindc_name = "length", fir.optional}, +! CHECK-SAME: %[[ARG_3:.*]]: !fir.ref {fir.bindc_name = "status", fir.optional}, +! CHECK-SAME: %[[ARG_4:.*]]: !fir.ref> {fir.bindc_name = "trim_name", fir.optional}, +! CHECK-SAME: %[[ARG_5:.*]]: !fir.boxchar<1> {fir.bindc_name = "errmsg", fir.optional}) { +subroutine test(name, value, length, status, trim_name, errmsg) integer, optional :: status, length character(*), optional :: name, value, errmsg logical, optional :: trim_name - ! Note: name is not optional in et_environment_variable and must be present - call get_environment_variable(name, value, length, status, trim_name, errmsg) -! CHECK: %[[VAL_6:.*]]:2 = fir.unboxchar %[[VAL_5]] : (!fir.boxchar<1>) -> (!fir.ref>, index) -! CHECK: %[[VAL_7:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) -! CHECK: %[[VAL_8:.*]]:2 = fir.unboxchar %[[VAL_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) -! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_7]]#0 typeparams %[[VAL_7]]#1 : (!fir.ref>, index) -> !fir.box> -! CHECK: %[[VAL_10:.*]] = fir.is_present %[[VAL_8]]#0 : (!fir.ref>) -> i1 -! CHECK: %[[VAL_11:.*]] = fir.embox %[[VAL_8]]#0 typeparams %[[VAL_8]]#1 : (!fir.ref>, index) -> !fir.box> -! CHECK: %[[VAL_12:.*]] = fir.absent !fir.box> -! CHECK: %[[VAL_13:.*]] = arith.select %[[VAL_10]], %[[VAL_11]], %[[VAL_12]] : !fir.box> -! CHECK: %[[VAL_14:.*]] = fir.is_present %[[VAL_6]]#0 : (!fir.ref>) -> i1 -! CHECK: %[[VAL_15:.*]] = fir.embox %[[VAL_6]]#0 typeparams %[[VAL_6]]#1 : (!fir.ref>, index) -> !fir.box> -! CHECK: %[[VAL_16:.*]] = fir.absent !fir.box> -! CHECK: %[[VAL_17:.*]] = arith.select %[[VAL_14]], %[[VAL_15]], %[[VAL_16]] : !fir.box> -! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> i64 -! CHECK: %[[VAL_19:.*]] = arith.constant 0 : i64 -! CHECK: %[[VAL_20:.*]] = arith.cmpi ne, %[[VAL_18]], %[[VAL_19]] : i64 -! CHECK: %[[VAL_21:.*]] = fir.if %[[VAL_20]] -> (i1) { -! CHECK: %[[VAL_22:.*]] = fir.load %[[VAL_4]] : !fir.ref> -! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_22]] : (!fir.logical<4>) -> i1 -! CHECK: fir.result %[[VAL_23]] : i1 + ! Note: name is not optional in get_environment_variable and must be present + call get_environment_variable(name, value, length, status, trim_name, errmsg) +! CHECK: %[[VAL_0:.*]]:2 = fir.unboxchar %[[ARG_5]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG_0]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG_1]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_2]]#0 : (!fir.ref>) -> i1 +! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box> +! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_4]], %[[VAL_5]], %[[VAL_6]] : !fir.box> +! CHECK: %[[VAL_8:.*]] = fir.is_present %[[ARG_2]] : (!fir.ref) -> i1 +! CHECK: %[[VAL_9:.*]] = fir.embox %[[ARG_2]] : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box +! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.box +! CHECK: %[[VAL_12:.*]] = fir.is_present %[[VAL_0]]#0 : (!fir.ref>) -> i1 +! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_0]]#0 typeparams %[[VAL_0]]#1 : (!fir.ref>, index) -> !fir.box> +! CHECK: %[[VAL_14:.*]] = fir.absent !fir.box> +! CHECK: %[[VAL_15:.*]] = arith.select %[[VAL_12]], %[[VAL_13]], %[[VAL_14]] : !fir.box> +! CHECK: %[[VAL_16:.*]] = fir.convert %[[ARG_4]] : (!fir.ref>) -> i64 +! CHECK: %[[CONST_0:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_17:.*]] = arith.cmpi ne, %[[VAL_16]], %[[CONST_0]] : i64 +! CHECK: %[[VAL_18:.*]] = fir.if %[[VAL_17]] -> (i1) { +! CHECK: %[[VAL_28:.*]] = fir.load %[[ARG_4]] : !fir.ref> +! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (!fir.logical<4>) -> i1 +! CHECK: fir.result %[[VAL_29]] : i1 ! CHECK: } else { -! CHECK: %[[VAL_24:.*]] = arith.constant true -! CHECK: fir.result %[[VAL_24]] : i1 +! CHECK: %[[CONST_1:.*]] = arith.constant true +! CHECK: fir.result %[[CONST_1]] : i1 ! CHECK: } -! CHECK: %[[VAL_27:.*]] = fir.convert %[[VAL_9]] : (!fir.box>) -> !fir.box -! CHECK: %[[VAL_28:.*]] = fir.convert %[[VAL_13]] : (!fir.box>) -> !fir.box -! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_17]] : (!fir.box>) -> !fir.box -! CHECK: %[[VAL_31:.*]] = fir.call @_FortranAEnvVariableValue(%[[VAL_27]], %[[VAL_28]], %[[VAL_32:.*]], %[[VAL_29]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 -! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_3]] : (!fir.ref) -> i64 -! CHECK: %[[VAL_34:.*]] = arith.constant 0 : i64 -! CHECK: %[[VAL_35:.*]] = arith.cmpi ne, %[[VAL_33]], %[[VAL_34]] : i64 -! CHECK: fir.if %[[VAL_35]] { -! CHECK: fir.store %[[VAL_31]] to %[[VAL_3]] : !fir.ref -! CHECK: } -! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_2]] : (!fir.ref) -> i64 -! CHECK: %[[VAL_37:.*]] = arith.constant 0 : i64 -! CHECK: %[[VAL_38:.*]] = arith.cmpi ne, %[[VAL_36]], %[[VAL_37]] : i64 -! CHECK: fir.if %[[VAL_38]] { -! CHECK: %[[VAL_41:.*]] = fir.convert %[[VAL_9]] : (!fir.box>) -> !fir.box -! CHECK: %[[VAL_43:.*]] = fir.call @_FortranAEnvVariableLength(%[[VAL_41]], %[[VAL_32]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box, i1, !fir.ref, i32) -> i64 -! CHECK: %[[VAL_44:.*]] = fir.convert %[[VAL_43]] : (i64) -> i32 -! CHECK: fir.store %[[VAL_44]] to %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_11]] : (!fir.box) -> !fir.box +! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_15]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAGetEnvVariable(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_18]], %[[VAL_23]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK: %[[VAL_26:.*]] = fir.convert %[[ARG_3]] : (!fir.ref) -> i64 +! CHECK: %[[CONST_2:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_27:.*]] = arith.cmpi ne, %[[VAL_26]], %[[CONST_2]] : i64 +! CHECK: fir.if %[[VAL_27]] { +! CHECK: fir.store %[[VAL_25]] to %[[ARG_3]] : !fir.ref ! CHECK: } end subroutine diff --git a/flang/test/Lower/Intrinsics/get_environment_variable.f90 b/flang/test/Lower/Intrinsics/get_environment_variable.f90 --- a/flang/test/Lower/Intrinsics/get_environment_variable.f90 +++ b/flang/test/Lower/Intrinsics/get_environment_variable.f90 @@ -1,15 +1,14 @@ ! RUN: bbc -emit-fir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-32 -DDEFAULT_INTEGER_SIZE=32 %s ! RUN: flang-new -fc1 -fdefault-integer-8 -emit-fir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-64 -DDEFAULT_INTEGER_SIZE=64 %s -! CHECK-LABEL: func @_QPnumber_only( +! CHECK-LABEL: func @_QPname_only( ! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}) { -subroutine number_only(name) +subroutine name_only(name) character(len=32) :: name call get_environment_variable(name) -! CHECK-NOT: fir.call @_FortranAEnvVariableValue -! CHECK-NOT: fir.call @_FortranAEnvVariableLength +! CHECK-NOT: fir.call @_FortranAGetEnvVariable ! CHECK-NEXT: return -end subroutine number_only +end subroutine name_only ! CHECK-LABEL: func @_QPname_and_value_only( ! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, @@ -24,13 +23,14 @@ ! CHECK-NEXT: %[[nameBox:.*]] = fir.embox %[[nameUnbox]]#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> ! CHECK-NEXT: %[[valueBox:.*]] = fir.embox %[[valueUnbox]]#0 typeparams %[[valueLength]] : (!fir.ref>, index) -> !fir.box> ! CHECK-NEXT: %true = arith.constant true +! CHECK-NEXT: %[[length:.*]] = fir.absent !fir.box ! CHECK-NEXT: %[[errmsg:.*]] = fir.absent !fir.box ! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl{{.*}}) : !fir.ref> -! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 10]] : i32 +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32 ! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBox]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[value:.*]] = fir.convert %[[valueBox]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref -! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 ! CHECK-NEXT: return end subroutine name_and_value_only @@ -41,19 +41,19 @@ character(len=32) :: name integer :: length call get_environment_variable(name, LENGTH=length) -! CHECK-NOT: fir.call @_FortranAEnvVariableValue ! CHECK: %[[nameUnbox:.*]]:2 = fir.unboxchar %[[nameArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) ! CHECK-NEXT: %[[nameLength:.*]] = arith.constant 32 : index ! CHECK-NEXT: %[[nameBox:.*]] = fir.embox %0#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[lengthBox:.*]] = fir.embox %arg1 : (!fir.ref) -> !fir.box ! CHECK-NEXT: %true = arith.constant true +! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[errmsg:.*]] = fir.absent !fir.box ! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> -! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 7]] : i32 +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32 ! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBox]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[length:.*]] = fir.convert %[[lengthBox]] : (!fir.box) -> !fir.box ! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref -! CHECK-32-NEXT: %[[length64:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %true, %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, i1, !fir.ref, i32) -> i64 -! CHECK-64-NEXT: %[[length:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %true, %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, i1, !fir.ref, i32) -> i64 -! CHECK-32-NEXT: %[[length:.*]] = fir.convert %[[length64]] : (i64) -> i32 -! CHECK-NEXT: fir.store %[[length]] to %[[lengthArg]] : !fir.ref +! CHECK-NEXT: %{{.*}} = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 end subroutine name_and_length_only ! CHECK-LABEL: func @_QPname_and_status_only( @@ -68,13 +68,14 @@ ! CHECK-NEXT: %[[nameBox:.*]] = fir.embox %[[nameUnbox]]#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> ! CHECK-NEXT: %true = arith.constant true ! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[length:.*]] = fir.absent !fir.box ! CHECK-NEXT: %[[errmsg:.*]] = fir.absent !fir.box ! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> -! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 8]] : i32 +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32 ! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBox]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref -! CHECK-32-NEXT: %[[status:.*]] = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 -! CHECK-64-NEXT: %[[status32:.*]] = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-32-NEXT: %[[status:.*]] = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-64-NEXT: %[[status32:.*]] = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 ! CHECK-64: %[[status:.*]] = fir.convert %[[status32]] : (i32) -> i64 ! CHECK: fir.store %[[status]] to %[[statusArg]] : !fir.ref end subroutine name_and_status_only @@ -86,8 +87,7 @@ character(len=32) :: name logical :: trim_name call get_environment_variable(name, TRIM_NAME=trim_name) - ! CHECK-NOT: fir.call @_FortranAEnvVariableValue - ! CHECK-NOT: fir.call @_FortranAEnvVariableLength + ! CHECK-NOT: fir.call @_FortranAGetEnvVariable ! CHECK-NEXT: return end subroutine name_and_trim_name_only @@ -105,12 +105,13 @@ ! CHECK-NEXT: %[[errmsgBox:.*]] = fir.embox %[[errmsgUnbox]]#0 typeparams %c32 : (!fir.ref>, index) -> !fir.box> ! CHECK-NEXT: %true = arith.constant true ! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[length:.*]] = fir.absent !fir.box ! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> -! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 10]] : i32 +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32 ! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBox]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[errmsg:.*]] = fir.convert %[[errmsgBox]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref -! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %true, %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 ! CHECK-NEXT: return end subroutine name_and_errmsg_only @@ -134,6 +135,7 @@ ! CHECK-NEXT: %[[valueLength:.*]] = arith.constant 32 : index ! CHECK-NEXT: %[[nameBoxed:.*]] = fir.embox %[[nameUnbox]]#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> ! CHECK-NEXT: %[[valueBoxed:.*]] = fir.embox %[[valueUnbox]]#0 typeparams %[[valueLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[lengthBoxed:.*]] = fir.embox %[[lengthArg]] : (!fir.ref) -> !fir.box ! CHECK-NEXT: %[[errmsgBoxed:.*]] = fir.embox %[[errmsgUnbox]]#0 typeparams %[[errmsgLength]] : (!fir.ref>, index) -> !fir.box> ! CHECK: %[[trimName:.*]] = fir.if %{{.*}} -> (i1) { ! CHECK-NEXT: %[[trimNameLoaded:.*]] = fir.load %[[trimNameArg]] : !fir.ref> @@ -144,21 +146,14 @@ ! CHECK-NEXT: fir.result %[[trueVal]] : i1 ! CHECK-NEXT: } ! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.[[fileString:.*]]) : !fir.ref> -! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 19]] : i32 +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 20]] : i32 ! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBoxed]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[value:.*]] = fir.convert %[[valueBoxed]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[length:.*]] = fir.convert %[[lengthBoxed]] : (!fir.box) -> !fir.box ! CHECK-NEXT: %[[errmsg:.*]] = fir.convert %[[errmsgBoxed]] : (!fir.box>) -> !fir.box ! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref -! CHECK-32-NEXT: %[[status:.*]] = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %[[trimName]], %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 -! CHECK-64-NEXT: %[[status32:.*]] = fir.call @_FortranAEnvVariableValue(%[[name]], %[[value]], %[[trimName]], %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-32-NEXT: %[[status:.*]] = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %[[trimName]], %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 +! CHECK-64-NEXT: %[[status32:.*]] = fir.call @_FortranAGetEnvVariable(%[[name]], %[[value]], %[[length]], %[[trimName]], %[[errmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box, !fir.box, !fir.box, i1, !fir.box, !fir.ref, i32) -> i32 ! CHECK-64: %[[status:.*]] = fir.convert %[[status32]] : (i32) -> i64 ! CHECK: fir.store %[[status]] to %[[statusArg]] : !fir.ref -! CHECK: %[[sourceFileString2:.*]] = fir.address_of(@_QQcl.[[fileString]]) : !fir.ref> -! CHECK-NEXT: %[[sourceLine2:.*]] = arith.constant [[# @LINE - 29]] : i32 -! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBoxed]] : (!fir.box>) -> !fir.box -! CHECK-NEXT: %[[sourceFile2:.*]] = fir.convert %[[sourceFileString2]] : (!fir.ref>) -> !fir.ref -! CHECK-32-NEXT: %[[result64:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %[[trimName]], %[[sourceFile2]], %[[sourceLine2]]) {{.*}}: (!fir.box, i1, !fir.ref, i32) -> i64 -! CHECK-64-NEXT: %[[result:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %[[trimName]], %[[sourceFile2]], %[[sourceLine2]]) {{.*}}: (!fir.box, i1, !fir.ref, i32) -> i64 -! CHECK-32: %[[result:.*]] = fir.convert %[[result64]] : (i64) -> i32 -! CHECK-NEXT: fir.store %[[result]] to %[[lengthArg]] : !fir.ref end subroutine all_arguments diff --git a/flang/test/Runtime/no-cpp-dep.c b/flang/test/Runtime/no-cpp-dep.c --- a/flang/test/Runtime/no-cpp-dep.c +++ b/flang/test/Runtime/no-cpp-dep.c @@ -26,11 +26,13 @@ int32_t RTNAME(ArgumentCount)(); int32_t RTNAME(GetCommandArgument)(int32_t, const struct Descriptor *, const struct Descriptor *, const struct Descriptor *); +int32_t RTNAME(GetEnvVariable)(); int main() { double x = RTNAME(CpuTime)(); RTNAME(ProgramStart)(0, 0, 0, 0); int32_t c = RTNAME(ArgumentCount)(); int32_t v = RTNAME(GetCommandArgument)(0, 0, 0, 0); - return x + c + v; + int32_t e = RTNAME(GetEnvVariable)("FOO", 0, 0); + return x + c + v + e; } diff --git a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp --- a/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp +++ b/flang/unittests/Optimizer/Builder/Runtime/CommandTest.cpp @@ -32,26 +32,15 @@ /*addLocArgs=*/true); } -TEST_F(RuntimeCallTest, genEnvVariableValue) { +TEST_F(RuntimeCallTest, genGetEnvVariable) { mlir::Location loc = firBuilder->getUnknownLoc(); - mlir::Type charTy = fir::BoxType::get(firBuilder->getNoneType()); - mlir::Value name = firBuilder->create(loc, charTy); - mlir::Value value = firBuilder->create(loc, charTy); + mlir::Value name = firBuilder->create(loc, boxTy); + mlir::Value value = firBuilder->create(loc, boxTy); + mlir::Value length = firBuilder->create(loc, boxTy); mlir::Value trimName = firBuilder->create(loc, i1Ty); - mlir::Value errmsg = firBuilder->create(loc, charTy); - mlir::Value result = fir::runtime::genEnvVariableValue( - *firBuilder, loc, name, value, trimName, errmsg); - checkCallOp(result.getDefiningOp(), "_FortranAEnvVariableValue", /*nbArgs=*/4, + mlir::Value errmsg = firBuilder->create(loc, boxTy); + mlir::Value result = fir::runtime::genGetEnvVariable( + *firBuilder, loc, name, value, length, trimName, errmsg); + checkCallOp(result.getDefiningOp(), "_FortranAGetEnvVariable", /*nbArgs=*/5, /*addLocArgs=*/true); } - -TEST_F(RuntimeCallTest, genEnvVariableLength) { - mlir::Location loc = firBuilder->getUnknownLoc(); - mlir::Type charTy = fir::BoxType::get(firBuilder->getNoneType()); - mlir::Value name = firBuilder->create(loc, charTy); - mlir::Value trimName = firBuilder->create(loc, i1Ty); - mlir::Value result = - fir::runtime::genEnvVariableLength(*firBuilder, loc, name, trimName); - checkCallOp(result.getDefiningOp(), "_FortranAEnvVariableLength", - /*nbArgs=*/2, /*addLocArgs=*/true); -} diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp --- a/flang/unittests/Runtime/CommandTest.cpp +++ b/flang/unittests/Runtime/CommandTest.cpp @@ -132,12 +132,12 @@ SCOPED_TRACE(name); SCOPED_TRACE("Checking environment variable"); CheckValue( - [&](const Descriptor *value, const Descriptor *, + [&](const Descriptor *value, const Descriptor *length, const Descriptor *errmsg) { - return RTNAME(EnvVariableValue)(*CharDescriptor(name), value, - trimName, errmsg, /*sourceFile=*/nullptr, /*line=*/0); + return RTNAME(GetEnvVariable)( + *CharDescriptor(name), value, length, trimName, errmsg); }, - expectedValue); + expectedValue, std::strlen(expectedValue)); } void CheckMissingEnvVarValue(const char *name, bool trimName = true) const { @@ -147,15 +147,13 @@ ASSERT_EQ(nullptr, std::getenv(name)) << "Environment variable " << name << " not expected to exist"; - OwningPtr nameDescriptor{CharDescriptor(name)}; - EXPECT_EQ(0, RTNAME(EnvVariableLength)(*nameDescriptor, trimName)); CheckValue( - [&](const Descriptor *value, const Descriptor *, + [&](const Descriptor *value, const Descriptor *length, const Descriptor *errmsg) { - return RTNAME(EnvVariableValue)(*nameDescriptor, value, trimName, - errmsg, /*sourceFile=*/nullptr, /*line=*/0); + return RTNAME(GetEnvVariable)( + *CharDescriptor(name), value, length, trimName, errmsg); }, - "", -1, 1, "Missing environment variable"); + "", 0, 1, "Missing environment variable"); } void CheckMissingArgumentValue(int n, const char *errStr = nullptr) const { @@ -416,7 +414,6 @@ TEST_F(EnvironmentVariables, Nonexistent) { CheckMissingEnvVarValue("DOESNT_EXIST"); - CheckMissingEnvVarValue(" "); CheckMissingEnvVarValue(""); } @@ -425,12 +422,15 @@ // Test a variable that's expected to exist in the environment. char *path{std::getenv("PATH")}; auto expectedLen{static_cast(std::strlen(path))}; - EXPECT_EQ(expectedLen, RTNAME(EnvVariableLength)(*CharDescriptor("PATH"))); + OwningPtr length{EmptyIntDescriptor()}; + EXPECT_EQ(0, + RTNAME(GetEnvVariable)(*CharDescriptor("PATH"), + /*value=*/nullptr, length.get())); + CheckDescriptorEqInt(length.get(), expectedLen); } TEST_F(EnvironmentVariables, Trim) { if (EnableFineGrainedTests()) { - EXPECT_EQ(5, RTNAME(EnvVariableLength)(*CharDescriptor("NAME "))); CheckEnvVarValue("VALUE", "NAME "); } } @@ -443,7 +443,6 @@ TEST_F(EnvironmentVariables, Empty) { if (EnableFineGrainedTests()) { - EXPECT_EQ(0, RTNAME(EnvVariableLength)(*CharDescriptor("EMPTY"))); CheckEnvVarValue("", "EMPTY"); } } @@ -451,10 +450,10 @@ TEST_F(EnvironmentVariables, NoValueOrErrmsg) { ASSERT_EQ(std::getenv("DOESNT_EXIST"), nullptr) << "Environment variable DOESNT_EXIST actually exists"; - EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("DOESNT_EXIST")), 1); + EXPECT_EQ(RTNAME(GetEnvVariable)(*CharDescriptor("DOESNT_EXIST")), 1); if (EnableFineGrainedTests()) { - EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME")), 0); + EXPECT_EQ(RTNAME(GetEnvVariable)(*CharDescriptor("NAME")), 0); } } @@ -462,16 +461,16 @@ if (EnableFineGrainedTests()) { OwningPtr tooShort{CreateEmptyCharDescriptor<2>()}; ASSERT_NE(tooShort, nullptr); - EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME"), tooShort.get(), - /*trim_name=*/true, nullptr), + EXPECT_EQ(RTNAME(GetEnvVariable)(*CharDescriptor("NAME"), tooShort.get(), + /*length=*/nullptr, /*trim_name=*/true, nullptr), -1); CheckDescriptorEqStr(tooShort.get(), "VALUE"); OwningPtr errMsg{CreateEmptyCharDescriptor()}; ASSERT_NE(errMsg, nullptr); - EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("NAME"), tooShort.get(), - /*trim_name=*/true, errMsg.get()), + EXPECT_EQ(RTNAME(GetEnvVariable)(*CharDescriptor("NAME"), tooShort.get(), + /*length=*/nullptr, /*trim_name=*/true, errMsg.get()), -1); std::string expectedErrMsg{ @@ -485,8 +484,8 @@ << "Environment variable DOESNT_EXIST actually exists"; OwningPtr errMsg{CreateEmptyCharDescriptor<3>()}; - EXPECT_EQ(RTNAME(EnvVariableValue)(*CharDescriptor("DOESNT_EXIST"), nullptr, - /*trim_name=*/true, errMsg.get()), + EXPECT_EQ(RTNAME(GetEnvVariable)(*CharDescriptor("DOESNT_EXIST"), nullptr, + /*length=*/nullptr, /*trim_name=*/true, errMsg.get()), 1); CheckDescriptorEqStr(errMsg.get(), "Mis"); }