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 @@ -25,6 +25,7 @@ #include "flang/Optimizer/Builder/FIRBuilder.h" #include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Builder/Runtime/Character.h" +#include "flang/Optimizer/Builder/Runtime/Command.h" #include "flang/Optimizer/Builder/Runtime/Inquiry.h" #include "flang/Optimizer/Builder/Runtime/Numeric.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" @@ -445,6 +446,8 @@ mlir::Value genBtest(mlir::Type, llvm::ArrayRef); mlir::Value genCeiling(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue + genCommandArgumentCount(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef); template fir::ExtendedValue genCharacterCompare(mlir::Type, @@ -463,6 +466,8 @@ mlir::Value genFloor(mlir::Type, llvm::ArrayRef); mlir::Value genFraction(mlir::Type resultType, mlir::ArrayRef args); + void genGetCommandArgument(mlir::ArrayRef args); + void genGetEnvironmentVariable(llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments /// in the llvm::ArrayRef. mlir::Value genIand(mlir::Type, llvm::ArrayRef); @@ -634,6 +639,7 @@ {"btest", &I::genBtest}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, + {"command_argument_count", &I::genCommandArgumentCount}, {"count", &I::genCount, {{{"mask", asAddr}, {"dim", asValue}, {"kind", asValue}}}, @@ -672,6 +678,23 @@ {"exponent", &I::genExponent}, {"floor", &I::genFloor}, {"fraction", &I::genFraction}, + {"get_command_argument", + &I::genGetCommandArgument, + {{{"number", asValue}, + {"value", asAddr}, + {"length", asAddr}, + {"status", asAddr}, + {"errmsg", asAddr}}}, + /*isElemental=*/false}, + {"get_environment_variable", + &I::genGetEnvironmentVariable, + {{{"name", asValue}, + {"value", asAddr}, + {"length", asAddr}, + {"status", asAddr}, + {"trim_name", asValue}, + {"errmsg", asAddr}}}, + /*isElemental=*/false}, {"iachar", &I::genIchar}, {"iand", &I::genIand}, {"ibclr", &I::genIbclr}, @@ -1843,6 +1866,17 @@ return fir::CharBoxValue{cast, len}; } +// COMMAND_ARGUMENT_COUNT +fir::ExtendedValue IntrinsicLibrary::genCommandArgumentCount( + mlir::Type resultType, llvm::ArrayRef args) { + assert(args.size() == 0); + assert(resultType == builder.getDefaultIntegerType() && + "result type is not default integer kind type"); + return builder.createConvert( + loc, resultType, fir::runtime::genCommandArgumentCount(builder, loc)); + ; +} + // COUNT fir::ExtendedValue IntrinsicLibrary::genCount(mlir::Type resultType, @@ -2096,6 +2130,105 @@ fir::runtime::genFraction(builder, loc, fir::getBase(args[0]))); } +// GET_COMMAND_ARGUMENT +void IntrinsicLibrary::genGetCommandArgument( + llvm::ArrayRef args) { + assert(args.size() == 5); + + auto processCharBox = [&](llvm::Optional arg, + mlir::Value &value) -> void { + if (arg.hasValue()) { + value = builder.createBox(loc, *arg); + } else { + value = builder + .create( + loc, fir::BoxType::get(builder.getNoneType())) + .getResult(); + } + }; + + // Handle NUMBER argument + mlir::Value number = fir::getBase(args[0]); + if (!number) + fir::emitFatalError(loc, "expected NUMBER parameter"); + + // Handle optional VALUE argument + mlir::Value value; + llvm::Optional valBox; + if (const fir::CharBoxValue *charBox = args[1].getCharBox()) + valBox = *charBox; + processCharBox(valBox, value); + + // Handle optional LENGTH argument + mlir::Value length = fir::getBase(args[2]); + + // Handle optional STATUS argument + mlir::Value status = fir::getBase(args[3]); + + // Handle optional ERRMSG argument + mlir::Value errmsg; + llvm::Optional errmsgBox; + if (const fir::CharBoxValue *charBox = args[4].getCharBox()) + errmsgBox = *charBox; + processCharBox(errmsgBox, errmsg); + + fir::runtime::genGetCommandArgument(builder, loc, number, value, length, + status, errmsg); +} + +// GET_ENVIRONMENT_VARIABLE +void IntrinsicLibrary::genGetEnvironmentVariable( + llvm::ArrayRef args) { + assert(args.size() == 6); + + auto processCharBox = [&](llvm::Optional arg, + mlir::Value &value) -> void { + if (arg.hasValue()) { + value = builder.createBox(loc, *arg); + } else { + value = builder + .create( + loc, fir::BoxType::get(builder.getNoneType())) + .getResult(); + } + }; + + // Handle NAME argument + mlir::Value name; + if (const fir::CharBoxValue *charBox = args[0].getCharBox()) { + llvm::Optional nameBox = *charBox; + assert(nameBox.hasValue()); + name = builder.createBox(loc, *nameBox); + } + + // Handle optional VALUE argument + mlir::Value value; + llvm::Optional valBox; + if (const fir::CharBoxValue *charBox = args[1].getCharBox()) + valBox = *charBox; + processCharBox(valBox, value); + + // Handle optional LENGTH argument + mlir::Value length = fir::getBase(args[2]); + + // Handle optional STATUS argument + mlir::Value status = fir::getBase(args[3]); + + // Handle optional TRIM_NAME argument + mlir::Value trim_name = + isAbsent(args[4]) ? builder.createBool(loc, true) : fir::getBase(args[4]); + + // Handle optional ERRMSG argument + mlir::Value errmsg; + llvm::Optional errmsgBox; + if (const fir::CharBoxValue *charBox = args[5].getCharBox()) + errmsgBox = *charBox; + processCharBox(errmsgBox, errmsg); + + fir::runtime::genGetEnvironmentVariable(builder, loc, name, value, length, + status, trim_name, errmsg); +} + // IAND mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/test/Lower/Intrinsics/command_argument_count.f90 b/flang/test/Lower/Intrinsics/command_argument_count.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/command_argument_count.f90 @@ -0,0 +1,11 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! bbc doesn't have a way to set the default kinds so we use flang-new driver +! RUN: flang-new -fc1 -fdefault-integer-8 -emit-fir %s -o - | FileCheck --check-prefixes=CHECK,CHECK-64 %s + +! CHECK-LABEL: argument_count_test +subroutine argument_count_test() +integer :: arg_count_test +arg_count_test = command_argument_count() +! CHECK: %[[argumentCount:.*]] = fir.call @_FortranAArgumentCount() : () -> i32 +! CHECK-64: %{{[0-9]+}} = fir.convert %[[argumentCount]] : (i32) -> i64 +end subroutine argument_count_test diff --git a/flang/test/Lower/Intrinsics/get_command_argument.f90 b/flang/test/Lower/Intrinsics/get_command_argument.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/get_command_argument.f90 @@ -0,0 +1,106 @@ +! 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-SAME: %[[num:.*]]: !fir.ref{{.*}}) { +subroutine number_only(num) + integer :: num + call get_command_argument(num) +! CHECK-NOT: fir.call @_FortranAArgumentValue +! CHECK-NOT: fir.call @_FortranAArgumentLength +! CHECK-NEXT: return +end subroutine number_only + +! CHECK-LABEL: func @_QPnumber_and_value_only( +! CHECK-SAME: %[[num:.*]]: !fir.ref{{.*}}, %[[value:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine number_and_value_only(num, value) +integer :: num +character(len=32) :: value +call get_command_argument(num, value) +! CHECK: %[[valueUnboxed:.*]]:2 = fir.unboxchar %[[value]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[valueLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[numUnbox:.*]] = fir.load %[[num]] : !fir.ref +! CHECK-NEXT: %[[valueBoxed:.*]] = fir.embox %[[valueUnboxed]]#0 typeparams %[[valueLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[errmsg:.*]] = fir.absent !fir.box +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numUnbox]] : (i64) -> i32 +! CHECK-NEXT: %[[valueCast:.*]] = fir.convert %[[valueBoxed]] : (!fir.box>) -> !fir.box +! CHECK-32-NEXT: %{{[0-9]+}} = fir.call @_FortranAArgumentValue(%[[numUnbox]], %[[valueCast]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %{{[0-9]+}} = fir.call @_FortranAArgumentValue(%[[numCast]], %[[valueCast]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-NOT: fir.call @_FortranAArgumentLength +end subroutine number_and_value_only + +! CHECK-LABEL: func @_QPall_arguments( +! CHECK-SAME: %[[num:[^:]*]]: !fir.ref{{.*}}, %[[value:.*]]: !fir.boxchar<1>{{.*}}, %[[length:[^:]*]]: !fir.ref{{.*}}, %[[status:.*]]: !fir.ref{{.*}}, %[[errmsg:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine all_arguments(num, value, length, status, errmsg) + integer :: num, length, status + character(len=32) :: value, errmsg + call get_command_argument(num, value, length, status, errmsg) +! CHECK: %[[errmsgUnboxed:.*]]:2 = fir.unboxchar %[[errmsg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[errmsgLen:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[valueUnboxed:.*]]:2 = fir.unboxchar %[[value]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[valueLen:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[numUnboxed:.*]] = fir.load %[[num]] : !fir.ref +! CHECK-NEXT: %[[valueBoxed:.*]] = fir.embox %[[valueUnboxed]]#0 typeparams %[[valueLen]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[errmsgBoxed:.*]] = fir.embox %[[errmsgUnboxed]]#0 typeparams %[[errmsgLen]] : (!fir.ref>, index) -> !fir.box> +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numUnboxed]] : (i64) -> i32 +! CHECK-NEXT: %[[valueBuffer:.*]] = fir.convert %[[valueBoxed]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[errmsgBuffer:.*]] = fir.convert %[[errmsgBoxed]] : (!fir.box>) -> !fir.box +! CHECK-32-NEXT: %[[statusResult:.*]] = fir.call @_FortranAArgumentValue(%[[numUnboxed]], %[[valueBuffer]], %[[errmsgBuffer]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %[[statusResult32:.*]] = fir.call @_FortranAArgumentValue(%[[numCast]], %[[valueBuffer]], %[[errmsgBuffer]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %[[statusResult:.*]] = fir.convert %[[statusResult32]] : (i32) -> i64 +! CHECK-NEXT: fir.store %[[statusResult]] to %[[status]] : !fir.ref +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numUnboxed]] : (i64) -> i32 +! CHECK-32-NEXT: %[[lengthResult64:.*]] = fir.call @_FortranAArgumentLength(%[[numUnboxed]]) : (i32) -> i64 +! CHECK-64-NEXT: %[[lengthResult:.*]] = fir.call @_FortranAArgumentLength(%[[numCast]]) : (i32) -> i64 +! CHECK-32-NEXT: %[[lengthResult:.*]] = fir.convert %[[lengthResult64]] : (i64) -> i32 +! CHECK-NEXT: fir.store %[[lengthResult]] to %[[length]] : !fir.ref +end subroutine all_arguments + +! CHECK-LABEL: func @_QPnumber_and_length_only( +! CHECK-SAME: %[[num:.*]]: !fir.ref{{.*}}, %[[length:.*]]: !fir.ref{{.*}}) { +subroutine number_and_length_only(num, length) + integer :: num, length + call get_command_argument(num, LENGTH=length) +! CHECK-NOT: fir.call @_FortranAArgumentValue +! CHECK: %[[numLoaded:.*]] = fir.load %[[num]] : !fir.ref +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numLoaded]] : (i64) -> i32 +! CHECK-32-NEXT: %[[result64:.*]] = fir.call @_FortranAArgumentLength(%[[numLoaded]]) : (i32) -> i64 +! CHECK-64-NEXT: %[[result:.*]] = fir.call @_FortranAArgumentLength(%[[numCast]]) : (i32) -> i64 +! CHECK-32-NEXT: %[[result:.*]] = fir.convert %[[result64]] : (i64) -> i32 +! CHECK-NEXT: fir.store %[[result]] to %[[length]] : !fir.ref +! CHECK-NEXT: return +end subroutine number_and_length_only + +! CHECK-LABEL: func @_QPnumber_and_status_only( +! CHECK-SAME: %[[num:.*]]: !fir.ref{{.*}}, %[[status:.*]]: !fir.ref{{.*}}) { +subroutine number_and_status_only(num, status) + integer :: num, status + call get_command_argument(num, STATUS=status) +! CHECK: %[[numLoaded:.*]] = fir.load %[[num]] : !fir.ref +! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[errmsg:.*]] = fir.absent !fir.box +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numLoaded]] : (i64) -> i32 +! CHECK-32-NEXT: %[[result:.*]] = fir.call @_FortranAArgumentValue(%[[numLoaded]], %[[value]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %[[result32:.*]] = fir.call @_FortranAArgumentValue(%[[numCast]], %[[value]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %[[result:.*]] = fir.convert %[[result32]] : (i32) -> i64 +! CHECK-32-NEXT: fir.store %[[result]] to %[[status]] : !fir.ref +! CHECK-NOT: fir.call @_FortranAArgumentLength +end subroutine number_and_status_only + +! CHECK-LABEL: func @_QPnumber_and_errmsg_only( +! CHECK-SAME: %[[num:.*]]: !fir.ref{{.*}}, %[[errmsg:.*]]: !fir.boxchar<1>{{.*}}) { +subroutine number_and_errmsg_only(num, errmsg) + integer :: num + character(len=32) :: errmsg + call get_command_argument(num, ERRMSG=errmsg) +! CHECK: %[[errmsgUnboxed:.*]]:2 = fir.unboxchar %[[errmsg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[errmsgLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[numUnboxed:.*]] = fir.load %[[num]] : !fir.ref +! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[errmsgBoxed:.*]] = fir.embox %[[errmsgUnboxed]]#0 typeparams %[[errmsgLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-64-NEXT: %[[numCast:.*]] = fir.convert %[[numUnboxed]] : (i64) -> i32 +! CHECK-NEXT: %[[errmsg:.*]] = fir.convert %[[errmsgBoxed]] : (!fir.box>) -> !fir.box +! CHECK-32-NEXT: %{{[0-9]+}} = fir.call @_FortranAArgumentValue(%[[numUnboxed]], %[[value]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-64-NEXT: %{{[0-9]+}} = fir.call @_FortranAArgumentValue(%[[numCast]], %[[value]], %[[errmsg]]) : (i32, !fir.box, !fir.box) -> i32 +! CHECK-NOT: fir.call @_FortranAArgumentLength +end subroutine number_and_errmsg_only diff --git a/flang/test/Lower/Intrinsics/get_environment_variable.f90 b/flang/test/Lower/Intrinsics/get_environment_variable.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/get_environment_variable.f90 @@ -0,0 +1,160 @@ +! 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-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}) { +subroutine number_only(name) + character(len=32) :: name + call get_environment_variable(name) +! CHECK-NOT: fir.call @_FortranAEnvVariableValue +! CHECK-NOT: fir.call @_FortranAEnvVariableLength +! CHECK-NEXT: return +end subroutine number_only + +! CHECK-LABEL: func @_QPname_and_value_only( +! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[valueArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "value"}) { +subroutine name_and_value_only(name, value) + character(len=32) :: name, value + call get_environment_variable(name, value) +! CHECK: %[[nameUnbox:.*]]:2 = fir.unboxchar %[[nameArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[nameLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[valueUnbox:.*]]:2 = fir.unboxchar %[[valueArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[valueLength:.*]] = arith.constant 32 : index +! 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: %[[errmsg:.*]] = fir.absent !fir.box +! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl{{.*}}) : !fir.ref> +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 10]] : 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: return +end subroutine name_and_value_only + +! CHECK-LABEL: func @_QPname_and_length_only( +! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[lengthArg:.*]]: !fir.ref {fir.bindc_name = "length"}) { +subroutine name_and_length_only(name, length) + 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: %true = arith.constant true +! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 7]] : i32 +! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBox]] : (!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: return +end subroutine name_and_length_only + +! CHECK-LABEL: func @_QPname_and_status_only( +! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[statusArg:.*]]: !fir.ref {fir.bindc_name = "status"}) { +subroutine name_and_status_only(name, status) + character(len=32) :: name + integer :: status + call get_environment_variable(name, STATUS=status) +! CHECK: %[[nameUnbox:.*]]:2 = fir.unboxchar %[[nameArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[nameLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[nameBox:.*]] = fir.embox %[[nameUnbox]]#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %true = arith.constant true +! 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: %[[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-64-NEXT: %[[status:.*]] = fir.convert %[[status32]] : (i32) -> i64 +! CHECK-NEXT: fir.store %[[status]] to %[[statusArg]] : !fir.ref +! CHECK-NEXT: return +end subroutine name_and_status_only + +! CHECK-LABEL: func @_QPname_and_trim_name_only( +! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[trimNameArg:.*]]: !fir.ref> {fir.bindc_name = "trim_name"}) { +subroutine name_and_trim_name_only(name, trim_name) + 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-NEXT: return +end subroutine name_and_trim_name_only + +! CHECK-LABEL: func @_QPname_and_errmsg_only( +! CHECK-SAME: %[[nameArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[errmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "errmsg"}) { +subroutine name_and_errmsg_only(name, errmsg) + character(len=32) :: name, errmsg + call get_environment_variable(name, ERRMSG=errmsg) +! CHECK: %[[errmsgUnbox:.*]]:2 = fir.unboxchar %[[errmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[errmsgLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[nameUnbox:.*]]:2 = fir.unboxchar %[[nameArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[nameLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[nameBox:.*]] = fir.embox %[[nameUnbox]]#0 typeparams %[[nameLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[value:.*]] = fir.absent !fir.box +! CHECK-NEXT: %true = arith.constant true +! CHECK-NEXT: %[[errmsgBox:.*]] = fir.embox %[[errmsgUnbox]]#0 typeparams %c32 : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref> +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 10]] : 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: return +end subroutine name_and_errmsg_only + +! CHECK-LABEL: func @_QPall_arguments( +! CHECK-SAME: %[[nameArg:[^:]*]]: !fir.boxchar<1> {fir.bindc_name = "name"}, +! CHECK-SAME: %[[valueArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "value"}, +! CHECK-SAME: %[[lengthArg:[^:]*]]: !fir.ref {fir.bindc_name = "length"}, +! CHECK-SAME: %[[statusArg:.*]]: !fir.ref {fir.bindc_name = "status"}, +! CHECK-SAME: %[[trimNameArg:.*]]: !fir.ref> {fir.bindc_name = "trim_name"}, +! CHECK-SAME: %[[errmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "errmsg"}) { +subroutine all_arguments(name, value, length, status, trim_name, errmsg) + character(len=32) :: name, value, errmsg + integer :: length, status + logical :: trim_name + call get_environment_variable(name, value, length, status, trim_name, errmsg) +! CHECK: %[[errmsgUnbox:.*]]:2 = fir.unboxchar %[[errmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[errmsgLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[nameUnbox:.*]]:2 = fir.unboxchar %[[nameArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[nameLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[valueUnbox:.*]]:2 = fir.unboxchar %[[valueArg]] : (!fir.boxchar<1>) -> (!fir.ref>, index) +! CHECK-NEXT: %[[valueLength:.*]] = arith.constant 32 : index +! CHECK-NEXT: %[[trimNameLoaded:.*]] = fir.load %[[trimNameArg]] : !fir.ref> +! 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: %[[errmsgBoxed:.*]] = fir.embox %[[errmsgUnbox]]#0 typeparams %[[errmsgLength]] : (!fir.ref>, index) -> !fir.box> +! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.[[fileString:.*]]) : !fir.ref> +! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 12]] : i32 +! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBoxed]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[value:.*]] = fir.convert %[[valueBoxed]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[trimName:.*]] = fir.convert %[[trimNameLoaded]] : (!fir.logical<4>) -> i1 +! 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-64-NEXT: %[[status:.*]] = fir.convert %[[status32]] : (i32) -> i64 +! CHECK-NEXT: fir.store %[[status]] to %[[statusArg]] : !fir.ref +! CHECK-NEXT: %[[name:.*]] = fir.convert %[[nameBoxed]] : (!fir.box>) -> !fir.box +! CHECK-NEXT: %[[trimName:.*]] = fir.convert %[[trimNameLoaded]] : (!fir.logical<4>) -> i1 +! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref>) -> !fir.ref +! CHECK-32-NEXT: %[[result64:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %[[trimName]], %[[sourceFile]], %[[sourceLine]]) : (!fir.box, i1, !fir.ref, i32) -> i64 +! CHECK-64-NEXT: %[[result:.*]] = fir.call @_FortranAEnvVariableLength(%[[name]], %[[trimName]], %[[sourceFile]], %[[sourceLine]]) : (!fir.box, i1, !fir.ref, i32) -> i64 +! CHECK-32-NEXT: %[[result:.*]] = fir.convert %[[result64]] : (i64) -> i32 +! CHECK-NEXT: fir.store %[[result]] to %[[lengthArg]] : !fir.ref +! CHECK-NEXT: return +end subroutine all_arguments