[flang-commits] [llvm] [clang-tools-extra] [flang] [clang] [flang] Add EXECUTE_COMMAND_LINE runtime and lowering intrinsics implementation (PR #74077)
Yi Wu via flang-commits
flang-commits at lists.llvm.org
Thu Dec 21 11:48:57 PST 2023
https://github.com/yi-wu-arm updated https://github.com/llvm/llvm-project/pull/74077
>From 49da4a6d4730cfc8cd9bcd28e7dc6f0f6f1b2cb6 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 13:57:46 +0300
Subject: [PATCH 01/34] add execute_command_line
Signed-off-by: Jeff Hammond <jeff.science at gmail.com>
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 0a023bc6b21ea0..8218096c842434 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -209,6 +209,14 @@ static constexpr IntrinsicHandler handlers[]{
{"boundary", asBox, handleDynamicOptional},
{"dim", asValue}}},
/*isElemental=*/false},
+ {"execute_command_line",
+ &I::genExecuteCommandLine,
+ {{{"command", asBox},
+ {"wait", asAddr, handleDynamicOptional},
+ {"exitstat", asAddr, handleDynamicOptional},
+ {"cmdstat", asAddr, handleDynamicOptional},
+ {"cmdmsg", asBox, handleDynamicOptional}}},
+ /*isElemental=*/false},
{"exit",
&I::genExit,
{{{"status", asValue, handleDynamicOptional}}},
>From e31c6f39122117a37e09a43a9fd13f05a7d70912 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 14:41:02 +0300
Subject: [PATCH 02/34] this is definitely not completely correct
---
.../execute_command_line-optional.f90 | 54 +++++++
.../Lower/Intrinsics/execute_command_line.f90 | 138 ++++++++++++++++++
2 files changed, 192 insertions(+)
create mode 100644 flang/test/Lower/Intrinsics/execute_command_line-optional.f90
create mode 100644 flang/test/Lower/Intrinsics/execute_command_line.f90
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
new file mode 100644
index 00000000000000..b2c589a7744663
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -0,0 +1,54 @@
+! Test execute_command_line with dynamically optional arguments.
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+
+! CHECK-LABEL: func @_QPtest(
+! CHECK-SAME: %[[ARG_0:.*]]: !fir.boxchar<1> {fir.bindc_command = "command", fir.optional},
+! CHECK-SAME: %[[ARG_1:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
+! CHECK-SAME: %[[ARG_2:.*]]: !fir.ref<i32> {fir.bindc_command = "length", fir.optional},
+! CHECK-SAME: %[[ARG_3:.*]]: !fir.ref<i32> {fir.bindc_command = "cmdstat", fir.optional},
+! CHECK-SAME: %[[ARG_4:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg", fir.optional}) {
+subroutine test(command, wait, length, cmdstat, cmdmsg)
+ integer, optional :: cmdstat, length
+ character(*), optional :: command, wait, cmdmsg
+ ! Note: command is not optional in execute_command_line and must be present
+ call execute_command_line(command, wait, length, cmdstat, cmdmsg)
+! CHECK: %[[VAL_0:.*]]:2 = fir.unboxchar %[[ARG_5]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
+! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_4]], %[[VAL_5]], %[[VAL_6]] : !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_8:.*]] = fir.is_present %[[ARG_2]] : (!fir.ref<i32>) -> i1
+! CHECK: %[[VAL_9:.*]] = fir.embox %[[ARG_2]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box<i32>
+! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.box<i32>
+! CHECK: %[[VAL_12:.*]] = fir.is_present %[[VAL_0]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
+! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_0]]#0 typeparams %[[VAL_0]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_14:.*]] = fir.absent !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_15:.*]] = arith.select %[[VAL_12]], %[[VAL_13]], %[[VAL_14]] : !fir.box<!fir.char<1,?>>
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[ARG_4]] : (!fir.ref<!fir.logical<4>>) -> 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<!fir.logical<4>>
+! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (!fir.logical<4>) -> i1
+! CHECK: fir.result %[[VAL_29]] : i1
+! CHECK: } else {
+! CHECK: %[[CONST_1:.*]] = arith.constant true
+! CHECK: fir.result %[[CONST_1]] : i1
+! CHECK: }
+! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_11]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_15]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAGetEnvVariable(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_18]], %[[VAL_23]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_26:.*]] = fir.convert %[[ARG_3]] : (!fir.ref<i32>) -> 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<i32>
+! CHECK: }
+end subroutine
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
new file mode 100644
index 00000000000000..f9b11ad7d772a9
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -0,0 +1,138 @@
+! 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 @_QPcommand_only(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"}) {
+subroutine command_only(command)
+ character(len=32) :: command
+ call execute_command_line(command)
+! CHECK-NOT: fir.call @_FortranAGetEnvVariable
+! CHECK-NEXT: return
+end subroutine command_only
+
+! CHECK-LABEL: func @_QPcommand_and_wait_only(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
+subroutine command_and_wait_only(command, wait)
+ character(len=32) :: command, wait
+ call execute_command_line(command, wait)
+! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[waitUnbox:.*]]:2 = fir.unboxchar %[[waitArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[waitCast:.*]] = fir.convert %[[waitUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %[[waitBox:.*]] = fir.embox %[[waitCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
+! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
+! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NEXT: return
+end subroutine command_and_wait_only
+
+! CHECK-LABEL: func @_QPcommand_and_exitstat_only(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
+! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "exitstat"}) {
+subroutine command_and_exitstat_only(command, exitstat)
+ character(len=32) :: command
+ integer :: exitstat
+ call execute_command_line(command, EXITSTAT=exitstat)
+! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %arg1 : (!fir.ref<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<i[[DEFAULT_INTEGER_SIZE]]>
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
+! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
+! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
+! CHECK-NEXT: %{{.*}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+end subroutine command_and_exitstat_only
+
+! CHECK-LABEL: func @_QPcommand_and_cmdstat_only(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "cmdstat"}) {
+subroutine command_and_cmdstat_only(command, cmdstat)
+ character(len=32) :: command
+ integer :: cmdstat
+ call execute_command_line(command, CMDSTAT=cmdstat)
+! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
+! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
+! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
+! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
+end subroutine command_and_cmdstat_only
+
+! CHECK-LABEL: func @_QPcommand_and_cmdmsg_only(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg"}) {
+subroutine command_and_cmdmsg_only(command, cmdmsg)
+ character(len=32) :: command, cmdmsg
+ call execute_command_line(command, CMDMSG=cmdmsg)
+! CHECK: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %[[cmdmsgCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
+! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
+! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
+! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NEXT: return
+end subroutine command_and_cmdmsg_only
+
+! CHECK-LABEL: func @_QPall_arguments(
+! CHECK-SAME: %[[commandArg:[^:]*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
+! CHECK-SAME: %[[exitstatArg:[^:]*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "exitstat"},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "cmdstat"},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg"}) {
+subroutine all_arguments(command, wait, exitstat, cmdstat, cmdmsg)
+ character(len=32) :: command, wait, cmdmsg
+ integer :: exitstat, cmdstat
+ call execute_command_line(command, wait, exitstat, cmdstat, cmdmsg)
+! CHECK: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[waitUnbox:.*]]:2 = fir.unboxchar %[[waitArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[waitCast:.*]] = fir.convert %[[waitUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
+! CHECK-NEXT: %[[commandBoxed:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %[[waitBoxed:.*]] = fir.embox %[[waitCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK-NEXT: %[[exitstatBoxed:.*]] = fir.embox %[[exitstatArg]] : (!fir.ref<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<i[[DEFAULT_INTEGER_SIZE]]>
+! CHECK-NEXT: %[[cmdmsgBoxed:.*]] = fir.embox %[[cmdmsgCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
+! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.[[fileString:.*]]) : !fir.ref<!fir.char<1,[[fileStringexitstat:.*]]>>
+! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 22]] : i32
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBoxed]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
+! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[fileStringexitstat]]>>) -> !fir.ref<i8>
+! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
+! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
+end subroutine all_arguments
>From 60a826e12df697d1389ae8d6011df4bd86c384c0 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 14:46:57 +0300
Subject: [PATCH 03/34] definitely not right either
---
.../flang/Optimizer/Builder/Runtime/Execute.h | 32 +++++++++++++++
.../lib/Optimizer/Builder/Runtime/Execute.cpp | 41 +++++++++++++++++++
2 files changed, 73 insertions(+)
create mode 100644 flang/include/flang/Optimizer/Builder/Runtime/Execute.h
create mode 100644 flang/lib/Optimizer/Builder/Runtime/Execute.cpp
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
new file mode 100644
index 00000000000000..000565f20c5dc5
--- /dev/null
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -0,0 +1,32 @@
+//===-- Command.cpp -- generate command line runtime API calls ------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
+
+namespace mlir {
+class Value;
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+} // namespace fir
+
+namespace fir::runtime {
+
+/// Generate a call to the ExecuteCommandLine runtime function which implements
+/// the GET_EXECUTE_ARGUMENT 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.
+mlir::Value genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
+ mlir::Value number, mlir::Value value,
+ mlir::Value length, mlir::Value errmsg);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
diff --git a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
new file mode 100644
index 00000000000000..8c612966aabdb7
--- /dev/null
+++ b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
@@ -0,0 +1,41 @@
+//===-- Execute.cpp -- generate command line runtime API calls ------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/Runtime/Execute.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/command.h"
+
+using namespace Fortran::runtime;
+
+// Certain runtime intrinsics should only be run when select parameters of the
+// intrisic are supplied. In certain cases one of these parameters may not be
+// given, however the intrinsic needs to be run due to another required
+// parameter being supplied. In this case the missing parameter is assigned to
+// have an "absent" value. This typically happens in IntrinsicCall.cpp. For this
+// reason the extra indirection with `isAbsent` is needed for testing whether a
+// given parameter is actually present (so that parameters with "value" absent
+// are not considered as present).
+inline bool isAbsent(mlir::Value val) {
+ return mlir::isa_and_nonnull<fir::AbsentOp>(val.getDefiningOp());
+}
+
+mlir::Value fir::runtime::genExecuteCommandLine(
+ fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number,
+ mlir::Value value, mlir::Value length, mlir::Value errmsg) {
+ auto runtimeFunc =
+ fir::runtime::getRuntimeFunc<mkRTKey(ExecuteCommandLine)>(loc, builder);
+ mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
+ mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+ mlir::Value sourceLine =
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(5));
+ llvm::SmallVector<mlir::Value> args =
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, number, value,
+ length, errmsg, sourceFile, sourceLine);
+ return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
+}
>From aa31e9b49a3c7a5a0d1b3be4afeb936915d374bd Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 14:49:22 +0300
Subject: [PATCH 04/34] definitely not right either
---
.../flang/Optimizer/Builder/IntrinsicCall.h | 1 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 43 +++++++++++++++++++
2 files changed, 44 insertions(+)
diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 06db8cf9e9dc92..83d7315c1f1a1a 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -214,6 +214,7 @@ struct IntrinsicLibrary {
mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genExit(llvm::ArrayRef<fir::ExtendedValue>);
+ void genExecuteCommandLine(mlir::ArrayRef<fir::ExtendedValue> args);
mlir::Value genExponent(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genExtendsTypeOf(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 8218096c842434..4c504e0b04f23c 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -2775,6 +2775,49 @@ IntrinsicLibrary::genEoshift(mlir::Type resultType,
return readAndAddCleanUp(resultMutableBox, resultType, "EOSHIFT");
}
+// EXECUTE_COMMAND_LINE
+void IntrinsicLibrary::genExecuteCommandLine(
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 5);
+ mlir::Value number = fir::getBase(args[0]);
+ const fir::ExtendedValue &value = args[1];
+ const fir::ExtendedValue &length = args[2];
+ const fir::ExtendedValue &status = args[3];
+ const fir::ExtendedValue &errmsg = args[4];
+
+ if (!number)
+ fir::emitFatalError(loc, "expected NUMBER parameter");
+
+ // If none of the optional parameters are present, do nothing.
+ if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
+ !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
+ return;
+
+ mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+ mlir::Value valBox =
+ isStaticallyPresent(value)
+ ? fir::getBase(value)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value lenBox =
+ isStaticallyPresent(length)
+ ? fir::getBase(length)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value errBox =
+ isStaticallyPresent(errmsg)
+ ? fir::getBase(errmsg)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value stat = fir::runtime::genExecuteCommandLine(
+ builder, loc, number, valBox, lenBox, 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();
+ }
+}
+
// EXIT
void IntrinsicLibrary::genExit(llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
>From a417c5a3abf83c6d661f8fe43e63c86b62f28f61 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 14:54:14 +0300
Subject: [PATCH 05/34] more correct
---
.../include/flang/Optimizer/Builder/Runtime/Execute.h | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
index 000565f20c5dc5..c35f46fa88d42d 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -22,11 +22,13 @@ namespace fir::runtime {
/// Generate a call to the ExecuteCommandLine runtime function which implements
/// the GET_EXECUTE_ARGUMENT 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 wait, \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
+/// absent (but not null mlir values). The status exitstat and cmdstat are
+/// returned, along with the message cmdmsg.
mlir::Value genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
- mlir::Value number, mlir::Value value,
- mlir::Value length, mlir::Value errmsg);
+ mlir::Value command, mlir::Value wait,
+ mlir::Value exitstat, mlir::Value cmdstat,
+ mlir::Value cmdmsg);
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
>From 36811c71091940267fb4f2d9b15aabd0234704e6 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 14:59:19 +0300
Subject: [PATCH 06/34] more correct
---
flang/lib/Optimizer/Builder/Runtime/Execute.cpp | 12 +++++++-----
1 file changed, 7 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
index 8c612966aabdb7..1942c6e943fb83 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
@@ -26,16 +26,18 @@ inline bool isAbsent(mlir::Value val) {
}
mlir::Value fir::runtime::genExecuteCommandLine(
- fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value number,
- mlir::Value value, mlir::Value length, mlir::Value errmsg) {
+ fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value command,
+ mlir::Value wait, mlir::Value exitstat, mlir::Value cmdstat,
+ mlir::Value cmdmsg) {
auto runtimeFunc =
fir::runtime::getRuntimeFunc<mkRTKey(ExecuteCommandLine)>(loc, builder);
mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
- fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(5));
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(6));
llvm::SmallVector<mlir::Value> args =
- fir::runtime::createArguments(builder, loc, runtimeFuncTy, number, value,
- length, errmsg, sourceFile, sourceLine);
+ fir::runtime::createArguments(builder, loc, runtimeFuncTy, command, wait,
+ exitstat, cmdstat, cmdmsg, sourceFile,
+ sourceLine);
return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
}
>From 6cc9e3f9e581209c54d8c4f476023f406135dddb Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:02:07 +0300
Subject: [PATCH 07/34] remove trailing space
---
flang/include/flang/Optimizer/Builder/Runtime/Execute.h | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
index c35f46fa88d42d..ee431caaeefd4c 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -22,7 +22,7 @@ namespace fir::runtime {
/// Generate a call to the ExecuteCommandLine runtime function which implements
/// the GET_EXECUTE_ARGUMENT intrinsic.
-/// \p wait, \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
+/// \p wait, \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
/// absent (but not null mlir values). The status exitstat and cmdstat are
/// returned, along with the message cmdmsg.
mlir::Value genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
>From 46664b767681f64f3fd6e213e90a9f7a5a7b9131 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:03:31 +0300
Subject: [PATCH 08/34] 5 args not 6
---
flang/lib/Optimizer/Builder/Runtime/Execute.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
index 1942c6e943fb83..261dcb529b7c81 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
@@ -34,7 +34,7 @@ mlir::Value fir::runtime::genExecuteCommandLine(
mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
- fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(6));
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(5));
llvm::SmallVector<mlir::Value> args =
fir::runtime::createArguments(builder, loc, runtimeFuncTy, command, wait,
exitstat, cmdstat, cmdmsg, sourceFile,
>From 01d6167916959e47e16273579b058168b515e4f4 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:10:41 +0300
Subject: [PATCH 09/34] i have no idea what i am doing
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 62 +++++++++++--------
1 file changed, 37 insertions(+), 25 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 4c504e0b04f23c..1f151964a1d29e 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -2779,41 +2779,53 @@ IntrinsicLibrary::genEoshift(mlir::Type resultType,
void IntrinsicLibrary::genExecuteCommandLine(
llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 5);
- mlir::Value number = fir::getBase(args[0]);
- const fir::ExtendedValue &value = args[1];
- const fir::ExtendedValue &length = args[2];
- const fir::ExtendedValue &status = args[3];
- const fir::ExtendedValue &errmsg = args[4];
+ mlir::Value command = fir::getBase(args[0]);
+ const fir::ExtendedValue &wait = args[1];
+ const fir::ExtendedValue &exitstat = args[2];
+ const fir::ExtendedValue &cmdstat = args[3];
+ const fir::ExtendedValue &cmdmsg = args[4];
- if (!number)
- fir::emitFatalError(loc, "expected NUMBER parameter");
+ if (!command)
+ fir::emitFatalError(loc, "expected COMMAND parameter");
// If none of the optional parameters are present, do nothing.
- if (!isStaticallyPresent(value) && !isStaticallyPresent(length) &&
- !isStaticallyPresent(status) && !isStaticallyPresent(errmsg))
+ if (!isStaticallyPresent(wait) && !isStaticallyPresent(exitstat) &&
+ !isStaticallyPresent(cmdstat) && !isStaticallyPresent(cmdmsg))
return;
mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
- mlir::Value valBox =
- isStaticallyPresent(value)
- ? fir::getBase(value)
+ mlir::Value waitBox =
+ isStaticallyPresent(wait)
+ ? fir::getBase(wait)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
- mlir::Value lenBox =
- isStaticallyPresent(length)
- ? fir::getBase(length)
+ mlir::Value exitstatBox =
+ isStaticallyPresent(exitstat)
+ ? fir::getBase(exitstt)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
- mlir::Value errBox =
- isStaticallyPresent(errmsg)
- ? fir::getBase(errmsg)
+ mlir::Value cmdstatBox =
+ isStaticallyPresent(cmdstat)
+ ? fir::getBase(cmdstat)
+ : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+ mlir::Value cmdmsgBox =
+ isStaticallyPresent(cmdmsg)
+ ? fir::getBase(cmdmsg)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
mlir::Value stat = fir::runtime::genExecuteCommandLine(
- builder, loc, number, valBox, lenBox, 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); })
+ builder, loc, command, waitBox, cmdstatBox, exitstatBox, cmdmsgBox);
+ if (isStaticallyPresent(exitstat)) {
+ mlir::Value exitstatAddr = fir::getBase(exitstat);
+ mlir::Value exitstatIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, exitstatAddr);
+ builder.genIfThen(loc, exitstatIsPresentAtRuntime)
+ .genThen([&]() { builder.createStoreWithConvert(loc, exitstat, exitstatAddr); })
+ .end();
+ }
+ if (isStaticallyPresent(cmdstat)) {
+ mlir::Value cmdstatAddr = fir::getBase(cmdstat);
+ mlir::Value cmdstatIsPresentAtRuntime =
+ builder.genIsNotNullAddr(loc, cmdstatAddr);
+ builder.genIfThen(loc, cmdstatIsPresentAtRuntime)
+ .genThen([&]() { builder.createStoreWithConvert(loc, cmdstat, cmdstatAddr); })
.end();
}
}
>From b6ea7a7f4492ca18aec1192e91b17bc308bc1ec8 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:21:10 +0300
Subject: [PATCH 10/34] runtime part of this
---
flang/include/flang/Runtime/execute.h | 33 +++++++++++++++++++++++++++
1 file changed, 33 insertions(+)
create mode 100644 flang/include/flang/Runtime/execute.h
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
new file mode 100644
index 00000000000000..a988963cb17995
--- /dev/null
+++ b/flang/include/flang/Runtime/execute.h
@@ -0,0 +1,33 @@
+//===-- include/flang/Runtime/command.h -------------------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_RUNTIME_EXECUTE_H_
+#define FORTRAN_RUNTIME_EXECUTE_H_
+
+#include "flang/Runtime/entry-names.h"
+
+#include <cstdint>
+
+namespace Fortran::runtime {
+class Descriptor;
+
+extern "C" {
+
+// 16.9.83 EXECUTE_COMMAND_LINE
+// Execute a command line.
+// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
+std::int32_t RTNAME(ExecuteCommandLine)(
+ const Descriptor *command = nullptr, const Descriptor *wait = nullptr,
+ const Descriptor *exitstat = nullptr, const Descriptor *cmdstat = nullptr,
+ const Descriptor *cmdmsg = nullptr, const char *sourceFile = nullptr,
+ int line = 0);
+
+}
+} // namespace Fortran::runtime
+
+#endif // FORTRAN_RUNTIME_EXECUTE_H_
>From 7ffafe46fec5e0751becbfd269bf6d460d01b428 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:26:10 +0300
Subject: [PATCH 11/34] WIP
---
flang/runtime/execute.cpp | 139 ++++++++++++++++++++++++++++++++++++++
1 file changed, 139 insertions(+)
create mode 100644 flang/runtime/execute.cpp
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
new file mode 100644
index 00000000000000..31f2a63a00d4d8
--- /dev/null
+++ b/flang/runtime/execute.cpp
@@ -0,0 +1,139 @@
+//===-- runtime/execute.cpp -----------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Runtime/execute.h"
+#include "environment.h"
+#include "stat.h"
+#include "terminator.h"
+#include "tools.h"
+#include "flang/Runtime/descriptor.h"
+#include <cstdlib>
+#include <limits>
+
+namespace Fortran::runtime {
+
+// Returns the length of the \p string. Assumes \p string is valid.
+static std::int64_t StringLength(const char *string) {
+ std::size_t length{std::strlen(string)};
+ if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
+ return static_cast<std::int64_t>(length);
+ } else {
+ std::size_t max{std::numeric_limits<std::int64_t>::max()};
+ return length > max ? 0 // Just fail.
+ : static_cast<std::int64_t>(length);
+ }
+}
+
+static bool IsValidCharDescriptor(const Descriptor *value) {
+ return value && value->IsAllocated() &&
+ value->type() == TypeCode(TypeCategory::Character, 1) &&
+ value->rank() == 0;
+}
+
+static bool IsValidIntDescriptor(const Descriptor *length) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ // Check that our descriptor is allocated and is a scalar integer with
+ // kind != 1 (i.e. with a large enough decimal exponent range).
+ return length->IsAllocated() && length->rank() == 0 &&
+ length->type().IsInteger() && typeCode && typeCode->second != 1;
+}
+
+static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
+ if (offset < value.ElementBytes()) {
+ std::memset(
+ value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
+ }
+}
+
+static std::int32_t CopyToDescriptor(const Descriptor &value,
+ const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
+ std::size_t offset = 0) {
+
+ std::int64_t toCopy{std::min(rawValueLength,
+ static_cast<std::int64_t>(value.ElementBytes() - offset))};
+ if (toCopy < 0) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+
+ if (rawValueLength > toCopy) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ return StatOk;
+}
+
+static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
+ const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
+ bool haveValue{IsValidCharDescriptor(value)};
+
+ std::int64_t len{StringLength(rawValue)};
+ if (len <= 0) {
+ if (haveValue) {
+ FillWithSpaces(*value);
+ }
+ return ToErrmsg(errmsg, StatMissingArgument);
+ }
+
+ std::int32_t stat{StatOk};
+ if (haveValue) {
+ stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
+ }
+
+ offset += len;
+ return stat;
+}
+
+static void StoreLengthToDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
+ kind, terminator, *length, /* atIndex = */ 0, value);
+}
+
+template <int KIND> struct FitsInIntegerKind {
+ bool operator()([[maybe_unused]] std::int64_t value) {
+ if constexpr (KIND >= 8) {
+ return true;
+ } else {
+ return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
+ Fortran::common::TypeCategory::Integer, KIND>>::max();
+ }
+ }
+};
+
+static bool FitsInDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
+ kind, terminator, value);
+}
+
+std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command,
+ const Descriptor *wait, const Descriptor *exitstat,
+ const Descriptor *cmdstat, const Descriptor *cmdmsg, const char *sourceFile,
+ int line) {
+ Terminator terminator{sourceFile, line};
+
+ if (command) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
+ }
+
+ if (wait) {
+ RUNTIME_CHECK(terminator, IsValidLogicalDescriptor(wait));
+ }
+
+ // TODO
+
+ return StatOk;
+}
+
+} // namespace Fortran::runtime
>From 2e9685bdec4d36ee69a82ee073254f6f9fe5e001 Mon Sep 17 00:00:00 2001
From: Jeff Hammond <jeff.science at gmail.com>
Date: Wed, 18 Oct 2023 15:27:55 +0300
Subject: [PATCH 12/34] where is the pattern for IsValidLogicalDescriptor
---
flang/runtime/execute.cpp | 6 ++++++
1 file changed, 6 insertions(+)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 31f2a63a00d4d8..d5515b3e2d7bbc 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -43,6 +43,12 @@ static bool IsValidIntDescriptor(const Descriptor *length) {
length->type().IsInteger() && typeCode && typeCode->second != 1;
}
+static bool IsValidLogicalDescriptor(const Descriptor *wait) {
+ return wait && wait->IsAllocated() &&
+ wait->type() == TypeCode(TypeCategory::Logical, 1) &&
+ wait->rank() == 0;
+}
+
static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
if (offset < value.ElementBytes()) {
std::memset(
>From df35e093dba7e9f7899b48e2cf7d9b7bf05cb895 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Mon, 20 Nov 2023 10:08:01 +0000
Subject: [PATCH 13/34] some small fixes to make it build
---
.../flang/Optimizer/Builder/Runtime/Execute.h | 8 +--
flang/include/flang/Runtime/execute.h | 10 ++--
flang/lib/Optimizer/Builder/CMakeLists.txt | 1 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 42 ++++-----------
.../lib/Optimizer/Builder/Runtime/Execute.cpp | 23 ++++----
flang/runtime/CMakeLists.txt | 1 +
flang/runtime/execute.cpp | 53 ++++++++++++-------
.../execute_command_line-optional.f90 | 5 +-
.../Lower/Intrinsics/execute_command_line.f90 | 24 +++++----
9 files changed, 85 insertions(+), 82 deletions(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
index ee431caaeefd4c..f660419d703041 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -25,10 +25,10 @@ namespace fir::runtime {
/// \p wait, \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
/// absent (but not null mlir values). The status exitstat and cmdstat are
/// returned, along with the message cmdmsg.
-mlir::Value genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
- mlir::Value command, mlir::Value wait,
- mlir::Value exitstat, mlir::Value cmdstat,
- mlir::Value cmdmsg);
+void genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
+ mlir::Value command, mlir::Value wait,
+ mlir::Value exitstat, mlir::Value cmdstat,
+ mlir::Value cmdmsg);
} // namespace fir::runtime
#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_EXECUTE_H
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
index a988963cb17995..397c82db82eb5e 100644
--- a/flang/include/flang/Runtime/execute.h
+++ b/flang/include/flang/Runtime/execute.h
@@ -21,12 +21,10 @@ extern "C" {
// 16.9.83 EXECUTE_COMMAND_LINE
// Execute a command line.
// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
-std::int32_t RTNAME(ExecuteCommandLine)(
- const Descriptor *command = nullptr, const Descriptor *wait = nullptr,
- const Descriptor *exitstat = nullptr, const Descriptor *cmdstat = nullptr,
- const Descriptor *cmdmsg = nullptr, const char *sourceFile = nullptr,
- int line = 0);
-
+std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command = nullptr,
+ bool wait = false, const Descriptor *exitstat = nullptr,
+ const Descriptor *cmdstat = nullptr, const Descriptor *cmdmsg = nullptr,
+ const char *sourceFile = nullptr, int line = 0);
}
} // namespace Fortran::runtime
diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt
index 5e5daffd3ed7de..2d28b10f01fdeb 100644
--- a/flang/lib/Optimizer/Builder/CMakeLists.txt
+++ b/flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -19,6 +19,7 @@ add_flang_library(FIRBuilder
Runtime/Command.cpp
Runtime/Derived.cpp
Runtime/EnvironmentDefaults.cpp
+ Runtime/Execute.cpp
Runtime/Inquiry.cpp
Runtime/Intrinsics.cpp
Runtime/Numeric.cpp
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 9447d3325a1aad..9100cf0a4394bb 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -25,6 +25,7 @@
#include "flang/Optimizer/Builder/Runtime/Character.h"
#include "flang/Optimizer/Builder/Runtime/Command.h"
#include "flang/Optimizer/Builder/Runtime/Derived.h"
+#include "flang/Optimizer/Builder/Runtime/Execute.h"
#include "flang/Optimizer/Builder/Runtime/Inquiry.h"
#include "flang/Optimizer/Builder/Runtime/Intrinsics.h"
#include "flang/Optimizer/Builder/Runtime/Numeric.h"
@@ -212,9 +213,9 @@ static constexpr IntrinsicHandler handlers[]{
{"execute_command_line",
&I::genExecuteCommandLine,
{{{"command", asBox},
- {"wait", asAddr, handleDynamicOptional},
- {"exitstat", asAddr, handleDynamicOptional},
- {"cmdstat", asAddr, handleDynamicOptional},
+ {"wait", asValue, handleDynamicOptional},
+ {"exitstat", asBox, handleDynamicOptional},
+ {"cmdstat", asBox, handleDynamicOptional},
{"cmdmsg", asBox, handleDynamicOptional}}},
/*isElemental=*/false},
{"exit",
@@ -2797,19 +2798,14 @@ void IntrinsicLibrary::genExecuteCommandLine(
if (!command)
fir::emitFatalError(loc, "expected COMMAND parameter");
- // If none of the optional parameters are present, do nothing.
- if (!isStaticallyPresent(wait) && !isStaticallyPresent(exitstat) &&
- !isStaticallyPresent(cmdstat) && !isStaticallyPresent(cmdmsg))
- return;
-
mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
- mlir::Value waitBox =
- isStaticallyPresent(wait)
- ? fir::getBase(wait)
- : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+
+ mlir::Value waitBool = isStaticallyPresent(wait)
+ ? fir::getBase(wait)
+ : builder.createBool(loc, false);
mlir::Value exitstatBox =
isStaticallyPresent(exitstat)
- ? fir::getBase(exitstt)
+ ? fir::getBase(exitstat)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
mlir::Value cmdstatBox =
isStaticallyPresent(cmdstat)
@@ -2819,24 +2815,8 @@ void IntrinsicLibrary::genExecuteCommandLine(
isStaticallyPresent(cmdmsg)
? fir::getBase(cmdmsg)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
- mlir::Value stat = fir::runtime::genExecuteCommandLine(
- builder, loc, command, waitBox, cmdstatBox, exitstatBox, cmdmsgBox);
- if (isStaticallyPresent(exitstat)) {
- mlir::Value exitstatAddr = fir::getBase(exitstat);
- mlir::Value exitstatIsPresentAtRuntime =
- builder.genIsNotNullAddr(loc, exitstatAddr);
- builder.genIfThen(loc, exitstatIsPresentAtRuntime)
- .genThen([&]() { builder.createStoreWithConvert(loc, exitstat, exitstatAddr); })
- .end();
- }
- if (isStaticallyPresent(cmdstat)) {
- mlir::Value cmdstatAddr = fir::getBase(cmdstat);
- mlir::Value cmdstatIsPresentAtRuntime =
- builder.genIsNotNullAddr(loc, cmdstatAddr);
- builder.genIfThen(loc, cmdstatIsPresentAtRuntime)
- .genThen([&]() { builder.createStoreWithConvert(loc, cmdstat, cmdstatAddr); })
- .end();
- }
+ fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
+ cmdstatBox, exitstatBox, cmdmsgBox);
}
// EXIT
diff --git a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
index 261dcb529b7c81..71ee3996ac0da7 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Execute.cpp
@@ -9,7 +9,7 @@
#include "flang/Optimizer/Builder/Runtime/Execute.h"
#include "flang/Optimizer/Builder/FIRBuilder.h"
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
-#include "flang/Runtime/command.h"
+#include "flang/Runtime/execute.h"
using namespace Fortran::runtime;
@@ -25,19 +25,20 @@ inline bool isAbsent(mlir::Value val) {
return mlir::isa_and_nonnull<fir::AbsentOp>(val.getDefiningOp());
}
-mlir::Value fir::runtime::genExecuteCommandLine(
- fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value command,
- mlir::Value wait, mlir::Value exitstat, mlir::Value cmdstat,
- mlir::Value cmdmsg) {
+void fir::runtime::genExecuteCommandLine(fir::FirOpBuilder &builder,
+ mlir::Location loc,
+ mlir::Value command, mlir::Value wait,
+ mlir::Value exitstat,
+ mlir::Value cmdstat,
+ mlir::Value cmdmsg) {
auto runtimeFunc =
fir::runtime::getRuntimeFunc<mkRTKey(ExecuteCommandLine)>(loc, builder);
mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
mlir::Value sourceLine =
- fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(5));
- llvm::SmallVector<mlir::Value> args =
- fir::runtime::createArguments(builder, loc, runtimeFuncTy, command, wait,
- exitstat, cmdstat, cmdmsg, sourceFile,
- sourceLine);
- return builder.create<fir::CallOp>(loc, runtimeFunc, args).getResult(0);
+ fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(6));
+ llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+ builder, loc, runtimeFuncTy, command, wait, exitstat, cmdstat, cmdmsg,
+ sourceFile, sourceLine);
+ builder.create<fir::CallOp>(loc, runtimeFunc, args);
}
diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 68ae97bed4e329..cd2bc51098d242 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -104,6 +104,7 @@ set(sources
edit-input.cpp
edit-output.cpp
environment.cpp
+ execute.cpp
extensions.cpp
extrema.cpp
file.cpp
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index d5515b3e2d7bbc..5966daf84f5a47 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -13,6 +13,8 @@
#include "tools.h"
#include "flang/Runtime/descriptor.h"
#include <cstdlib>
+// #include <iostream>
+// #include <string>
#include <limits>
namespace Fortran::runtime {
@@ -43,12 +45,6 @@ static bool IsValidIntDescriptor(const Descriptor *length) {
length->type().IsInteger() && typeCode && typeCode->second != 1;
}
-static bool IsValidLogicalDescriptor(const Descriptor *wait) {
- return wait && wait->IsAllocated() &&
- wait->type() == TypeCode(TypeCategory::Logical, 1) &&
- wait->rank() == 0;
-}
-
static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
if (offset < value.ElementBytes()) {
std::memset(
@@ -96,12 +92,12 @@ static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
return stat;
}
-static void StoreLengthToDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
+static void StoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
+ auto typeCode{intVal->type().GetCategoryAndKind()};
int kind{typeCode->second};
Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
- kind, terminator, *length, /* atIndex = */ 0, value);
+ kind, terminator, *intVal, /* atIndex = */ 0, value);
}
template <int KIND> struct FitsInIntegerKind {
@@ -123,18 +119,39 @@ static bool FitsInDescriptor(
kind, terminator, value);
}
-std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command,
- const Descriptor *wait, const Descriptor *exitstat,
- const Descriptor *cmdstat, const Descriptor *cmdmsg, const char *sourceFile,
- int line) {
+std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
+ const Descriptor *exitstat, const Descriptor *cmdstat,
+ const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
- if (command) {
- RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
- }
+ int exitstatVal;
+ int cmdstatVal;
if (wait) {
- RUNTIME_CHECK(terminator, IsValidLogicalDescriptor(wait));
+ // RUNTIME_CHECK(terminator, IsValidLogicalDescriptor(wait));
+ // if (wait)
+ } else {
+ if (command) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
+ exitstatVal = std::system(command->OffsetElement());
+ }
+ }
+
+ if (exitstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
+ StoreIntToDescriptor(exitstat, exitstatVal, terminator);
+ }
+
+ if (cmdstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
+ StoreIntToDescriptor(cmdstat, 0, terminator);
+ }
+
+ if (cmdmsg) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(cmdmsg));
+ std::array<char, 5> str;
+ str.fill('f');
+ CopyToDescriptor(*cmdmsg, str.data(), str.size(), nullptr);
}
// TODO
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
index b2c589a7744663..be63bc75f2ebf5 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -10,7 +10,8 @@
! CHECK-SAME: %[[ARG_4:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg", fir.optional}) {
subroutine test(command, wait, length, cmdstat, cmdmsg)
integer, optional :: cmdstat, length
- character(*), optional :: command, wait, cmdmsg
+ logical :: wait
+ character(*), optional :: command, cmdmsg
! Note: command is not optional in execute_command_line and must be present
call execute_command_line(command, wait, length, cmdstat, cmdmsg)
! CHECK: %[[VAL_0:.*]]:2 = fir.unboxchar %[[ARG_5]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
@@ -44,7 +45,7 @@ subroutine test(command, wait, length, cmdstat, cmdmsg)
! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_11]] : (!fir.box<i32>) -> !fir.box<none>
! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_15]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAGetEnvVariable(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_18]], %[[VAL_23]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAExecuteCommandLine(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_18]], %[[VAL_23]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: %[[VAL_26:.*]] = fir.convert %[[ARG_3]] : (!fir.ref<i32>) -> i64
! CHECK: %[[CONST_2:.*]] = arith.constant 0 : i64
! CHECK: %[[VAL_27:.*]] = arith.cmpi ne, %[[VAL_26]], %[[CONST_2]] : i64
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
index f9b11ad7d772a9..8ceae841440bc3 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -6,7 +6,7 @@
subroutine command_only(command)
character(len=32) :: command
call execute_command_line(command)
-! CHECK-NOT: fir.call @_FortranAGetEnvVariable
+! CHECK-Next: fir.call @_FortranAExecuteCommandLine
! CHECK-NEXT: return
end subroutine command_only
@@ -14,7 +14,9 @@ end subroutine command_only
! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
subroutine command_and_wait_only(command, wait)
- character(len=32) :: command, wait
+ character(len=32) :: command
+ logical::wait
+ wait = .false.
call execute_command_line(command, wait)
! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
@@ -30,7 +32,7 @@ subroutine command_and_wait_only(command, wait)
! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-NEXT: return
end subroutine command_and_wait_only
@@ -53,7 +55,7 @@ subroutine command_and_exitstat_only(command, exitstat)
! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{.*}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NEXT: %{{.*}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
end subroutine command_and_exitstat_only
! CHECK-LABEL: func @_QPcommand_and_cmdstat_only(
@@ -74,8 +76,8 @@ subroutine command_and_cmdstat_only(command, cmdstat)
! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32
! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
end subroutine command_and_cmdstat_only
@@ -100,7 +102,7 @@ subroutine command_and_cmdmsg_only(command, cmdmsg)
! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-NEXT: return
end subroutine command_and_cmdmsg_only
@@ -111,8 +113,10 @@ end subroutine command_and_cmdmsg_only
! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "cmdstat"},
! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg"}) {
subroutine all_arguments(command, wait, exitstat, cmdstat, cmdmsg)
- character(len=32) :: command, wait, cmdmsg
+ character(len=32) :: command, cmdmsg
+ logical :: wait
integer :: exitstat, cmdstat
+ wait=.false.
call execute_command_line(command, wait, exitstat, cmdstat, cmdmsg)
! CHECK: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
@@ -131,8 +135,8 @@ subroutine all_arguments(command, wait, exitstat, cmdstat, cmdmsg)
! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBoxed]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[fileStringexitstat]]>>) -> !fir.ref<i8>
-! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAGetEnvVariable(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
end subroutine all_arguments
>From 94ac4756eb2b9b008ed7f1c9edff06c82821c1eb Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Tue, 21 Nov 2023 12:14:01 +0000
Subject: [PATCH 14/34] Add simple support of async and sync execution, might
not work on Windows
---
flang/include/flang/Runtime/execute.h | 4 +-
flang/runtime/execute.cpp | 127 ++++++++++++++------------
2 files changed, 72 insertions(+), 59 deletions(-)
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
index 397c82db82eb5e..0c8086fa8ecf09 100644
--- a/flang/include/flang/Runtime/execute.h
+++ b/flang/include/flang/Runtime/execute.h
@@ -21,8 +21,8 @@ extern "C" {
// 16.9.83 EXECUTE_COMMAND_LINE
// Execute a command line.
// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
-std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command = nullptr,
- bool wait = false, const Descriptor *exitstat = nullptr,
+void RTNAME(ExecuteCommandLine)(const Descriptor *command = nullptr,
+ bool wait = true, const Descriptor *exitstat = nullptr,
const Descriptor *cmdstat = nullptr, const Descriptor *cmdmsg = nullptr,
const char *sourceFile = nullptr, int line = 0);
}
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 5966daf84f5a47..458f2f6c964f3c 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -13,24 +13,18 @@
#include "tools.h"
#include "flang/Runtime/descriptor.h"
#include <cstdlib>
-// #include <iostream>
-// #include <string>
+#include <future>
#include <limits>
+#ifdef _WIN32
+#define LEAN_AND_MEAN
+#define NOMINMAX
+#include <windows.h>
+#else
+#include <unistd.h>
+#endif
namespace Fortran::runtime {
-// Returns the length of the \p string. Assumes \p string is valid.
-static std::int64_t StringLength(const char *string) {
- std::size_t length{std::strlen(string)};
- if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
- return static_cast<std::int64_t>(length);
- } else {
- std::size_t max{std::numeric_limits<std::int64_t>::max()};
- return length > max ? 0 // Just fail.
- : static_cast<std::int64_t>(length);
- }
-}
-
static bool IsValidCharDescriptor(const Descriptor *value) {
return value && value->IsAllocated() &&
value->type() == TypeCode(TypeCategory::Character, 1) &&
@@ -71,27 +65,6 @@ static std::int32_t CopyToDescriptor(const Descriptor &value,
return StatOk;
}
-static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
- const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
- bool haveValue{IsValidCharDescriptor(value)};
-
- std::int64_t len{StringLength(rawValue)};
- if (len <= 0) {
- if (haveValue) {
- FillWithSpaces(*value);
- }
- return ToErrmsg(errmsg, StatMissingArgument);
- }
-
- std::int32_t stat{StatOk};
- if (haveValue) {
- stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
- }
-
- offset += len;
- return stat;
-}
-
static void StoreIntToDescriptor(
const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
auto typeCode{intVal->type().GetCategoryAndKind()};
@@ -111,30 +84,75 @@ template <int KIND> struct FitsInIntegerKind {
}
};
-static bool FitsInDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
- kind, terminator, value);
-}
-
-std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
+void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
const Descriptor *exitstat, const Descriptor *cmdstat,
const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
int exitstatVal;
int cmdstatVal;
+ pid_t pid;
+ std::array<char, 30> cmdstr;
+ cmdstr.fill(' ');
+
+ // cmdstat specified in 16.9.73
+ // It is assigned the value −1 if the processor does not support command
+ // line execution, a processor-dependent positive value if an error
+ // condition occurs, or the value −2 if no error condition occurs but WAIT
+ // is present with the value false and the processor does not support
+ // asynchronous execution. Otherwise it is assigned the value 0
+ enum CMD_STAT {
+ ASYNC_NO_SUPPORT_ERR = -2,
+ NO_SUPPORT_ERR = -1,
+ CMD_EXECUTED = 0,
+ FORK_ERR = 1,
+ EXECL_ERR = 2,
+ SIGNAL_ERR = 3
+ };
+
+ if (command) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
+ }
if (wait) {
- // RUNTIME_CHECK(terminator, IsValidLogicalDescriptor(wait));
- // if (wait)
+ // either wait is not specified or wait is true: synchronous mode
+ exitstatVal = std::system(command->OffsetElement());
+ cmdstatVal = CMD_EXECUTED;
} else {
- if (command) {
- RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
- exitstatVal = std::system(command->OffsetElement());
+// Asynchronous mode, Windows doesn't support fork()
+#ifdef _WIN32
+ STARTUPINFO si;
+ PROCESS_INFORMATION pi;
+
+ ZeroMemory(&si, sizeof(si));
+ si.cb = sizeof(si);
+ ZeroMemory(&pi, sizeof(pi));
+
+ if (CreateProcess(nullptr, const_cast<char *>(cmd), nullptr, nullptr, FALSE,
+ 0, nullptr, nullptr, &si, &pi)) {
+ if (!GetExitCodeProcess(pi.hProcess, (DWORD)&exitstatVal)) {
+ cmdstatVal = (uint32_t)GetLastError();
+ std::strncpy(cmdstr.data(), "GetExitCodeProcess failed.", 26);
+ } else {
+ cmdstatVal = CMD_EXECUTED;
+ }
+ } else {
+ cmdstatVal = (uint32_t)GetLastError();
+ std::strncpy(cmdstr.data(), "CreateProcess failed.", 21);
}
+
+#else
+ pid = fork();
+ if (pid < 0) {
+ std::strncpy(cmdstr.data(), "Fork failed", 11);
+ cmdstatVal = FORK_ERR;
+ } else if (pid == 0) {
+ exitstatVal =
+ execl("/bin/sh", "sh", "-c", command->OffsetElement(), (char *)NULL);
+ cmdstatVal = CMD_EXECUTED;
+ std::strncpy(cmdstr.data(), "Command executed.", 17);
+ }
+#endif
}
if (exitstat) {
@@ -144,19 +162,14 @@ std::int32_t RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (cmdstat) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
- StoreIntToDescriptor(cmdstat, 0, terminator);
+ StoreIntToDescriptor(cmdstat, cmdstatVal, terminator);
}
if (cmdmsg) {
RUNTIME_CHECK(terminator, IsValidCharDescriptor(cmdmsg));
- std::array<char, 5> str;
- str.fill('f');
- CopyToDescriptor(*cmdmsg, str.data(), str.size(), nullptr);
+ FillWithSpaces(*cmdmsg);
+ CopyToDescriptor(*cmdmsg, cmdstr.data(), cmdstr.size(), nullptr);
}
-
- // TODO
-
- return StatOk;
}
} // namespace Fortran::runtime
>From ecfd50dd5b63f2b29e49c8adae16ea5853943e8c Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 23 Nov 2023 15:52:08 +0000
Subject: [PATCH 15/34] some changes to match the standard 16.9.73
exitstat: If sync, assigned processor-dependent exit status. Otherwise unchanged.
cmdstast: Assigned 0 as specifed in standard, if error then overwrite.
If a condition occurs that would assign a nonzero value to CMDSTAT but
the CMDSTAT variable is not present, error termination is initiated.
---
flang/runtime/execute.cpp | 109 +++++++++++++++++++++-----------------
1 file changed, 61 insertions(+), 48 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 458f2f6c964f3c..d8a37dd19764df 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -89,18 +89,12 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
- int exitstatVal;
- int cmdstatVal;
- pid_t pid;
- std::array<char, 30> cmdstr;
- cmdstr.fill(' ');
-
// cmdstat specified in 16.9.73
- // It is assigned the value −1 if the processor does not support command
- // line execution, a processor-dependent positive value if an error
- // condition occurs, or the value −2 if no error condition occurs but WAIT
- // is present with the value false and the processor does not support
- // asynchronous execution. Otherwise it is assigned the value 0
+ // −1 if the processor does not support command line execution,
+ // a processor-dependent positive value if an error condition occurs
+ // −2 if no error condition occurs but WAIT is present with the value false
+ // and the processor does not support asynchronous execution. Otherwise it is
+ // assigned the value 0
enum CMD_STAT {
ASYNC_NO_SUPPORT_ERR = -2,
NO_SUPPORT_ERR = -1,
@@ -113,63 +107,82 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (command) {
RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
}
+ if (exitstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
+ // If sync, assigned processor-dependent exit status. Otherwise unchanged
+ }
+
+ if (cmdstat) {
+ RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
+ // If a condition occurs that would assign a nonzero value to CMDSTAT but
+ // the CMDSTAT variable is not present, error termination is initiated.
+ // Assigned 0 as specifed in standard, if error then overwrite
+ StoreIntToDescriptor(cmdstat, CMD_EXECUTED, terminator);
+ }
+
+ if (cmdmsg) {
+ RUNTIME_CHECK(terminator, IsValidCharDescriptor(cmdmsg));
+ }
if (wait) {
// either wait is not specified or wait is true: synchronous mode
- exitstatVal = std::system(command->OffsetElement());
- cmdstatVal = CMD_EXECUTED;
+ int exitstatVal = std::system(command->OffsetElement());
+ StoreIntToDescriptor(exitstat, exitstatVal, terminator);
} else {
-// Asynchronous mode, Windows doesn't support fork()
+// Asynchronous mode
#ifdef _WIN32
STARTUPINFO si;
PROCESS_INFORMATION pi;
-
ZeroMemory(&si, sizeof(si));
si.cb = sizeof(si);
ZeroMemory(&pi, sizeof(pi));
- if (CreateProcess(nullptr, const_cast<char *>(cmd), nullptr, nullptr, FALSE,
- 0, nullptr, nullptr, &si, &pi)) {
- if (!GetExitCodeProcess(pi.hProcess, (DWORD)&exitstatVal)) {
- cmdstatVal = (uint32_t)GetLastError();
- std::strncpy(cmdstr.data(), "GetExitCodeProcess failed.", 26);
- } else {
- cmdstatVal = CMD_EXECUTED;
- }
+ // append "cmd.exe /c " to the begining of command
+ const char *cmd = command->OffsetElement();
+ const char *prefix = "cmd.exe /c ";
+ char *newCmd = (char *)malloc(strlen(prefix) + strlen(cmd) + 1);
+ if (newCmd != NULL) {
+ std::strcpy(newCmd, prefix);
+ std::strcat(newCmd, cmd);
} else {
- cmdstatVal = (uint32_t)GetLastError();
- std::strncpy(cmdstr.data(), "CreateProcess failed.", 21);
+ terminator.Crash("Memory allocation failed for newCmd");
+ }
+
+ // Convert the narrow string to a wide string
+ int size_needed = MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, NULL, 0);
+ wchar_t *wcmd = new wchar_t[size_needed];
+ if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, size_needed) != 0) {
+ terminator.Crash(
+ "Char to wider char conversion failed with error code: %lu.",
+ GetLastError());
}
+ free(newCmd);
+ if (!CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
+ nullptr, &si, &pi)) {
+ if (!cmdstat) {
+ terminator.Crash(
+ "CreateProcess failed with error code: %lu.", GetLastError());
+ } else {
+ StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
+ CopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21, nullptr);
+ }
+ }
+ delete[] wcmd;
#else
- pid = fork();
+ pid_t pid = fork();
if (pid < 0) {
- std::strncpy(cmdstr.data(), "Fork failed", 11);
- cmdstatVal = FORK_ERR;
+ if (!cmdstat) {
+ terminator.Crash("Fork failed with error code: %d.", FORK_ERR);
+ } else {
+ StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
+ CopyToDescriptor(*cmdmsg, "Fork failed", 11, nullptr);
+ }
} else if (pid == 0) {
- exitstatVal =
- execl("/bin/sh", "sh", "-c", command->OffsetElement(), (char *)NULL);
- cmdstatVal = CMD_EXECUTED;
- std::strncpy(cmdstr.data(), "Command executed.", 17);
+ execl("/bin/sh", "sh", "-c", command->OffsetElement(), (char *)NULL);
}
#endif
}
-
- if (exitstat) {
- RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
- StoreIntToDescriptor(exitstat, exitstatVal, terminator);
- }
-
- if (cmdstat) {
- RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
- StoreIntToDescriptor(cmdstat, cmdstatVal, terminator);
- }
-
- if (cmdmsg) {
- RUNTIME_CHECK(terminator, IsValidCharDescriptor(cmdmsg));
- FillWithSpaces(*cmdmsg);
- CopyToDescriptor(*cmdmsg, cmdstr.data(), cmdstr.size(), nullptr);
- }
}
} // namespace Fortran::runtime
>From 9f687f01874490c4774f30859a0c78829f9d6a06 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Tue, 28 Nov 2023 12:12:05 +0000
Subject: [PATCH 16/34] Fixing error termination Linux only
Work and test on Linux, both sync and async mode.
Sync mode: termination will terminate directly
Async mode: will only terminate the child/async process, no effect on parent
Standard: If a condition occurs that would assign a nonzero value to CMDSTAT,
but the CMDSTAT variable is not present, error termination is initiated.
---
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 2 +-
flang/runtime/execute.cpp | 118 +++++++++++-------
2 files changed, 77 insertions(+), 43 deletions(-)
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 9100cf0a4394bb..8b262e5fda6430 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -2802,7 +2802,7 @@ void IntrinsicLibrary::genExecuteCommandLine(
mlir::Value waitBool = isStaticallyPresent(wait)
? fir::getBase(wait)
- : builder.createBool(loc, false);
+ : builder.createBool(loc, true);
mlir::Value exitstatBox =
isStaticallyPresent(exitstat)
? fir::getBase(exitstat)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index d8a37dd19764df..93b5d1b0e046e9 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -23,8 +23,25 @@
#include <unistd.h>
#endif
+
namespace Fortran::runtime {
+// cmdstat specified in 16.9.73
+// −1 if the processor does not support command line execution,
+// a processor-dependent positive value if an error condition occurs
+// −2 if no error condition occurs but WAIT is present with the value false
+// and the processor does not support asynchronous execution. Otherwise it is
+// assigned the value 0
+enum CMD_STAT {
+ ASYNC_NO_SUPPORT_ERR = -2,
+ NO_SUPPORT_ERR = -1,
+ CMD_EXECUTED = 0,
+ FORK_ERR = 1,
+ EXECL_ERR = 2,
+ INVALID_CL_ERR = 3,
+ SIGNAL_ERR = 4
+};
+
static bool IsValidCharDescriptor(const Descriptor *value) {
return value && value->IsAllocated() &&
value->type() == TypeCode(TypeCategory::Character, 1) &&
@@ -39,30 +56,16 @@ static bool IsValidIntDescriptor(const Descriptor *length) {
length->type().IsInteger() && typeCode && typeCode->second != 1;
}
-static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
- if (offset < value.ElementBytes()) {
- std::memset(
- value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
+void CheckAndCopyToDescriptor(const Descriptor *value, const char *rawValue,
+ std::int64_t rawValueLength, std::size_t offset = 0) {
+ if (!value) {
+ return;
}
-}
-
-static std::int32_t CopyToDescriptor(const Descriptor &value,
- const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
- std::size_t offset = 0) {
std::int64_t toCopy{std::min(rawValueLength,
- static_cast<std::int64_t>(value.ElementBytes() - offset))};
- if (toCopy < 0) {
- return ToErrmsg(errmsg, StatValueTooShort);
- }
-
- std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+ static_cast<std::int64_t>(value->ElementBytes() - offset))};
- if (rawValueLength > toCopy) {
- return ToErrmsg(errmsg, StatValueTooShort);
- }
-
- return StatOk;
+ std::memcpy(value->OffsetElement(offset), rawValue, toCopy);
}
static void StoreIntToDescriptor(
@@ -73,6 +76,13 @@ static void StoreIntToDescriptor(
kind, terminator, *intVal, /* atIndex = */ 0, value);
}
+static void CheckAndStoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
+ if (intVal) {
+ StoreIntToDescriptor(intVal, value, terminator);
+ }
+}
+
template <int KIND> struct FitsInIntegerKind {
bool operator()([[maybe_unused]] std::int64_t value) {
if constexpr (KIND >= 8) {
@@ -84,29 +94,51 @@ template <int KIND> struct FitsInIntegerKind {
}
};
+// If a condition occurs that would assign a nonzero value to CMDSTAT but
+// the CMDSTAT variable is not present, error termination is initiated.
+int TerminationCheck(int status, const Descriptor *command,
+ const Descriptor *cmdstat, const Descriptor *cmdmsg,
+ Terminator &terminator) {
+ int exitStatusVal = WEXITSTATUS(status);
+ if (exitStatusVal == 127 || exitStatusVal == 126) {
+ if (!cmdstat) {
+ terminator.Crash("\'%s\' not found with exit status code: %d",
+ command->OffsetElement(), exitStatusVal);
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
+ CheckAndCopyToDescriptor(cmdmsg, "Invalid command line", 20);
+ }
+ }
+
+ if (WIFSIGNALED(status)) {
+ if (!cmdstat) {
+ terminator.Crash("killed by signal: %d", WTERMSIG(status));
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
+ CheckAndCopyToDescriptor(cmdmsg, "killed by signal", 18);
+ }
+ }
+
+ if (WIFSTOPPED(status)) {
+ if (!cmdstat) {
+ terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
+ CheckAndCopyToDescriptor(cmdmsg, "stopped by signal", 17);
+ }
+ }
+ return exitStatusVal;
+}
+
void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
const Descriptor *exitstat, const Descriptor *cmdstat,
const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
- // cmdstat specified in 16.9.73
- // −1 if the processor does not support command line execution,
- // a processor-dependent positive value if an error condition occurs
- // −2 if no error condition occurs but WAIT is present with the value false
- // and the processor does not support asynchronous execution. Otherwise it is
- // assigned the value 0
- enum CMD_STAT {
- ASYNC_NO_SUPPORT_ERR = -2,
- NO_SUPPORT_ERR = -1,
- CMD_EXECUTED = 0,
- FORK_ERR = 1,
- EXECL_ERR = 2,
- SIGNAL_ERR = 3
- };
-
if (command) {
RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
}
+
if (exitstat) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
// If sync, assigned processor-dependent exit status. Otherwise unchanged
@@ -114,8 +146,6 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (cmdstat) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(cmdstat));
- // If a condition occurs that would assign a nonzero value to CMDSTAT but
- // the CMDSTAT variable is not present, error termination is initiated.
// Assigned 0 as specifed in standard, if error then overwrite
StoreIntToDescriptor(cmdstat, CMD_EXECUTED, terminator);
}
@@ -126,8 +156,10 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (wait) {
// either wait is not specified or wait is true: synchronous mode
- int exitstatVal = std::system(command->OffsetElement());
- StoreIntToDescriptor(exitstat, exitstatVal, terminator);
+ int status{std::system(command->OffsetElement())};
+ int exitStatusVal =
+ TerminationCheck(status, command, cmdstat, cmdmsg, terminator);
+ CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
} else {
// Asynchronous mode
#ifdef _WIN32
@@ -173,13 +205,15 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
pid_t pid = fork();
if (pid < 0) {
if (!cmdstat) {
- terminator.Crash("Fork failed with error code: %d.", FORK_ERR);
+ terminator.Crash("Fork failed with pid: %d.", pid);
} else {
StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "Fork failed", 11, nullptr);
+ CheckAndCopyToDescriptor(cmdmsg, "Fork failed", 11);
}
} else if (pid == 0) {
- execl("/bin/sh", "sh", "-c", command->OffsetElement(), (char *)NULL);
+ int status = std::system(command->OffsetElement());
+ TerminationCheck(status, command, cmdstat, cmdmsg, terminator);
+ exit(status);
}
#endif
}
>From 7ef735f5b679561d168ebdcf1795b82ad126d9fa Mon Sep 17 00:00:00 2001
From: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Date: Tue, 28 Nov 2023 17:06:41 +0000
Subject: [PATCH 17/34] Added EXECL_ERR if exit==-1, update docs
---
flang/docs/Intrinsics.md | 43 ++++++++++++++
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 2 +-
flang/runtime/execute.cpp | 57 +++++++++++++------
3 files changed, 84 insertions(+), 18 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index fef2b4ea4dd8c8..ffbbed7119692b 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -835,3 +835,46 @@ TRIM, UBOUND, UNPACK, VERIFY.
Coarray, non standard, IEEE and ISO_C_BINDINGS intrinsic functions that can be
used in constant expressions have currently no folding support at all.
+
+### Standard Intrinsics: EXECUTE_COMMAND_LINE
+
+#### Usage and Info
+
+- **Standard:** Fortran 2008 and later, specified in 16.9.73
+- **Class:** Subroutine
+- **Syntax:** `CALL EXECUTE_COMMAND_LINE(COMMAND [, WAIT, EXITSTAT, CMDSTAT, CMDMSG ])`
+- **Arguments:**
+
+ | Argument | Description |
+ |-----------|--------------------------------------------------------------|
+ | `COMMAND` | Shall be a default CHARACTER scalar. |
+ | `WAIT` | (Optional) Shall be a default LOGICAL scalar. |
+ | `EXITSTAT`| (Optional) Shall be an INTEGER of the default kind. |
+ | `CMDSTAT` | (Optional) Shall be an INTEGER of the default kind. |
+ | `CMDMSG` | (Optional) Shall be a CHARACTER scalar of the default kind. |
+
+#### Implementation Specifics
+
+- **`COMMAND`:**
+ - Must be preset.
+
+- **`WAIT`:**
+ - If set to `false`, the command is executed asynchronously. If not preset or set to `false`, it is executed synchronously.
+
+- **`CMDSTAT`:**
+ - -2: No error condition occurs, but `WAIT` is present with the value `false`, and the processor does not support asynchronous execution.
+ - -1: The processor does not support command line execution.
+ - \+ (positive value): An error condition occurs.
+ - 1: Fork Error, where `pid_t < 0`, would only occur on POSIX-compatible systems.
+ - 2: Execution Error, a command exits with status -1.
+ - 3: Invalid Command Error, determined by the exit code depending on the system.
+ - On Windows, if the exit code is 1.
+ - On POSIX-compatible systems, if the exit code is 127 or 126.
+ - 4: Signal error, either it is stopped or killed by signal, would only occur on POSIX-compatible systems.
+ - 0: Otherwise.
+
+- **`CMDMSG`:**
+ - If an error condition occurs, it is assigned an explanatory message. Otherwise, it remains unchanged.
+ - If a condition occurs that would assign a nonzero value to `CMDSTAT` but the `CMDSTAT` variable is not present, error termination is initiated.
+ - On POSIX-compatible systems, this applies to both synchronous and asynchronous error termination. When the execution mode is set to async with error termination, the child process (async process) will be terminated with no effect on the parent process (continues).
+ - On Windows, this only applies to synchronous error termination.
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index 8b262e5fda6430..9017ef2377871b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -2816,7 +2816,7 @@ void IntrinsicLibrary::genExecuteCommandLine(
? fir::getBase(cmdmsg)
: builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
fir::runtime::genExecuteCommandLine(builder, loc, command, waitBool,
- cmdstatBox, exitstatBox, cmdmsgBox);
+ exitstatBox, cmdstatBox, cmdmsgBox);
}
// EXIT
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 93b5d1b0e046e9..67a61939c34c96 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -18,12 +18,12 @@
#ifdef _WIN32
#define LEAN_AND_MEAN
#define NOMINMAX
+#include <stdio.h>
#include <windows.h>
#else
#include <unistd.h>
#endif
-
namespace Fortran::runtime {
// cmdstat specified in 16.9.73
@@ -56,16 +56,19 @@ static bool IsValidIntDescriptor(const Descriptor *length) {
length->type().IsInteger() && typeCode && typeCode->second != 1;
}
-void CheckAndCopyToDescriptor(const Descriptor *value, const char *rawValue,
+void CopyToDescriptor(const Descriptor &value, const char *rawValue,
std::int64_t rawValueLength, std::size_t offset = 0) {
- if (!value) {
- return;
- }
-
std::int64_t toCopy{std::min(rawValueLength,
- static_cast<std::int64_t>(value->ElementBytes() - offset))};
+ static_cast<std::int64_t>(value.ElementBytes() - offset))};
- std::memcpy(value->OffsetElement(offset), rawValue, toCopy);
+ std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+}
+
+void CheckAndCopyToDescriptor(const Descriptor *value, const char *rawValue,
+ std::int64_t rawValueLength, std::size_t offset = 0) {
+ if (value) {
+ CopyToDescriptor(*value, rawValue, rawValueLength, offset);
+ }
}
static void StoreIntToDescriptor(
@@ -99,34 +102,51 @@ template <int KIND> struct FitsInIntegerKind {
int TerminationCheck(int status, const Descriptor *command,
const Descriptor *cmdstat, const Descriptor *cmdmsg,
Terminator &terminator) {
+ if (status == -1) {
+ if (!cmdstat) {
+ terminator.Crash("Execution error with system status code: %d",
+ command->OffsetElement(), status);
+ } else {
+ CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
+ CopyToDescriptor(*cmdmsg, "Execution error", 15);
+ }
+ }
+#ifdef _WIN32
+ // On WIN32 API std::system directly returns exit status
+ int exitStatusVal = status;
+ if (exitStatusVal == 1) {
+#else
int exitStatusVal = WEXITSTATUS(status);
if (exitStatusVal == 127 || exitStatusVal == 126) {
+#endif
if (!cmdstat) {
terminator.Crash("\'%s\' not found with exit status code: %d",
command->OffsetElement(), exitStatusVal);
} else {
CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
- CheckAndCopyToDescriptor(cmdmsg, "Invalid command line", 20);
+ CopyToDescriptor(*cmdmsg, "Invalid command line", 20);
}
}
-
+#if defined(_WIFSIGNALED) && defined(_WTERMSIG)
if (WIFSIGNALED(status)) {
if (!cmdstat) {
terminator.Crash("killed by signal: %d", WTERMSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CheckAndCopyToDescriptor(cmdmsg, "killed by signal", 18);
+ CopyToDescriptor(*cmdmsg, "killed by signal", 18);
}
}
-
+#endif
+#if defined(_WIFSTOPPED) && defined(_WSTOPSIG)
if (WIFSTOPPED(status)) {
if (!cmdstat) {
terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CheckAndCopyToDescriptor(cmdmsg, "stopped by signal", 17);
+ CopyToDescriptor(*cmdmsg, "stopped by signal", 17);
}
}
+#endif
return exitStatusVal;
}
@@ -169,7 +189,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
si.cb = sizeof(si);
ZeroMemory(&pi, sizeof(pi));
- // append "cmd.exe /c " to the begining of command
+ // append "cmd.exe /c " to the beginning of command
const char *cmd = command->OffsetElement();
const char *prefix = "cmd.exe /c ";
char *newCmd = (char *)malloc(strlen(prefix) + strlen(cmd) + 1);
@@ -183,21 +203,24 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
// Convert the narrow string to a wide string
int size_needed = MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, NULL, 0);
wchar_t *wcmd = new wchar_t[size_needed];
- if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, size_needed) != 0) {
+ if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, size_needed) == 0) {
terminator.Crash(
"Char to wider char conversion failed with error code: %lu.",
GetLastError());
}
free(newCmd);
- if (!CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
+ if (CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
nullptr, &si, &pi)) {
+ CloseHandle(pi.hProcess);
+ CloseHandle(pi.hThread);
+ } else {
if (!cmdstat) {
terminator.Crash(
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21, nullptr);
+ CopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21);
}
}
delete[] wcmd;
>From 1b17b28be64dee6dca5a2a7a072d0a4f242937be Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 30 Nov 2023 13:49:38 +0000
Subject: [PATCH 18/34] Add runtime tests
---
flang/runtime/execute.cpp | 6 +-
flang/unittests/Runtime/CommandTest.cpp | 101 ++++++++++++++++++++++++
2 files changed, 104 insertions(+), 3 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 67a61939c34c96..77b7ae2a7e4c2d 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -127,7 +127,7 @@ int TerminationCheck(int status, const Descriptor *command,
CopyToDescriptor(*cmdmsg, "Invalid command line", 20);
}
}
-#if defined(_WIFSIGNALED) && defined(_WTERMSIG)
+#if defined(WIFSIGNALED) && defined(WTERMSIG)
if (WIFSIGNALED(status)) {
if (!cmdstat) {
terminator.Crash("killed by signal: %d", WTERMSIG(status));
@@ -137,7 +137,7 @@ int TerminationCheck(int status, const Descriptor *command,
}
}
#endif
-#if defined(_WIFSTOPPED) && defined(_WSTOPSIG)
+#if defined(WIFSTOPPED) && defined(WSTOPSIG)
if (WIFSTOPPED(status)) {
if (!cmdstat) {
terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
@@ -220,7 +220,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21);
+ CheckAndCopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21);
}
}
delete[] wcmd;
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index 9f66c7924c86e3..c3bf9ae5a53ecb 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -10,6 +10,7 @@
#include "gmock/gmock.h"
#include "gtest/gtest.h"
#include "flang/Runtime/descriptor.h"
+#include "flang/Runtime/execute.h"
#include "flang/Runtime/main.h"
#include <cstdlib>
@@ -46,6 +47,18 @@ static OwningPtr<Descriptor> EmptyIntDescriptor() {
return descriptor;
}
+template <int kind = sizeof(std::int64_t)>
+static OwningPtr<Descriptor> IntDescriptor(const int &value) {
+ Terminator terminator{__FILE__, __LINE__};
+ OwningPtr<Descriptor> descriptor{Descriptor::Create(TypeCategory::Integer,
+ kind, nullptr, 0, nullptr, CFI_attribute_allocatable)};
+ if (descriptor->Allocate() != 0) {
+ return nullptr;
+ }
+ std::memcpy(descriptor->OffsetElement<int>(), &value, sizeof(int));
+ return descriptor;
+}
+
class CommandFixture : public ::testing::Test {
protected:
CommandFixture(int argc, const char *argv[]) {
@@ -227,6 +240,94 @@ TEST_F(ZeroArguments, GetCommandArgument) {
TEST_F(ZeroArguments, GetCommand) { CheckCommandValue(commandOnlyArgv, 1); }
+TEST_F(ZeroArguments, ECLValidCommandAndPadSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> cmdStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ std::string spaces(cmdMsg->ElementBytes(), ' ');
+ CheckDescriptorEqInt(exitStat.get(), 0);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLValidCommandStatusSetSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ CheckDescriptorEqInt(exitStat.get(), 0);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandErrorSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("Message ChangedXXXXXXXXX")};
+
+ RTNAME(ExecuteCommandLine)
+ (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ CheckDescriptorEqInt(exitStat.get(), 127);
+ CheckDescriptorEqInt(cmdStat.get(), 3);
+ CheckDescriptorEqStr(cmdMsg.get(), "Invalid command lineXXXX");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandTerminatedSync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{true};
+ OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No Change")};
+
+ EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
+ command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ "'InvalidCommand' not found with exit status code: 127");
+
+ CheckDescriptorEqInt(exitStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No Change");
+}
+
+TEST_F(ZeroArguments, ECLValidCommandAndExitStatNoChangeAndCMDStatusSetAsync) {
+ OwningPtr<Descriptor> command{CharDescriptor("echo hi")};
+ bool wait{false};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdStat{IntDescriptor(202)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ RTNAME(ExecuteCommandLine)
+ (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+
+ CheckDescriptorEqInt(exitStat.get(), 404);
+ CheckDescriptorEqInt(cmdStat.get(), 0);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
+TEST_F(ZeroArguments, ECLInvalidCommandParentNotTerminatedAsync) {
+ OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
+ bool wait{false};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
+ OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
+
+ EXPECT_NO_FATAL_FAILURE(RTNAME(ExecuteCommandLine)(
+ command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()));
+
+ CheckDescriptorEqInt(exitStat.get(), 404);
+ CheckDescriptorEqStr(cmdMsg.get(), "No change");
+}
+
static const char *oneArgArgv[]{"aProgram", "anArgumentOfLength20"};
class OneArgument : public CommandFixture {
protected:
>From 521228c5b55039f3e593522e5e8cec4e32075b18 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 30 Nov 2023 21:30:59 +0000
Subject: [PATCH 19/34] Add lowering intrinsic tests
---
.../execute_command_line-optional.f90 | 102 +++++-----
.../Lower/Intrinsics/execute_command_line.f90 | 192 +++++-------------
flang/unittests/Runtime/CommandTest.cpp | 1 -
3 files changed, 102 insertions(+), 193 deletions(-)
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
index be63bc75f2ebf5..706f544d063f4d 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -1,55 +1,53 @@
-! Test execute_command_line with dynamically optional arguments.
! RUN: bbc -emit-fir %s -o - | FileCheck %s
-
-! CHECK-LABEL: func @_QPtest(
-! CHECK-SAME: %[[ARG_0:.*]]: !fir.boxchar<1> {fir.bindc_command = "command", fir.optional},
-! CHECK-SAME: %[[ARG_1:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
-! CHECK-SAME: %[[ARG_2:.*]]: !fir.ref<i32> {fir.bindc_command = "length", fir.optional},
-! CHECK-SAME: %[[ARG_3:.*]]: !fir.ref<i32> {fir.bindc_command = "cmdstat", fir.optional},
-! CHECK-SAME: %[[ARG_4:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg", fir.optional}) {
-subroutine test(command, wait, length, cmdstat, cmdmsg)
- integer, optional :: cmdstat, length
- logical :: wait
- character(*), optional :: command, cmdmsg
+! CHECK-LABEL: func.func @_QPall_args_optional(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command", fir.optional},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "iswait", fir.optional},
+! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "exitval", fir.optional},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "cmdval", fir.optional},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "msg", fir.optional}) {
+subroutine all_args_optional(command, isWait, exitVal, cmdVal, msg)
+ CHARACTER(*), OPTIONAL :: command, msg
+ INTEGER, OPTIONAL :: exitVal, cmdVal
+ LOGICAL, OPTIONAL :: isWait
! Note: command is not optional in execute_command_line and must be present
- call execute_command_line(command, wait, length, cmdstat, cmdmsg)
-! CHECK: %[[VAL_0:.*]]:2 = fir.unboxchar %[[ARG_5]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_1:.*]]:2 = fir.unboxchar %[[ARG_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_2:.*]]:2 = fir.unboxchar %[[ARG_1]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1]]#0 typeparams %[[VAL_1]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_4:.*]] = fir.is_present %[[VAL_2]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
-! CHECK: %[[VAL_5:.*]] = fir.embox %[[VAL_2]]#0 typeparams %[[VAL_2]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_6:.*]] = fir.absent !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_7:.*]] = arith.select %[[VAL_4]], %[[VAL_5]], %[[VAL_6]] : !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_8:.*]] = fir.is_present %[[ARG_2]] : (!fir.ref<i32>) -> i1
-! CHECK: %[[VAL_9:.*]] = fir.embox %[[ARG_2]] : (!fir.ref<i32>) -> !fir.box<i32>
-! CHECK: %[[VAL_10:.*]] = fir.absent !fir.box<i32>
-! CHECK: %[[VAL_11:.*]] = arith.select %[[VAL_8]], %[[VAL_9]], %[[VAL_10]] : !fir.box<i32>
-! CHECK: %[[VAL_12:.*]] = fir.is_present %[[VAL_0]]#0 : (!fir.ref<!fir.char<1,?>>) -> i1
-! CHECK: %[[VAL_13:.*]] = fir.embox %[[VAL_0]]#0 typeparams %[[VAL_0]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_14:.*]] = fir.absent !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_15:.*]] = arith.select %[[VAL_12]], %[[VAL_13]], %[[VAL_14]] : !fir.box<!fir.char<1,?>>
-! CHECK: %[[VAL_16:.*]] = fir.convert %[[ARG_4]] : (!fir.ref<!fir.logical<4>>) -> 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<!fir.logical<4>>
-! CHECK: %[[VAL_29:.*]] = fir.convert %[[VAL_28]] : (!fir.logical<4>) -> i1
-! CHECK: fir.result %[[VAL_29]] : i1
-! CHECK: } else {
-! CHECK: %[[CONST_1:.*]] = arith.constant true
-! CHECK: fir.result %[[CONST_1]] : i1
-! CHECK: }
-! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_3]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_7]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_11]] : (!fir.box<i32>) -> !fir.box<none>
-! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_15]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAExecuteCommandLine(%[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_18]], %[[VAL_23]], %{{.*}}, %{{.*}}) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK: %[[VAL_26:.*]] = fir.convert %[[ARG_3]] : (!fir.ref<i32>) -> 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<i32>
-! CHECK: }
-end subroutine
+ call execute_command_line(command, isWait, exitVal, cmdVal, msg)
+! CHECK: %0 = fir.declare %[[cmdstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %1:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %2 = fir.declare %1#0 typeparams %1#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcommand"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %3 = fir.emboxchar %2, %1#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %4 = fir.declare %[[exitstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %5 = fir.declare %[[waitArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %6:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %7 = fir.declare %6#0 typeparams %6#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEmsg"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %8 = fir.emboxchar %7, %6#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %9 = fir.is_present %5 : (!fir.ref<!fir.logical<4>>) -> i1
+! CHECK-NEXT: %10 = fir.is_present %4 : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %11 = fir.is_present %0 : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %12 = fir.is_present %8 : (!fir.boxchar<1>) -> i1
+! CHECK-NEXT: %13 = fir.embox %2 typeparams %1#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %14 = fir.if %9 -> (!fir.logical<4>) {
+! CHECK-NEXT: %31 = fir.load %5 : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: fir.result %31 : !fir.logical<4>
+! CHECK-NEXT: } else {
+! CHECK-NEXT: %31 = fir.convert %false : (i1) -> !fir.logical<4>
+! CHECK-NEXT: fir.result %31 : !fir.logical<4>
+! CHECK-NEXT: }
+! CHECK-NEXT: %15 = fir.embox %4 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %16 = fir.absent !fir.box<i32>
+! CHECK-NEXT: %17 = arith.select %10, %15, %16 : !fir.box<i32>
+! CHECK-NEXT: %18 = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %19 = arith.select %11, %18, %16 : !fir.box<i32>
+! CHECK-NEXT: %20 = fir.embox %7 typeparams %6#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %21 = fir.absent !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %22 = arith.select %12, %20, %21 : !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %23 = fir.address_of(@_QQclX76c8fd75e0e20222cfcde5fe9055bcbe) : !fir.ref<!fir.char<1,96>>
+! CHECK-NEXT: %24 = fir.convert %13 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-NEXT: %25 = fir.convert %14 : (!fir.logical<4>) -> i1
+! CHECK-NEXT: %26 = fir.convert %17 : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %27 = fir.convert %19 : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %28 = fir.convert %22 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-NEXT: %29 = fir.convert %23 : (!fir.ref<!fir.char<1,96>>) -> !fir.ref<i8>
+! CHECK-NEXT: %30 = fir.call @_FortranAExecuteCommandLine(%24, %25, %26, %27, %28, %29, %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine all_args_optional
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
index 8ceae841440bc3..68befdb850861a 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -1,142 +1,54 @@
-! 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
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
-! CHECK-LABEL: func @_QPcommand_only(
-! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"}) {
-subroutine command_only(command)
- character(len=32) :: command
- call execute_command_line(command)
-! CHECK-Next: fir.call @_FortranAExecuteCommandLine
-! CHECK-NEXT: return
-end subroutine command_only
+! CHECK-LABEL: func.func @_QPall_args(
+! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"},
+! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_name = "iswait"},
+! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "exitval"},
+! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i32> {fir.bindc_name = "cmdval"},
+! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "msg"}) {
+subroutine all_args(command, isWait, exitVal, cmdVal, msg)
+CHARACTER(30) :: command, msg
+INTEGER :: exitVal, cmdVal
+LOGICAL :: isWait
+call execute_command_line(command, isWait, exitVal, cmdVal, msg)
+! CHECK: %0 = fir.declare %[[cmdstatArg]] {uniq_name = "_QFall_argsEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %3 = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %4 = fir.declare %[[exitstatArg]] {uniq_name = "_QFall_argsEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %5 = fir.declare %[[waitArg]] {uniq_name = "_QFall_argsEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %8 = fir.declare %[[cmdmsgCast]] typeparams %c30 {uniq_name = "_QFall_argsEmsg"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %3 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[waitLoaded:.*]] = fir.load %5 : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %4 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %8 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %14 = fir.address_of(@_QQclX05b779b120ed6fd4f4d4144c6c9136d6) : !fir.ref<!fir.char<1,87>>
+! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK-NEXT: %20 = fir.convert %14 : (!fir.ref<!fir.char<1,87>>) -> !fir.ref<i8>
+! CHECK-NEXT: %21 = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %20, %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine all_args
-! CHECK-LABEL: func @_QPcommand_and_wait_only(
-! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
-! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
-subroutine command_and_wait_only(command, wait)
- character(len=32) :: command
- logical::wait
- wait = .false.
- call execute_command_line(command, wait)
-! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[waitUnbox:.*]]:2 = fir.unboxchar %[[waitArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[waitCast:.*]] = fir.convert %[[waitUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %[[waitBox:.*]] = fir.embox %[[waitCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %true = arith.constant true
-! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
-! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-NEXT: return
-end subroutine command_and_wait_only
-
-! CHECK-LABEL: func @_QPcommand_and_exitstat_only(
-! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
-! CHECK-SAME: %[[exitstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "exitstat"}) {
-subroutine command_and_exitstat_only(command, exitstat)
- character(len=32) :: command
- integer :: exitstat
- call execute_command_line(command, EXITSTAT=exitstat)
-! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %arg1 : (!fir.ref<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<i[[DEFAULT_INTEGER_SIZE]]>
-! CHECK-NEXT: %true = arith.constant true
-! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
-! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
-! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
-! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{.*}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-end subroutine command_and_exitstat_only
-
-! CHECK-LABEL: func @_QPcommand_and_cmdstat_only(
-! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
-! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "cmdstat"}) {
-subroutine command_and_cmdstat_only(command, cmdstat)
- character(len=32) :: command
- integer :: cmdstat
- call execute_command_line(command, CMDSTAT=cmdstat)
-! CHECK: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %true = arith.constant true
-! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[cmdmsg:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
-! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 9]] : i32
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
-! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
-end subroutine command_and_cmdstat_only
-
-! CHECK-LABEL: func @_QPcommand_and_cmdmsg_only(
-! CHECK-SAME: %[[commandArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
-! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg"}) {
-subroutine command_and_cmdmsg_only(command, cmdmsg)
- character(len=32) :: command, cmdmsg
- call execute_command_line(command, CMDMSG=cmdmsg)
-! CHECK: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %[[cmdmsgCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %true = arith.constant true
-! CHECK-NEXT: %[[wait:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[exitstat:.*]] = fir.absent !fir.box<none>
-! CHECK-NEXT: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.{{.*}}) : !fir.ref<!fir.char<1,[[sourceFileexitstat:.*]]>>
-! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 11]] : i32
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[sourceFileexitstat]]>>) -> !fir.ref<i8>
-! CHECK-NEXT: %{{[0-9]+}} = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %true, %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-NEXT: return
-end subroutine command_and_cmdmsg_only
-
-! CHECK-LABEL: func @_QPall_arguments(
-! CHECK-SAME: %[[commandArg:[^:]*]]: !fir.boxchar<1> {fir.bindc_command = "command"},
-! CHECK-SAME: %[[waitArg:.*]]: !fir.ref<!fir.logical<4>> {fir.bindc_command = "wait", fir.optional},
-! CHECK-SAME: %[[exitstatArg:[^:]*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "exitstat"},
-! CHECK-SAME: %[[cmdstatArg:.*]]: !fir.ref<i[[DEFAULT_INTEGER_SIZE]]> {fir.bindc_command = "cmdstat"},
-! CHECK-SAME: %[[cmdmsgArg:.*]]: !fir.boxchar<1> {fir.bindc_command = "cmdmsg"}) {
-subroutine all_arguments(command, wait, exitstat, cmdstat, cmdmsg)
- character(len=32) :: command, cmdmsg
- logical :: wait
- integer :: exitstat, cmdstat
- wait=.false.
- call execute_command_line(command, wait, exitstat, cmdstat, cmdmsg)
-! CHECK: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[waitUnbox:.*]]:2 = fir.unboxchar %[[waitArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %[[waitCast:.*]] = fir.convert %[[waitUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,32>>
-! CHECK-NEXT: %[[commandBoxed:.*]] = fir.embox %[[commandCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %[[waitBoxed:.*]] = fir.embox %[[waitCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK-NEXT: %[[exitstatBoxed:.*]] = fir.embox %[[exitstatArg]] : (!fir.ref<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<i[[DEFAULT_INTEGER_SIZE]]>
-! CHECK-NEXT: %[[cmdmsgBoxed:.*]] = fir.embox %[[cmdmsgCast]] : (!fir.ref<!fir.char<1,32>>) -> !fir.box<!fir.char<1,32>>
-! CHECK: %[[sourceFileString:.*]] = fir.address_of(@_QQcl.[[fileString:.*]]) : !fir.ref<!fir.char<1,[[fileStringexitstat:.*]]>>
-! CHECK-NEXT: %[[sourceLine:.*]] = arith.constant [[# @LINE - 22]] : i32
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBoxed]] : (!fir.box<i[[DEFAULT_INTEGER_SIZE]]>) -> !fir.box<none>
-! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBoxed]] : (!fir.box<!fir.char<1,32>>) -> !fir.box<none>
-! CHECK-NEXT: %[[sourceFile:.*]] = fir.convert %[[sourceFileString]] : (!fir.ref<!fir.char<1,[[fileStringexitstat]]>>) -> !fir.ref<i8>
-! CHECK-32-NEXT: %[[cmdstat:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64-NEXT: %[[cmdstat32:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdmsg]], %[[sourceFile]], %[[sourceLine]]) {{.*}}: (!fir.box<none>, !fir.box<none>, !fir.box<none>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
-! CHECK-64: %[[cmdstat:.*]] = fir.convert %[[cmdstat32]] : (i32) -> i64
-! CHECK: fir.store %[[cmdstat]] to %[[cmdstatArg]] : !fir.ref<i[[DEFAULT_INTEGER_SIZE]]>
-end subroutine all_arguments
+! CHECK-LABEL: func.func @_QPonly_command_default_wait_true(
+! CHECK-SAME: %[[cmdArg:.*]]: !fir.boxchar<1> {fir.bindc_name = "command"}) {
+subroutine only_command_default_wait_true(command)
+CHARACTER(30) :: command
+call execute_command_line(command)
+! CHECK: %0:2 = fir.unboxchar %[[cmdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %1 = fir.convert %0#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %2 = fir.declare %1 typeparams %c30 {uniq_name = "_QFonly_command_default_wait_trueEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %3 = fir.embox %2 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %4 = fir.absent !fir.box<none>
+! CHECK-NEXT: %5 = fir.address_of(@_QQclX05b779b120ed6fd4f4d4144c6c9136d6) : !fir.ref<!fir.char<1,87>>
+! CHECK-NEXT: %6 = fir.convert %3 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK-NEXT: %7 = fir.convert %5 : (!fir.ref<!fir.char<1,87>>) -> !fir.ref<i8>
+! CHECK-NEXT: %8 = fir.call @_FortranAExecuteCommandLine(%6, %true, %4, %4, %4, %7, %c43_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: return
+end subroutine only_command_default_wait_true
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index c3bf9ae5a53ecb..66b5d3970ba763 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -49,7 +49,6 @@ static OwningPtr<Descriptor> EmptyIntDescriptor() {
template <int kind = sizeof(std::int64_t)>
static OwningPtr<Descriptor> IntDescriptor(const int &value) {
- Terminator terminator{__FILE__, __LINE__};
OwningPtr<Descriptor> descriptor{Descriptor::Create(TypeCategory::Integer,
kind, nullptr, 0, nullptr, CFI_attribute_allocatable)};
if (descriptor->Allocate() != 0) {
>From f7133e441209ed4d39c14f1426ea47005ceecc4d Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 1 Dec 2023 10:09:59 +0000
Subject: [PATCH 20/34] add more docs, format, and brace initialization
---
flang/docs/Intrinsics.md | 2 ++
flang/runtime/execute.cpp | 28 ++++++++++++++--------------
2 files changed, 16 insertions(+), 14 deletions(-)
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index ffbbed7119692b..40445526314b0a 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -860,6 +860,8 @@ used in constant expressions have currently no folding support at all.
- **`WAIT`:**
- If set to `false`, the command is executed asynchronously. If not preset or set to `false`, it is executed synchronously.
+ - Sync: achieved by passing command into `std::system` on all systems.
+ - Async: achieved by calling a `fork()` on POSIX-compatible systems, or `CreateProcess()` on Windows.
- **`CMDSTAT`:**
- -2: No error condition occurs, but `WAIT` is present with the value `false`, and the processor does not support asynchronous execution.
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 77b7ae2a7e4c2d..7ae64f7ee86a04 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -112,11 +112,11 @@ int TerminationCheck(int status, const Descriptor *command,
}
}
#ifdef _WIN32
- // On WIN32 API std::system directly returns exit status
- int exitStatusVal = status;
+ // On WIN32 API std::system returns exit status directly
+ int exitStatusVal{status};
if (exitStatusVal == 1) {
#else
- int exitStatusVal = WEXITSTATUS(status);
+ int exitStatusVal{WEXITSTATUS(status)};
if (exitStatusVal == 127 || exitStatusVal == 126) {
#endif
if (!cmdstat) {
@@ -177,8 +177,8 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (wait) {
// either wait is not specified or wait is true: synchronous mode
int status{std::system(command->OffsetElement())};
- int exitStatusVal =
- TerminationCheck(status, command, cmdstat, cmdmsg, terminator);
+ int exitStatusVal{
+ TerminationCheck(status, command, cmdstat, cmdmsg, terminator)};
CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
} else {
// Asynchronous mode
@@ -186,13 +186,13 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
STARTUPINFO si;
PROCESS_INFORMATION pi;
ZeroMemory(&si, sizeof(si));
- si.cb = sizeof(si);
+ si.cb{sizeof(si)};
ZeroMemory(&pi, sizeof(pi));
// append "cmd.exe /c " to the beginning of command
- const char *cmd = command->OffsetElement();
- const char *prefix = "cmd.exe /c ";
- char *newCmd = (char *)malloc(strlen(prefix) + strlen(cmd) + 1);
+ const char *cmd{command->OffsetElement()};
+ const char *prefix{"cmd.exe /c "};
+ char *newCmd{(char *)malloc(strlen(prefix) + strlen(cmd) + 1)};
if (newCmd != NULL) {
std::strcpy(newCmd, prefix);
std::strcat(newCmd, cmd);
@@ -201,9 +201,9 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
}
// Convert the narrow string to a wide string
- int size_needed = MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, NULL, 0);
- wchar_t *wcmd = new wchar_t[size_needed];
- if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, size_needed) == 0) {
+ int sizeNeede{MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, NULL, 0)};
+ wchar_t *wcmd{new wchar_t[sizeNeeded]};
+ if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, sizeNeeded) == 0) {
terminator.Crash(
"Char to wider char conversion failed with error code: %lu.",
GetLastError());
@@ -225,7 +225,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
}
delete[] wcmd;
#else
- pid_t pid = fork();
+ pid_t pid{fork()};
if (pid < 0) {
if (!cmdstat) {
terminator.Crash("Fork failed with pid: %d.", pid);
@@ -234,7 +234,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
CheckAndCopyToDescriptor(cmdmsg, "Fork failed", 11);
}
} else if (pid == 0) {
- int status = std::system(command->OffsetElement());
+ int status{std::system(command->OffsetElement())};
TerminationCheck(status, command, cmdstat, cmdmsg, terminator);
exit(status);
}
>From c8e2e00c5a331096c20e582673a6c6ccf8bd5e39 Mon Sep 17 00:00:00 2001
From: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Date: Fri, 1 Dec 2023 10:55:58 +0000
Subject: [PATCH 21/34] add test fixes on Windows and remove `address_of` in
testing
---
flang/runtime/execute.cpp | 20 +++++++++----------
.../execute_command_line-optional.f90 | 6 ++----
.../Lower/Intrinsics/execute_command_line.f90 | 12 ++++-------
flang/unittests/Runtime/CommandTest.cpp | 18 ++++++++++++-----
4 files changed, 28 insertions(+), 28 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 7ae64f7ee86a04..13a103333c1c87 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -120,8 +120,8 @@ int TerminationCheck(int status, const Descriptor *command,
if (exitStatusVal == 127 || exitStatusVal == 126) {
#endif
if (!cmdstat) {
- terminator.Crash("\'%s\' not found with exit status code: %d",
- command->OffsetElement(), exitStatusVal);
+ terminator.Crash(
+ "Invalid command quit with exit status code: %d", exitStatusVal);
} else {
CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
CopyToDescriptor(*cmdmsg, "Invalid command line", 20);
@@ -186,13 +186,13 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
STARTUPINFO si;
PROCESS_INFORMATION pi;
ZeroMemory(&si, sizeof(si));
- si.cb{sizeof(si)};
+ si.cb = sizeof(si);
ZeroMemory(&pi, sizeof(pi));
// append "cmd.exe /c " to the beginning of command
const char *cmd{command->OffsetElement()};
const char *prefix{"cmd.exe /c "};
- char *newCmd{(char *)malloc(strlen(prefix) + strlen(cmd) + 1)};
+ char *newCmd{(char *)malloc(std::strlen(prefix) + std::strlen(cmd) + 1)};
if (newCmd != NULL) {
std::strcpy(newCmd, prefix);
std::strcat(newCmd, cmd);
@@ -200,13 +200,11 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
terminator.Crash("Memory allocation failed for newCmd");
}
- // Convert the narrow string to a wide string
- int sizeNeede{MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, NULL, 0)};
+ // Convert the char to wide char
+ const size_t sizeNeeded{mbstowcs(NULL, newCmd, 0) + 1};
wchar_t *wcmd{new wchar_t[sizeNeeded]};
- if (MultiByteToWideChar(CP_UTF8, 0, newCmd, -1, wcmd, sizeNeeded) == 0) {
- terminator.Crash(
- "Char to wider char conversion failed with error code: %lu.",
- GetLastError());
+ if (std::mbstowcs(wcmd, newCmd, sizeNeeded) == static_cast<size_t>(-1)) {
+ terminator.Crash("Char to wide char failed for newCmd");
}
free(newCmd);
@@ -220,7 +218,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CheckAndCopyToDescriptor(*cmdmsg, "CreateProcess failed.", 21);
+ CheckAndCopyToDescriptor(cmdmsg, "CreateProcess failed.", 21);
}
}
delete[] wcmd;
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
index 706f544d063f4d..eef3b0ccabc09b 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -41,13 +41,11 @@ subroutine all_args_optional(command, isWait, exitVal, cmdVal, msg)
! CHECK-NEXT: %20 = fir.embox %7 typeparams %6#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
! CHECK-NEXT: %21 = fir.absent !fir.box<!fir.char<1,?>>
! CHECK-NEXT: %22 = arith.select %12, %20, %21 : !fir.box<!fir.char<1,?>>
-! CHECK-NEXT: %23 = fir.address_of(@_QQclX76c8fd75e0e20222cfcde5fe9055bcbe) : !fir.ref<!fir.char<1,96>>
-! CHECK-NEXT: %24 = fir.convert %13 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %24 = fir.convert %13 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
! CHECK-NEXT: %25 = fir.convert %14 : (!fir.logical<4>) -> i1
! CHECK-NEXT: %26 = fir.convert %17 : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %27 = fir.convert %19 : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %28 = fir.convert %22 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK-NEXT: %29 = fir.convert %23 : (!fir.ref<!fir.char<1,96>>) -> !fir.ref<i8>
-! CHECK-NEXT: %30 = fir.call @_FortranAExecuteCommandLine(%24, %25, %26, %27, %28, %29, %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK: %30 = fir.call @_FortranAExecuteCommandLine(%24, %25, %26, %27, %28, %29, %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine all_args_optional
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
index 68befdb850861a..3d6d4c1ed8fe2a 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -25,14 +25,12 @@ subroutine all_args(command, isWait, exitVal, cmdVal, msg)
! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %4 : (!fir.ref<i32>) -> !fir.box<i32>
! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %8 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
-! CHECK-NEXT: %14 = fir.address_of(@_QQclX05b779b120ed6fd4f4d4144c6c9136d6) : !fir.ref<!fir.char<1,87>>
-! CHECK-NEXT: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
-! CHECK-NEXT: %20 = fir.convert %14 : (!fir.ref<!fir.char<1,87>>) -> !fir.ref<i8>
-! CHECK-NEXT: %21 = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %20, %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK: %21 = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %20, %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine all_args
@@ -46,9 +44,7 @@ subroutine only_command_default_wait_true(command)
! CHECK-NEXT: %2 = fir.declare %1 typeparams %c30 {uniq_name = "_QFonly_command_default_wait_trueEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
! CHECK-NEXT: %3 = fir.embox %2 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
! CHECK-NEXT: %4 = fir.absent !fir.box<none>
-! CHECK-NEXT: %5 = fir.address_of(@_QQclX05b779b120ed6fd4f4d4144c6c9136d6) : !fir.ref<!fir.char<1,87>>
-! CHECK-NEXT: %6 = fir.convert %3 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
-! CHECK-NEXT: %7 = fir.convert %5 : (!fir.ref<!fir.char<1,87>>) -> !fir.ref<i8>
-! CHECK-NEXT: %8 = fir.call @_FortranAExecuteCommandLine(%6, %true, %4, %4, %4, %7, %c43_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK: %6 = fir.convert %3 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK: %8 = fir.call @_FortranAExecuteCommandLine(%6, %true, %4, %4, %4, %7, %c41_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine only_command_default_wait_true
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index 66b5d3970ba763..ee82a5b3a46724 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -279,8 +279,11 @@ TEST_F(ZeroArguments, ECLInvalidCommandErrorSync) {
RTNAME(ExecuteCommandLine)
(command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
-
+#ifdef _WIN32
+ CheckDescriptorEqInt(exitStat.get(), 1);
+#else
CheckDescriptorEqInt(exitStat.get(), 127);
+#endif
CheckDescriptorEqInt(cmdStat.get(), 3);
CheckDescriptorEqStr(cmdMsg.get(), "Invalid command lineXXXX");
}
@@ -288,14 +291,19 @@ TEST_F(ZeroArguments, ECLInvalidCommandErrorSync) {
TEST_F(ZeroArguments, ECLInvalidCommandTerminatedSync) {
OwningPtr<Descriptor> command{CharDescriptor("InvalidCommand")};
bool wait{true};
- OwningPtr<Descriptor> exitStat{EmptyIntDescriptor()};
+ OwningPtr<Descriptor> exitStat{IntDescriptor(404)};
OwningPtr<Descriptor> cmdMsg{CharDescriptor("No Change")};
+#ifdef _WIN32
EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
- "'InvalidCommand' not found with exit status code: 127");
-
- CheckDescriptorEqInt(exitStat.get(), 0);
+ "Invalid command quit with exit status code: 1");
+#else
+ EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
+ command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ "Invalid command quit with exit status code: 127");
+#endif
+ CheckDescriptorEqInt(exitStat.get(), 404);
CheckDescriptorEqStr(cmdMsg.get(), "No Change");
}
>From af9294c5e2c15936d9869c3d253f55acedd0f34c Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Mon, 4 Dec 2023 16:38:59 +0000
Subject: [PATCH 22/34] terminated children do not become zombies on Linux
signal(SIGCHLD, SIG_IGN);
https://man7.org/linux/man-pages/man2/sigaction.2.html
POSIX.1-1990 disallowed setting the action for SIGCHLD to
SIG_IGN. POSIX.1-2001 and later allow this possibility, so that
ignoring SIGCHLD can be used to prevent the creation of zombies
(see wait(2)). Nevertheless, the historical BSD and System V
behaviors for ignoring SIGCHLD differ, so that the only
completely portable method of ensuring that terminated children
do not become zombies is to catch the SIGCHLD signal and perform
a wait(2) or similar.
---
flang/runtime/execute.cpp | 3 +++
1 file changed, 3 insertions(+)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 13a103333c1c87..3a57194644a145 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -21,6 +21,7 @@
#include <stdio.h>
#include <windows.h>
#else
+#include <signal.h>
#include <unistd.h>
#endif
@@ -223,6 +224,8 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
}
delete[] wcmd;
#else
+ // terminated children do not become zombies
+ signal(SIGCHLD, SIG_IGN);
pid_t pid{fork()};
if (pid < 0) {
if (!cmdstat) {
>From b5df8d7e2990ce67dc5853a79358c1dfbabcd764 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 7 Dec 2023 16:23:45 +0000
Subject: [PATCH 23/34] required para use reference not pointer, ensure command
isn null-terminated
---
flang/include/flang/Runtime/execute.h | 2 +-
flang/runtime/execute.cpp | 39 ++++++++++++++++---------
flang/unittests/Runtime/CommandTest.cpp | 14 ++++-----
3 files changed, 34 insertions(+), 21 deletions(-)
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
index 0c8086fa8ecf09..913c525b4fb8ad 100644
--- a/flang/include/flang/Runtime/execute.h
+++ b/flang/include/flang/Runtime/execute.h
@@ -21,7 +21,7 @@ extern "C" {
// 16.9.83 EXECUTE_COMMAND_LINE
// Execute a command line.
// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
-void RTNAME(ExecuteCommandLine)(const Descriptor *command = nullptr,
+void RTNAME(ExecuteCommandLine)(const Descriptor &command,
bool wait = true, const Descriptor *exitstat = nullptr,
const Descriptor *cmdstat = nullptr, const Descriptor *cmdmsg = nullptr,
const char *sourceFile = nullptr, int line = 0);
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 3a57194644a145..b9ce066313173d 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -100,13 +100,11 @@ template <int KIND> struct FitsInIntegerKind {
// If a condition occurs that would assign a nonzero value to CMDSTAT but
// the CMDSTAT variable is not present, error termination is initiated.
-int TerminationCheck(int status, const Descriptor *command,
- const Descriptor *cmdstat, const Descriptor *cmdmsg,
+int TerminationCheck(int status, const Descriptor *cmdstat, const Descriptor *cmdmsg,
Terminator &terminator) {
if (status == -1) {
if (!cmdstat) {
- terminator.Crash("Execution error with system status code: %d",
- command->OffsetElement(), status);
+ terminator.Crash("Execution error with system status code: %d", status);
} else {
CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
CopyToDescriptor(*cmdmsg, "Execution error", 15);
@@ -151,14 +149,29 @@ int TerminationCheck(int status, const Descriptor *command,
return exitStatusVal;
}
-void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
+const char *ensureNullTerminated(
+ const char *str, size_t length, Terminator &terminator) {
+ if (length < strlen(str)) {
+ char *newCmd{(char *)malloc(length + 1)};
+ if (newCmd == NULL) {
+ terminator.Crash("Command not null-terminated, memory allocation failed "
+ "for null-terminated newCmd.");
+ }
+
+ strncpy(newCmd, str, length);
+ newCmd[length] = '\0';
+ return newCmd;
+ } else {
+ return str;
+ }
+}
+
+void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
const Descriptor *exitstat, const Descriptor *cmdstat,
const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
-
- if (command) {
- RUNTIME_CHECK(terminator, IsValidCharDescriptor(command));
- }
+ const char *newCmd{ensureNullTerminated(
+ command.OffsetElement(), command.ElementBytes(), terminator)};
if (exitstat) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
@@ -177,9 +190,9 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
if (wait) {
// either wait is not specified or wait is true: synchronous mode
- int status{std::system(command->OffsetElement())};
+ int status{std::system(newCmd)};
int exitStatusVal{
- TerminationCheck(status, command, cmdstat, cmdmsg, terminator)};
+ TerminationCheck(status, cmdstat, cmdmsg, terminator)};
CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
} else {
// Asynchronous mode
@@ -235,8 +248,8 @@ void RTNAME(ExecuteCommandLine)(const Descriptor *command, bool wait,
CheckAndCopyToDescriptor(cmdmsg, "Fork failed", 11);
}
} else if (pid == 0) {
- int status{std::system(command->OffsetElement())};
- TerminationCheck(status, command, cmdstat, cmdmsg, terminator);
+ int status{std::system(newCmd)};
+ TerminationCheck(status, cmdstat, cmdmsg, terminator);
exit(status);
}
#endif
diff --git a/flang/unittests/Runtime/CommandTest.cpp b/flang/unittests/Runtime/CommandTest.cpp
index ee82a5b3a46724..5cb64d4f549392 100644
--- a/flang/unittests/Runtime/CommandTest.cpp
+++ b/flang/unittests/Runtime/CommandTest.cpp
@@ -247,7 +247,7 @@ TEST_F(ZeroArguments, ECLValidCommandAndPadSync) {
OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
RTNAME(ExecuteCommandLine)
- (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
std::string spaces(cmdMsg->ElementBytes(), ' ');
CheckDescriptorEqInt(exitStat.get(), 0);
@@ -263,7 +263,7 @@ TEST_F(ZeroArguments, ECLValidCommandStatusSetSync) {
OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
RTNAME(ExecuteCommandLine)
- (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
CheckDescriptorEqInt(exitStat.get(), 0);
CheckDescriptorEqInt(cmdStat.get(), 0);
@@ -278,7 +278,7 @@ TEST_F(ZeroArguments, ECLInvalidCommandErrorSync) {
OwningPtr<Descriptor> cmdMsg{CharDescriptor("Message ChangedXXXXXXXXX")};
RTNAME(ExecuteCommandLine)
- (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
#ifdef _WIN32
CheckDescriptorEqInt(exitStat.get(), 1);
#else
@@ -296,11 +296,11 @@ TEST_F(ZeroArguments, ECLInvalidCommandTerminatedSync) {
#ifdef _WIN32
EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
- command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
"Invalid command quit with exit status code: 1");
#else
EXPECT_DEATH(RTNAME(ExecuteCommandLine)(
- command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()),
"Invalid command quit with exit status code: 127");
#endif
CheckDescriptorEqInt(exitStat.get(), 404);
@@ -315,7 +315,7 @@ TEST_F(ZeroArguments, ECLValidCommandAndExitStatNoChangeAndCMDStatusSetAsync) {
OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
RTNAME(ExecuteCommandLine)
- (command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
+ (*command.get(), wait, exitStat.get(), cmdStat.get(), cmdMsg.get());
CheckDescriptorEqInt(exitStat.get(), 404);
CheckDescriptorEqInt(cmdStat.get(), 0);
@@ -329,7 +329,7 @@ TEST_F(ZeroArguments, ECLInvalidCommandParentNotTerminatedAsync) {
OwningPtr<Descriptor> cmdMsg{CharDescriptor("No change")};
EXPECT_NO_FATAL_FAILURE(RTNAME(ExecuteCommandLine)(
- command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()));
+ *command.get(), wait, exitStat.get(), nullptr, cmdMsg.get()));
CheckDescriptorEqInt(exitStat.get(), 404);
CheckDescriptorEqStr(cmdMsg.get(), "No change");
>From abe0a57c645d937a04fec57fed33a349af1a96d9 Mon Sep 17 00:00:00 2001
From: Yi Wu <yiwu02 at wdev-yiwu02.arm.com>
Date: Thu, 7 Dec 2023 17:14:10 +0000
Subject: [PATCH 24/34] fixes on Windows
---
flang/runtime/execute.cpp | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index b9ce066313173d..1d51d41503a01f 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -100,8 +100,8 @@ template <int KIND> struct FitsInIntegerKind {
// If a condition occurs that would assign a nonzero value to CMDSTAT but
// the CMDSTAT variable is not present, error termination is initiated.
-int TerminationCheck(int status, const Descriptor *cmdstat, const Descriptor *cmdmsg,
- Terminator &terminator) {
+int TerminationCheck(int status, const Descriptor *cmdstat,
+ const Descriptor *cmdmsg, Terminator &terminator) {
if (status == -1) {
if (!cmdstat) {
terminator.Crash("Execution error with system status code: %d", status);
@@ -191,8 +191,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
if (wait) {
// either wait is not specified or wait is true: synchronous mode
int status{std::system(newCmd)};
- int exitStatusVal{
- TerminationCheck(status, cmdstat, cmdmsg, terminator)};
+ int exitStatusVal{TerminationCheck(status, cmdstat, cmdmsg, terminator)};
CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
} else {
// Asynchronous mode
@@ -204,26 +203,27 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
ZeroMemory(&pi, sizeof(pi));
// append "cmd.exe /c " to the beginning of command
- const char *cmd{command->OffsetElement()};
const char *prefix{"cmd.exe /c "};
- char *newCmd{(char *)malloc(std::strlen(prefix) + std::strlen(cmd) + 1)};
+ char *newCmdWin{
+ (char *)malloc(std::strlen(prefix) + std::strlen(newCmd) + 1)};
if (newCmd != NULL) {
- std::strcpy(newCmd, prefix);
- std::strcat(newCmd, cmd);
+ std::strcpy(newCmdWin, prefix);
+ std::strcat(newCmdWin, newCmd);
} else {
terminator.Crash("Memory allocation failed for newCmd");
}
// Convert the char to wide char
- const size_t sizeNeeded{mbstowcs(NULL, newCmd, 0) + 1};
+ const size_t sizeNeeded{mbstowcs(NULL, newCmdWin, 0) + 1};
wchar_t *wcmd{new wchar_t[sizeNeeded]};
- if (std::mbstowcs(wcmd, newCmd, sizeNeeded) == static_cast<size_t>(-1)) {
+ if (std::mbstowcs(wcmd, newCmdWin, sizeNeeded) == static_cast<size_t>(-1)) {
terminator.Crash("Char to wide char failed for newCmd");
}
- free(newCmd);
+ free(newCmdWin);
if (CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
nullptr, &si, &pi)) {
+ // Close handles so it will be removed when terminated
CloseHandle(pi.hProcess);
CloseHandle(pi.hThread);
} else {
>From a36801e0f73c1f9fb33123d332b9bf20df3f4332 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 7 Dec 2023 17:24:24 +0000
Subject: [PATCH 25/34] clang-format
---
flang/include/flang/Runtime/execute.h | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/flang/include/flang/Runtime/execute.h b/flang/include/flang/Runtime/execute.h
index 913c525b4fb8ad..be111c37c2e448 100644
--- a/flang/include/flang/Runtime/execute.h
+++ b/flang/include/flang/Runtime/execute.h
@@ -21,10 +21,10 @@ extern "C" {
// 16.9.83 EXECUTE_COMMAND_LINE
// Execute a command line.
// Returns a EXITSTAT, CMDSTAT, and CMDMSG as described in the standard.
-void RTNAME(ExecuteCommandLine)(const Descriptor &command,
- bool wait = true, const Descriptor *exitstat = nullptr,
- const Descriptor *cmdstat = nullptr, const Descriptor *cmdmsg = nullptr,
- const char *sourceFile = nullptr, int line = 0);
+void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait = true,
+ const Descriptor *exitstat = nullptr, const Descriptor *cmdstat = nullptr,
+ const Descriptor *cmdmsg = nullptr, const char *sourceFile = nullptr,
+ int line = 0);
}
} // namespace Fortran::runtime
>From 990e7c2926b146dd2aa8abc364eb93a8e93e582f Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Tue, 12 Dec 2023 12:04:44 +0000
Subject: [PATCH 26/34] fix null-terminated if logic and minor fixes
---
flang/runtime/execute.cpp | 30 ++++++++++++++----------------
1 file changed, 14 insertions(+), 16 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 1d51d41503a01f..bd7e34314808c9 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -57,18 +57,16 @@ static bool IsValidIntDescriptor(const Descriptor *length) {
length->type().IsInteger() && typeCode && typeCode->second != 1;
}
-void CopyToDescriptor(const Descriptor &value, const char *rawValue,
- std::int64_t rawValueLength, std::size_t offset = 0) {
- std::int64_t toCopy{std::min(rawValueLength,
- static_cast<std::int64_t>(value.ElementBytes() - offset))};
-
+void CopyToDescriptor(
+ const Descriptor &value, const char *rawValue, std::size_t offset = 0) {
+ auto toCopy{std::min(std::strlen(rawValue), value.ElementBytes() - offset)};
std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
}
-void CheckAndCopyToDescriptor(const Descriptor *value, const char *rawValue,
- std::int64_t rawValueLength, std::size_t offset = 0) {
+void CheckAndCopyToDescriptor(
+ const Descriptor *value, const char *rawValue, std::size_t offset = 0) {
if (value) {
- CopyToDescriptor(*value, rawValue, rawValueLength, offset);
+ CopyToDescriptor(*value, rawValue, offset);
}
}
@@ -107,7 +105,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("Execution error with system status code: %d", status);
} else {
CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "Execution error", 15);
+ CopyToDescriptor(*cmdmsg, "Execution error");
}
}
#ifdef _WIN32
@@ -123,7 +121,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
"Invalid command quit with exit status code: %d", exitStatusVal);
} else {
CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "Invalid command line", 20);
+ CopyToDescriptor(*cmdmsg, "Invalid command line");
}
}
#if defined(WIFSIGNALED) && defined(WTERMSIG)
@@ -132,7 +130,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("killed by signal: %d", WTERMSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "killed by signal", 18);
+ CopyToDescriptor(*cmdmsg, "killed by signal");
}
}
#endif
@@ -142,7 +140,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "stopped by signal", 17);
+ CopyToDescriptor(*cmdmsg, "stopped by signal");
}
}
#endif
@@ -151,7 +149,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
const char *ensureNullTerminated(
const char *str, size_t length, Terminator &terminator) {
- if (length < strlen(str)) {
+ if (length <= strlen(str)) {
char *newCmd{(char *)malloc(length + 1)};
if (newCmd == NULL) {
terminator.Crash("Command not null-terminated, memory allocation failed "
@@ -175,7 +173,6 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
if (exitstat) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(exitstat));
- // If sync, assigned processor-dependent exit status. Otherwise unchanged
}
if (cmdstat) {
@@ -192,6 +189,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
// either wait is not specified or wait is true: synchronous mode
int status{std::system(newCmd)};
int exitStatusVal{TerminationCheck(status, cmdstat, cmdmsg, terminator)};
+ // If sync, assigned processor-dependent exit status. Otherwise unchanged
CheckAndStoreIntToDescriptor(exitstat, exitStatusVal, terminator);
} else {
// Asynchronous mode
@@ -232,7 +230,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CheckAndCopyToDescriptor(cmdmsg, "CreateProcess failed.", 21);
+ CheckAndCopyToDescriptor(cmdmsg, "CreateProcess failed.");
}
}
delete[] wcmd;
@@ -245,7 +243,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
terminator.Crash("Fork failed with pid: %d.", pid);
} else {
StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
- CheckAndCopyToDescriptor(cmdmsg, "Fork failed", 11);
+ CheckAndCopyToDescriptor(cmdmsg, "Fork failed");
}
} else if (pid == 0) {
int status{std::system(newCmd)};
>From dfac14203d11a7bcd50f8a653e227d1d459de336 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Wed, 13 Dec 2023 16:29:22 +0000
Subject: [PATCH 27/34] remove hard-coded SSA number from test
---
.../execute_command_line-optional.f90 | 66 +++++++++----------
.../Lower/Intrinsics/execute_command_line.f90 | 39 ++++++-----
2 files changed, 54 insertions(+), 51 deletions(-)
diff --git a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90 b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
index eef3b0ccabc09b..e51c0e5fca3004 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line-optional.f90
@@ -12,40 +12,40 @@ subroutine all_args_optional(command, isWait, exitVal, cmdVal, msg)
LOGICAL, OPTIONAL :: isWait
! Note: command is not optional in execute_command_line and must be present
call execute_command_line(command, isWait, exitVal, cmdVal, msg)
-! CHECK: %0 = fir.declare %[[cmdstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
-! CHECK-NEXT: %1:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %2 = fir.declare %1#0 typeparams %1#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcommand"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
-! CHECK-NEXT: %3 = fir.emboxchar %2, %1#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK-NEXT: %4 = fir.declare %[[exitstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
-! CHECK-NEXT: %5 = fir.declare %[[waitArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
-! CHECK-NEXT: %6:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %7 = fir.declare %6#0 typeparams %6#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEmsg"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
-! CHECK-NEXT: %8 = fir.emboxchar %7, %6#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
-! CHECK-NEXT: %9 = fir.is_present %5 : (!fir.ref<!fir.logical<4>>) -> i1
-! CHECK-NEXT: %10 = fir.is_present %4 : (!fir.ref<i32>) -> i1
-! CHECK-NEXT: %11 = fir.is_present %0 : (!fir.ref<i32>) -> i1
-! CHECK-NEXT: %12 = fir.is_present %8 : (!fir.boxchar<1>) -> i1
-! CHECK-NEXT: %13 = fir.embox %2 typeparams %1#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
-! CHECK-NEXT: %14 = fir.if %9 -> (!fir.logical<4>) {
-! CHECK-NEXT: %31 = fir.load %5 : !fir.ref<!fir.logical<4>>
-! CHECK-NEXT: fir.result %31 : !fir.logical<4>
+! CHECK: %[[cmdstatDeclare:.*]] = fir.declare %[[cmdstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandDeclare:.*]] = fir.declare %[[commandUnbox]]#0 typeparams %[[commandUnbox]]#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEcommand"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %[[commandBoxTemp:.*]] = fir.emboxchar %[[commandDeclare]], %[[commandUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %[[exitstatDeclare:.*]] = fir.declare %[[exitstatArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[waitDeclare:.*]] = fir.declare %[[waitArg]] {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[cmdmsgDeclare:.*]] = fir.declare %[[cmdmsgUnbox]]#0 typeparams %[[cmdmsgUnbox]]#1 {fortran_attrs = #fir.var_attrs<optional>, uniq_name = "_QFall_args_optionalEmsg"} : (!fir.ref<!fir.char<1,?>>, index) -> !fir.ref<!fir.char<1,?>>
+! CHECK-NEXT: %[[cmdmsgBoxTemp:.*]] = fir.emboxchar %[[cmdmsgDeclare]], %[[cmdmsgUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK-NEXT: %[[waitIsPresent:.*]] = fir.is_present %[[waitDeclare]] : (!fir.ref<!fir.logical<4>>) -> i1
+! CHECK-NEXT: %[[exitstatIsPresent:.*]] = fir.is_present %[[exitstatDeclare]] : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %[[cmdstatIsPresent:.*]] = fir.is_present %[[cmdstatDeclare]] : (!fir.ref<i32>) -> i1
+! CHECK-NEXT: %[[cmdmsgIsPresent:.*]] = fir.is_present %[[cmdmsgBoxTemp]] : (!fir.boxchar<1>) -> i1
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]] typeparams %[[commandUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[waitLoaded:.*]] = fir.if %[[waitIsPresent]] -> (!fir.logical<4>) {
+! CHECK-NEXT: %[[VAL_31:.*]] = fir.load %[[waitDeclare]] : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: fir.result %[[VAL_31]] : !fir.logical<4>
! CHECK-NEXT: } else {
-! CHECK-NEXT: %31 = fir.convert %false : (i1) -> !fir.logical<4>
-! CHECK-NEXT: fir.result %31 : !fir.logical<4>
+! CHECK-NEXT: %[[VAL_31:.*]] = fir.convert %false : (i1) -> !fir.logical<4>
+! CHECK-NEXT: fir.result %[[VAL_31]] : !fir.logical<4>
! CHECK-NEXT: }
-! CHECK-NEXT: %15 = fir.embox %4 : (!fir.ref<i32>) -> !fir.box<i32>
-! CHECK-NEXT: %16 = fir.absent !fir.box<i32>
-! CHECK-NEXT: %17 = arith.select %10, %15, %16 : !fir.box<i32>
-! CHECK-NEXT: %18 = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
-! CHECK-NEXT: %19 = arith.select %11, %18, %16 : !fir.box<i32>
-! CHECK-NEXT: %20 = fir.embox %7 typeparams %6#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
-! CHECK-NEXT: %21 = fir.absent !fir.box<!fir.char<1,?>>
-! CHECK-NEXT: %22 = arith.select %12, %20, %21 : !fir.box<!fir.char<1,?>>
-! CHECK: %24 = fir.convert %13 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK-NEXT: %25 = fir.convert %14 : (!fir.logical<4>) -> i1
-! CHECK-NEXT: %26 = fir.convert %17 : (!fir.box<i32>) -> !fir.box<none>
-! CHECK-NEXT: %27 = fir.convert %19 : (!fir.box<i32>) -> !fir.box<none>
-! CHECK-NEXT: %28 = fir.convert %22 : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
-! CHECK: %30 = fir.call @_FortranAExecuteCommandLine(%24, %25, %26, %27, %28, %29, %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: %[[exitstatArgBox:.*]] = fir.embox %[[exitstatDeclare]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[absentBoxi32:.*]] = fir.absent !fir.box<i32>
+! CHECK-NEXT: %[[exitstatBox:.*]] = arith.select %[[exitstatIsPresent]], %[[exitstatArgBox]], %[[absentBoxi32]] : !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatArgBox:.*]] = fir.embox %[[cmdstatDeclare]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatBox:.*]] = arith.select %[[cmdstatIsPresent]], %[[cmdstatArgBox]], %[[absentBoxi32]] : !fir.box<i32>
+! CHECK-NEXT: %[[cmdmsgArgBox:.*]] = fir.embox %[[cmdmsgDeclare]] typeparams %[[cmdmsgUnbox]]#1 : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[absentBox:.*]] = fir.absent !fir.box<!fir.char<1,?>>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = arith.select %[[cmdmsgIsPresent]], %[[cmdmsgArgBox]], %[[absentBox]] : !fir.box<!fir.char<1,?>>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
+! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
+! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,?>>) -> !fir.box<none>
+! CHECK: %[[VAL_30:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %[[VAL_29:.*]], %c14_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine all_args_optional
diff --git a/flang/test/Lower/Intrinsics/execute_command_line.f90 b/flang/test/Lower/Intrinsics/execute_command_line.f90
index 3d6d4c1ed8fe2a..1b65bbd5e1550c 100644
--- a/flang/test/Lower/Intrinsics/execute_command_line.f90
+++ b/flang/test/Lower/Intrinsics/execute_command_line.f90
@@ -11,26 +11,26 @@ subroutine all_args(command, isWait, exitVal, cmdVal, msg)
INTEGER :: exitVal, cmdVal
LOGICAL :: isWait
call execute_command_line(command, isWait, exitVal, cmdVal, msg)
-! CHECK: %0 = fir.declare %[[cmdstatArg]] {uniq_name = "_QFall_argsEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK: %[[cmdstatsDeclear:.*]] = fir.declare %[[cmdstatArg]] {uniq_name = "_QFall_argsEcmdval"} : (!fir.ref<i32>) -> !fir.ref<i32>
! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[commandArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %3 = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %4 = fir.declare %[[exitstatArg]] {uniq_name = "_QFall_argsEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
-! CHECK-NEXT: %5 = fir.declare %[[waitArg]] {uniq_name = "_QFall_argsEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[commandDeclear:.*]] = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFall_argsEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[exitstatDeclear:.*]] = fir.declare %[[exitstatArg]] {uniq_name = "_QFall_argsEexitval"} : (!fir.ref<i32>) -> !fir.ref<i32>
+! CHECK-NEXT: %[[waitDeclear:.*]] = fir.declare %[[waitArg]] {uniq_name = "_QFall_argsEiswait"} : (!fir.ref<!fir.logical<4>>) -> !fir.ref<!fir.logical<4>>
! CHECK-NEXT: %[[cmdmsgUnbox:.*]]:2 = fir.unboxchar %[[cmdmsgArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
! CHECK-NEXT: %[[cmdmsgCast:.*]] = fir.convert %[[cmdmsgUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %8 = fir.declare %[[cmdmsgCast]] typeparams %c30 {uniq_name = "_QFall_argsEmsg"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %3 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
-! CHECK-NEXT: %[[waitLoaded:.*]] = fir.load %5 : !fir.ref<!fir.logical<4>>
-! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %4 : (!fir.ref<i32>) -> !fir.box<i32>
-! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %0 : (!fir.ref<i32>) -> !fir.box<i32>
-! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %8 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[cmdmsgDeclear:.*]] = fir.declare %[[cmdmsgCast]] typeparams %c30 {uniq_name = "_QFall_argsEmsg"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclear]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[waitLoaded:.*]] = fir.load %[[waitDeclear]] : !fir.ref<!fir.logical<4>>
+! CHECK-NEXT: %[[exitstatBox:.*]] = fir.embox %[[exitstatDeclear]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdstatBox:.*]] = fir.embox %[[cmdstatsDeclear]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK-NEXT: %[[cmdmsgBox:.*]] = fir.embox %[[cmdmsgDeclear]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
! CHECK-NEXT: %[[wait:.*]] = fir.convert %[[waitLoaded]] : (!fir.logical<4>) -> i1
! CHECK-NEXT: %[[exitstat:.*]] = fir.convert %[[exitstatBox]] : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdstat:.*]] = fir.convert %[[cmdstatBox]] : (!fir.box<i32>) -> !fir.box<none>
! CHECK-NEXT: %[[cmdmsg:.*]] = fir.convert %[[cmdmsgBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
-! CHECK: %21 = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %20, %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %[[wait]], %[[exitstat]], %[[cmdstat]], %[[cmdmsg]], %[[VAL_20:.*]], %c13_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine all_args
@@ -39,12 +39,15 @@ end subroutine all_args
subroutine only_command_default_wait_true(command)
CHARACTER(30) :: command
call execute_command_line(command)
-! CHECK: %0:2 = fir.unboxchar %[[cmdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
-! CHECK-NEXT: %1 = fir.convert %0#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %2 = fir.declare %1 typeparams %c30 {uniq_name = "_QFonly_command_default_wait_trueEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
-! CHECK-NEXT: %3 = fir.embox %2 : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
-! CHECK-NEXT: %4 = fir.absent !fir.box<none>
-! CHECK: %6 = fir.convert %3 : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
-! CHECK: %8 = fir.call @_FortranAExecuteCommandLine(%6, %true, %4, %4, %4, %7, %c41_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK-NEXT: %c41_i32 = arith.constant 41 : i32
+! CHECK-NEXT: %true = arith.constant true
+! CHECK-NEXT: %c30 = arith.constant 30 : index
+! CHECK-NEXT: %[[commandUnbox:.*]]:2 = fir.unboxchar %[[cmdArg]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+! CHECK-NEXT: %[[commandCast:.*]] = fir.convert %[[commandUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandDeclare:.*]] = fir.declare %[[commandCast]] typeparams %c30 {uniq_name = "_QFonly_command_default_wait_trueEcommand"} : (!fir.ref<!fir.char<1,30>>, index) -> !fir.ref<!fir.char<1,30>>
+! CHECK-NEXT: %[[commandBox:.*]] = fir.embox %[[commandDeclare]] : (!fir.ref<!fir.char<1,30>>) -> !fir.box<!fir.char<1,30>>
+! CHECK-NEXT: %[[absent:.*]] = fir.absent !fir.box<none>
+! CHECK: %[[command:.*]] = fir.convert %[[commandBox]] : (!fir.box<!fir.char<1,30>>) -> !fir.box<none>
+! CHECK: %[[VAL_21:.*]] = fir.call @_FortranAExecuteCommandLine(%[[command]], %true, %[[absent]], %[[absent]], %[[absent]], %[[VAL_7:.*]], %c41_i32) fastmath<contract> : (!fir.box<none>, i1, !fir.box<none>, !fir.box<none>, !fir.box<none>, !fir.ref<i8>, i32) -> none
! CHECK-NEXT: return
end subroutine only_command_default_wait_true
>From bc6aef871fc941de59c14813dc44bb2cfb462705 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 14 Dec 2023 14:56:21 +0000
Subject: [PATCH 28/34] move EnsureNullTerminated to tools.h, free memory after
use.
On Linux, malloc is freed in parent, child process will be cleaned up on termination.
Same approach was taken on Windows as well, but does it work in the same way?
---
flang/runtime/execute.cpp | 36 ++++++++----------------------------
flang/runtime/tools.h | 12 ++++++++++++
2 files changed, 20 insertions(+), 28 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index bd7e34314808c9..07b09c90f5d9e8 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -147,28 +147,11 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
return exitStatusVal;
}
-const char *ensureNullTerminated(
- const char *str, size_t length, Terminator &terminator) {
- if (length <= strlen(str)) {
- char *newCmd{(char *)malloc(length + 1)};
- if (newCmd == NULL) {
- terminator.Crash("Command not null-terminated, memory allocation failed "
- "for null-terminated newCmd.");
- }
-
- strncpy(newCmd, str, length);
- newCmd[length] = '\0';
- return newCmd;
- } else {
- return str;
- }
-}
-
void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
const Descriptor *exitstat, const Descriptor *cmdstat,
const Descriptor *cmdmsg, const char *sourceFile, int line) {
Terminator terminator{sourceFile, line};
- const char *newCmd{ensureNullTerminated(
+ const char *newCmd{EnsureNullTerminated(
command.OffsetElement(), command.ElementBytes(), terminator)};
if (exitstat) {
@@ -202,14 +185,10 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
// append "cmd.exe /c " to the beginning of command
const char *prefix{"cmd.exe /c "};
- char *newCmdWin{
- (char *)malloc(std::strlen(prefix) + std::strlen(newCmd) + 1)};
- if (newCmd != NULL) {
- std::strcpy(newCmdWin, prefix);
- std::strcat(newCmdWin, newCmd);
- } else {
- terminator.Crash("Memory allocation failed for newCmd");
- }
+ char *newCmdWin{(char *)AllocateMemoryOrCrash(
+ terminator, std::strlen(prefix) + std::strlen(newCmd) + 1)};
+ std::strcpy(newCmdWin, prefix);
+ std::strcat(newCmdWin, newCmd);
// Convert the char to wide char
const size_t sizeNeeded{mbstowcs(NULL, newCmdWin, 0) + 1};
@@ -217,7 +196,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
if (std::mbstowcs(wcmd, newCmdWin, sizeNeeded) == static_cast<size_t>(-1)) {
terminator.Crash("Char to wide char failed for newCmd");
}
- free(newCmdWin);
+ FreeMemory((void *)newCmdWin);
if (CreateProcess(nullptr, wcmd, nullptr, nullptr, FALSE, 0, nullptr,
nullptr, &si, &pi)) {
@@ -233,7 +212,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
CheckAndCopyToDescriptor(cmdmsg, "CreateProcess failed.");
}
}
- delete[] wcmd;
+ FreeMemory((void *)wcmd);
#else
// terminated children do not become zombies
signal(SIGCHLD, SIG_IGN);
@@ -251,6 +230,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
exit(status);
}
#endif
+ FreeMemory((void *)newCmd);
}
}
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index ea659190e14391..735acad728422b 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -411,5 +411,17 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from,
bool toIsContiguous, bool fromIsContiguous);
RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
+inline RT_API_ATTRS const char *EnsureNullTerminated(
+ const char *str, size_t length, Terminator &terminator) {
+ if (length <= std::strlen(str)) {
+ char *newCmd{(char *)AllocateMemoryOrCrash(terminator, length + 1)};
+ std::memcpy(newCmd, str, length);
+ newCmd[length] = '\0';
+ return newCmd;
+ } else {
+ return str;
+ }
+}
+
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_TOOLS_H_
>From 438362d74d7ac9cc74645714afc20ab9b3616385 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 14 Dec 2023 16:41:50 +0000
Subject: [PATCH 29/34] move StoreToDescriptor functions to tools.h
---
flang/runtime/command.cpp | 120 ++------------------------------
flang/runtime/execute.cpp | 65 ++----------------
flang/runtime/tools.cpp | 140 ++++++++++++++++++++++++++++++++++++++
flang/runtime/tools.h | 50 +++++++++++---
4 files changed, 191 insertions(+), 184 deletions(-)
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index 8e6135b5487c05..b7460b1b635830 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -39,106 +39,6 @@ std::int32_t RTNAME(ArgumentCount)() {
pid_t RTNAME(GetPID)() { return getpid(); }
-// Returns the length of the \p string. Assumes \p string is valid.
-static std::int64_t StringLength(const char *string) {
- std::size_t length{std::strlen(string)};
- if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
- return static_cast<std::int64_t>(length);
- } else {
- std::size_t max{std::numeric_limits<std::int64_t>::max()};
- return length > max ? 0 // Just fail.
- : static_cast<std::int64_t>(length);
- }
-}
-
-static bool IsValidCharDescriptor(const Descriptor *value) {
- return value && value->IsAllocated() &&
- value->type() == TypeCode(TypeCategory::Character, 1) &&
- value->rank() == 0;
-}
-
-static bool IsValidIntDescriptor(const Descriptor *length) {
- auto typeCode{length->type().GetCategoryAndKind()};
- // Check that our descriptor is allocated and is a scalar integer with
- // kind != 1 (i.e. with a large enough decimal exponent range).
- return length->IsAllocated() && length->rank() == 0 &&
- length->type().IsInteger() && typeCode && typeCode->second != 1;
-}
-
-static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
- if (offset < value.ElementBytes()) {
- std::memset(
- value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
- }
-}
-
-static std::int32_t CopyToDescriptor(const Descriptor &value,
- const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
- std::size_t offset = 0) {
-
- std::int64_t toCopy{std::min(rawValueLength,
- static_cast<std::int64_t>(value.ElementBytes() - offset))};
- if (toCopy < 0) {
- return ToErrmsg(errmsg, StatValueTooShort);
- }
-
- std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
-
- if (rawValueLength > toCopy) {
- return ToErrmsg(errmsg, StatValueTooShort);
- }
-
- return StatOk;
-}
-
-static std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
- const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
- bool haveValue{IsValidCharDescriptor(value)};
-
- std::int64_t len{StringLength(rawValue)};
- if (len <= 0) {
- if (haveValue) {
- FillWithSpaces(*value);
- }
- return ToErrmsg(errmsg, StatMissingArgument);
- }
-
- std::int32_t stat{StatOk};
- if (haveValue) {
- stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
- }
-
- offset += len;
- return stat;
-}
-
-static void StoreLengthToDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
- kind, terminator, *length, /* atIndex = */ 0, value);
-}
-
-template <int KIND> struct FitsInIntegerKind {
- bool operator()([[maybe_unused]] std::int64_t value) {
- if constexpr (KIND >= 8) {
- return true;
- } else {
- return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
- Fortran::common::TypeCategory::Integer, KIND>>::max();
- }
- }
-};
-
-static bool FitsInDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
- kind, terminator, value);
-}
-
std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
int line) {
@@ -152,7 +52,7 @@ std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
if (n < 0 || n >= executionEnvironment.argc) {
@@ -166,7 +66,7 @@ std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
}
if (length && FitsInDescriptor(length, argLen, terminator)) {
- StoreLengthToDescriptor(length, argLen, terminator);
+ StoreIntToDescriptor(length, argLen, terminator);
}
if (value) {
@@ -188,7 +88,7 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
auto shouldContinue = [&](std::int32_t stat) -> bool {
@@ -225,7 +125,7 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
}
if (length && FitsInDescriptor(length, offset, terminator)) {
- StoreLengthToDescriptor(length, offset, terminator);
+ StoreIntToDescriptor(length, offset, terminator);
}
// value += spaces for padding
@@ -236,14 +136,6 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
return stat;
}
-static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
- std::size_t s{d.ElementBytes() - 1};
- while (*d.OffsetElement(s) == ' ') {
- --s;
- }
- return s + 1;
-}
-
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) {
@@ -257,7 +149,7 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
// Store 0 in case we error out later on.
if (length) {
RUNTIME_CHECK(terminator, IsValidIntDescriptor(length));
- StoreLengthToDescriptor(length, 0, terminator);
+ StoreIntToDescriptor(length, 0, terminator);
}
const char *rawValue{nullptr};
@@ -273,7 +165,7 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
std::int64_t varLen{StringLength(rawValue)};
if (length && FitsInDescriptor(length, varLen, terminator)) {
- StoreLengthToDescriptor(length, varLen, terminator);
+ StoreIntToDescriptor(length, varLen, terminator);
}
if (value) {
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 07b09c90f5d9e8..b217c777aa9a64 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -43,59 +43,6 @@ enum CMD_STAT {
SIGNAL_ERR = 4
};
-static bool IsValidCharDescriptor(const Descriptor *value) {
- return value && value->IsAllocated() &&
- value->type() == TypeCode(TypeCategory::Character, 1) &&
- value->rank() == 0;
-}
-
-static bool IsValidIntDescriptor(const Descriptor *length) {
- auto typeCode{length->type().GetCategoryAndKind()};
- // Check that our descriptor is allocated and is a scalar integer with
- // kind != 1 (i.e. with a large enough decimal exponent range).
- return length->IsAllocated() && length->rank() == 0 &&
- length->type().IsInteger() && typeCode && typeCode->second != 1;
-}
-
-void CopyToDescriptor(
- const Descriptor &value, const char *rawValue, std::size_t offset = 0) {
- auto toCopy{std::min(std::strlen(rawValue), value.ElementBytes() - offset)};
- std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
-}
-
-void CheckAndCopyToDescriptor(
- const Descriptor *value, const char *rawValue, std::size_t offset = 0) {
- if (value) {
- CopyToDescriptor(*value, rawValue, offset);
- }
-}
-
-static void StoreIntToDescriptor(
- const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
- auto typeCode{intVal->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- Fortran::runtime::ApplyIntegerKind<Fortran::runtime::StoreIntegerAt, void>(
- kind, terminator, *intVal, /* atIndex = */ 0, value);
-}
-
-static void CheckAndStoreIntToDescriptor(
- const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
- if (intVal) {
- StoreIntToDescriptor(intVal, value, terminator);
- }
-}
-
-template <int KIND> struct FitsInIntegerKind {
- bool operator()([[maybe_unused]] std::int64_t value) {
- if constexpr (KIND >= 8) {
- return true;
- } else {
- return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
- Fortran::common::TypeCategory::Integer, KIND>>::max();
- }
- }
-};
-
// If a condition occurs that would assign a nonzero value to CMDSTAT but
// the CMDSTAT variable is not present, error termination is initiated.
int TerminationCheck(int status, const Descriptor *cmdstat,
@@ -105,7 +52,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("Execution error with system status code: %d", status);
} else {
CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "Execution error");
+ CopyCharToDescriptor(*cmdmsg, "Execution error");
}
}
#ifdef _WIN32
@@ -121,7 +68,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
"Invalid command quit with exit status code: %d", exitStatusVal);
} else {
CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "Invalid command line");
+ CopyCharToDescriptor(*cmdmsg, "Invalid command line");
}
}
#if defined(WIFSIGNALED) && defined(WTERMSIG)
@@ -130,7 +77,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("killed by signal: %d", WTERMSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "killed by signal");
+ CopyCharToDescriptor(*cmdmsg, "killed by signal");
}
}
#endif
@@ -140,7 +87,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyToDescriptor(*cmdmsg, "stopped by signal");
+ CopyCharToDescriptor(*cmdmsg, "stopped by signal");
}
}
#endif
@@ -209,7 +156,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CheckAndCopyToDescriptor(cmdmsg, "CreateProcess failed.");
+ CheckAndCopyCharToDescriptor(cmdmsg, "CreateProcess failed.");
}
}
FreeMemory((void *)wcmd);
@@ -222,7 +169,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
terminator.Crash("Fork failed with pid: %d.", pid);
} else {
StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
- CheckAndCopyToDescriptor(cmdmsg, "Fork failed");
+ CheckAndCopyCharToDescriptor(cmdmsg, "Fork failed");
}
} else if (pid == 0) {
int status{std::system(newCmd)};
diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp
index a027559d9f4a74..b8af4f113fed2a 100644
--- a/flang/runtime/tools.cpp
+++ b/flang/runtime/tools.cpp
@@ -173,5 +173,145 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from) {
ShallowCopy(to, from, to.IsContiguous(), from.IsContiguous());
}
+RT_API_ATTRS const char *EnsureNullTerminated(
+ const char *str, size_t length, Terminator &terminator) {
+ if (length <= std::strlen(str)) {
+ char *newCmd{(char *)AllocateMemoryOrCrash(terminator, length + 1)};
+ std::memcpy(newCmd, str, length);
+ newCmd[length] = '\0';
+ return newCmd;
+ } else {
+ return str;
+ }
+}
+
+RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
+ std::size_t s{d.ElementBytes() - 1};
+ while (*d.OffsetElement(s) == ' ') {
+ --s;
+ }
+ return s + 1;
+}
+
+// Returns the length of the \p string. Assumes \p string is valid.
+RT_API_ATTRS std::int64_t StringLength(const char *string) {
+ std::size_t length{std::strlen(string)};
+ if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
+ return static_cast<std::int64_t>(length);
+ } else {
+ std::size_t max{std::numeric_limits<std::int64_t>::max()};
+ return length > max ? 0 // Just fail.
+ : static_cast<std::int64_t>(length);
+ }
+}
+
+RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value) {
+ return value && value->IsAllocated() &&
+ value->type() == TypeCode(TypeCategory::Character, 1) &&
+ value->rank() == 0;
+}
+
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *length) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ // Check that our descriptor is allocated and is a scalar integer with
+ // kind != 1 (i.e. with a large enough decimal exponent range).
+ return length->IsAllocated() && length->rank() == 0 &&
+ length->type().IsInteger() && typeCode && typeCode->second != 1;
+}
+
+RT_API_ATTRS void FillWithSpaces(const Descriptor &value, std::size_t offset) {
+ if (offset < value.ElementBytes()) {
+ std::memset(
+ value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
+ }
+}
+
+RT_API_ATTRS std::int32_t CopyToDescriptor(const Descriptor &value,
+ const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
+ std::size_t offset) {
+
+ std::int64_t toCopy{std::min(rawValueLength,
+ static_cast<std::int64_t>(value.ElementBytes() - offset))};
+ if (toCopy < 0) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+
+ if (rawValueLength > toCopy) {
+ return ToErrmsg(errmsg, StatValueTooShort);
+ }
+
+ return StatOk;
+}
+
+RT_API_ATTRS void CopyCharToDescriptor(
+ const Descriptor &value, const char *rawValue, std::size_t offset) {
+ auto toCopy{std::min(std::strlen(rawValue), value.ElementBytes() - offset)};
+ std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
+}
+
+RT_API_ATTRS std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
+ const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
+ bool haveValue{IsValidCharDescriptor(value)};
+
+ std::int64_t len{StringLength(rawValue)};
+ if (len <= 0) {
+ if (haveValue) {
+ FillWithSpaces(*value);
+ }
+ return ToErrmsg(errmsg, StatMissingArgument);
+ }
+
+ std::int32_t stat{StatOk};
+ if (haveValue) {
+ stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
+ }
+
+ offset += len;
+ return stat;
+}
+
+RT_API_ATTRS void CheckAndCopyCharToDescriptor(
+ const Descriptor *value, const char *rawValue, std::size_t offset) {
+ if (value) {
+ CopyCharToDescriptor(*value, rawValue, offset);
+ }
+}
+
+RT_API_ATTRS void StoreIntToDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ ApplyIntegerKind<StoreIntegerAt, void>(
+ kind, terminator, *length, /* atIndex = */ 0, value);
+}
+
+RT_API_ATTRS void CheckAndStoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
+ if (intVal) {
+ StoreIntToDescriptor(intVal, value, terminator);
+ }
+}
+
+template <int KIND> struct FitsInIntegerKind {
+ RT_API_ATTRS bool operator()([[maybe_unused]] std::int64_t value) {
+ if constexpr (KIND >= 8) {
+ return true;
+ } else {
+ return value <=
+ std::numeric_limits<
+ CppTypeFor<Fortran::common::TypeCategory::Integer, KIND>>::max();
+ }
+ }
+};
+
+RT_API_ATTRS bool FitsInDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ return ApplyIntegerKind<FitsInIntegerKind, bool>(kind, terminator, value);
+}
+
RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 735acad728422b..2fbad409a8ee4f 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -10,6 +10,7 @@
#define FORTRAN_RUNTIME_TOOLS_H_
#include "freestanding-tools.h"
+#include "stat.h"
#include "terminator.h"
#include "flang/Runtime/cpp-type.h"
#include "flang/Runtime/descriptor.h"
@@ -411,17 +412,44 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from,
bool toIsContiguous, bool fromIsContiguous);
RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
-inline RT_API_ATTRS const char *EnsureNullTerminated(
- const char *str, size_t length, Terminator &terminator) {
- if (length <= std::strlen(str)) {
- char *newCmd{(char *)AllocateMemoryOrCrash(terminator, length + 1)};
- std::memcpy(newCmd, str, length);
- newCmd[length] = '\0';
- return newCmd;
- } else {
- return str;
- }
-}
+RT_API_ATTRS const char *EnsureNullTerminated(
+ const char *str, size_t length, Terminator &terminator);
+
+RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d);
+
+// Returns the length of the \p string. Assumes \p string is valid.
+RT_API_ATTRS std::int64_t StringLength(const char *string);
+
+RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value);
+
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *length);
+
+RT_API_ATTRS void FillWithSpaces(
+ const Descriptor &value, std::size_t offset = 0);
+
+RT_API_ATTRS std::int32_t CopyToDescriptor(const Descriptor &value,
+ const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
+ std::size_t offset = 0);
+
+void CopyCharToDescriptor(
+ const Descriptor &value, const char *rawValue, std::size_t offset = 0);
+
+RT_API_ATTRS std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
+ const char *rawValue, const Descriptor *errmsg, std::size_t &offset);
+
+RT_API_ATTRS void CheckAndCopyCharToDescriptor(
+ const Descriptor *value, const char *rawValue, std::size_t offset = 0);
+
+RT_API_ATTRS void StoreIntToDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator);
+
+RT_API_ATTRS void CheckAndStoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator);
+
+template <int KIND> struct FitsInIntegerKind;
+
+RT_API_ATTRS bool FitsInDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator);
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_TOOLS_H_
>From f0cf3c560877c23c9326902a307e4fae2f3f7634 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Fri, 15 Dec 2023 15:12:00 +0000
Subject: [PATCH 30/34] minor fixes in tools and move memory deallocate to
bottom.
---
flang/runtime/execute.cpp | 2 +-
flang/runtime/tools.cpp | 20 ++++++++------------
flang/runtime/tools.h | 5 ++++-
3 files changed, 13 insertions(+), 14 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index b217c777aa9a64..b8000726af6411 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -177,8 +177,8 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
exit(status);
}
#endif
- FreeMemory((void *)newCmd);
}
+ FreeMemory((void *)newCmd);
}
} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp
index b8af4f113fed2a..5348fdf7417723 100644
--- a/flang/runtime/tools.cpp
+++ b/flang/runtime/tools.cpp
@@ -195,30 +195,26 @@ RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
// Returns the length of the \p string. Assumes \p string is valid.
RT_API_ATTRS std::int64_t StringLength(const char *string) {
- std::size_t length{std::strlen(string)};
- if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
- return static_cast<std::int64_t>(length);
- } else {
- std::size_t max{std::numeric_limits<std::int64_t>::max()};
- return length > max ? 0 // Just fail.
- : static_cast<std::int64_t>(length);
- }
+ return static_cast<std::int64_t>(std::strlen(string));
}
+// Assumes Descriptor \p value is not nullptr.
RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value) {
return value && value->IsAllocated() &&
value->type() == TypeCode(TypeCategory::Character, 1) &&
value->rank() == 0;
}
-RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *length) {
- auto typeCode{length->type().GetCategoryAndKind()};
+// Assumes Descriptor \p intVal is not nullptr.
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal) {
+ auto typeCode{intVal->type().GetCategoryAndKind()};
// Check that our descriptor is allocated and is a scalar integer with
// kind != 1 (i.e. with a large enough decimal exponent range).
- return length->IsAllocated() && length->rank() == 0 &&
- length->type().IsInteger() && typeCode && typeCode->second != 1;
+ return intVal->IsAllocated() && intVal->rank() == 0 &&
+ intVal->type().IsInteger() && typeCode && typeCode->second != 1;
}
+// Assume Descriptor \p value is valid: pass IsValidCharDescriptor check.
RT_API_ATTRS void FillWithSpaces(const Descriptor &value, std::size_t offset) {
if (offset < value.ElementBytes()) {
std::memset(
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 2fbad409a8ee4f..3576db598f01c8 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -420,10 +420,13 @@ RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d);
// Returns the length of the \p string. Assumes \p string is valid.
RT_API_ATTRS std::int64_t StringLength(const char *string);
+// Assumes Descriptor \p value is not nullptr.
RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value);
-RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *length);
+// Assumes Descriptor \p intVal is not nullptr.
+RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal);
+// Assume Descriptor \p value is valid: pass IsValidCharDescriptor check.
RT_API_ATTRS void FillWithSpaces(
const Descriptor &value, std::size_t offset = 0);
>From d2242c748ff9fa79830ae7d434317be67166d6d2 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 21 Dec 2023 12:46:04 +0000
Subject: [PATCH 31/34] clang-format
---
flang/include/flang/Optimizer/Builder/Runtime/Execute.h | 3 ++-
flang/runtime/tools.h | 1 +
2 files changed, 3 insertions(+), 1 deletion(-)
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
index f660419d703041..a1e6ef20876049 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Execute.h
@@ -22,7 +22,8 @@ namespace fir::runtime {
/// Generate a call to the ExecuteCommandLine runtime function which implements
/// the GET_EXECUTE_ARGUMENT intrinsic.
-/// \p wait, \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
+/// \p wait must be bool that can be absent.
+/// \p exitstat, \p cmdstat and \p cmdmsg must be fir.box that can be
/// absent (but not null mlir values). The status exitstat and cmdstat are
/// returned, along with the message cmdmsg.
void genExecuteCommandLine(fir::FirOpBuilder &, mlir::Location,
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 43d525f320bd75..25fc443b6e0da0 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -453,6 +453,7 @@ template <int KIND> struct FitsInIntegerKind;
RT_API_ATTRS bool FitsInDescriptor(
const Descriptor *length, std::int64_t value, Terminator &terminator);
+
// Defines a utility function for copying and padding characters
template <typename TO, typename FROM>
RT_API_ATTRS void CopyAndPad(
>From 573ac29a132a6efd30548bb3a726385299c6fb6c Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 21 Dec 2023 16:10:09 +0000
Subject: [PATCH 32/34] Revert "move StoreToDescriptor functions to tools.h"
This reverts commit 438362d74d7ac9cc74645714afc20ab9b3616385.
---
flang/runtime/command.cpp | 79 ++++++++++++++++++++++++++++++++++++---
flang/runtime/execute.cpp | 31 ++++++++++++---
flang/runtime/tools.cpp | 79 ++-------------------------------------
flang/runtime/tools.h | 48 ++++++------------------
4 files changed, 114 insertions(+), 123 deletions(-)
diff --git a/flang/runtime/command.cpp b/flang/runtime/command.cpp
index b7460b1b635830..7c44890545bd3f 100644
--- a/flang/runtime/command.cpp
+++ b/flang/runtime/command.cpp
@@ -39,6 +39,65 @@ std::int32_t RTNAME(ArgumentCount)() {
pid_t RTNAME(GetPID)() { return getpid(); }
+// Returns the length of the \p string. Assumes \p string is valid.
+static std::int64_t StringLength(const char *string) {
+ std::size_t length{std::strlen(string)};
+ if constexpr (sizeof(std::size_t) < sizeof(std::int64_t)) {
+ return static_cast<std::int64_t>(length);
+ } else {
+ std::size_t max{std::numeric_limits<std::int64_t>::max()};
+ return length > max ? 0 // Just fail.
+ : static_cast<std::int64_t>(length);
+ }
+}
+
+static void FillWithSpaces(const Descriptor &value, std::size_t offset = 0) {
+ if (offset < value.ElementBytes()) {
+ std::memset(
+ value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
+ }
+}
+
+static std::int32_t CheckAndCopyCharsToDescriptor(const Descriptor *value,
+ const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
+ bool haveValue{IsValidCharDescriptor(value)};
+
+ std::int64_t len{StringLength(rawValue)};
+ if (len <= 0) {
+ if (haveValue) {
+ FillWithSpaces(*value);
+ }
+ return ToErrmsg(errmsg, StatMissingArgument);
+ }
+
+ std::int32_t stat{StatOk};
+ if (haveValue) {
+ stat = CopyCharsToDescriptor(*value, rawValue, len, errmsg, offset);
+ }
+
+ offset += len;
+ return stat;
+}
+
+template <int KIND> struct FitsInIntegerKind {
+ bool operator()([[maybe_unused]] std::int64_t value) {
+ if constexpr (KIND >= 8) {
+ return true;
+ } else {
+ return value <= std::numeric_limits<Fortran::runtime::CppTypeFor<
+ Fortran::common::TypeCategory::Integer, KIND>>::max();
+ }
+ }
+};
+
+static bool FitsInDescriptor(
+ const Descriptor *length, std::int64_t value, Terminator &terminator) {
+ auto typeCode{length->type().GetCategoryAndKind()};
+ int kind{typeCode->second};
+ return Fortran::runtime::ApplyIntegerKind<FitsInIntegerKind, bool>(
+ kind, terminator, value);
+}
+
std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
const Descriptor *length, const Descriptor *errmsg, const char *sourceFile,
int line) {
@@ -70,7 +129,7 @@ std::int32_t RTNAME(GetCommandArgument)(std::int32_t n, const Descriptor *value,
}
if (value) {
- return CopyToDescriptor(*value, arg, argLen, errmsg);
+ return CopyCharsToDescriptor(*value, arg, argLen, errmsg);
}
return StatOk;
@@ -100,11 +159,11 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
std::size_t offset{0};
if (executionEnvironment.argc == 0) {
- return CheckAndCopyToDescriptor(value, "", errmsg, offset);
+ return CheckAndCopyCharsToDescriptor(value, "", errmsg, offset);
}
// value = argv[0]
- std::int32_t stat{CheckAndCopyToDescriptor(
+ std::int32_t stat{CheckAndCopyCharsToDescriptor(
value, executionEnvironment.argv[0], errmsg, offset)};
if (!shouldContinue(stat)) {
return stat;
@@ -112,12 +171,12 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
// value += " " + argv[1:n]
for (std::int32_t i{1}; i < executionEnvironment.argc; ++i) {
- stat = CheckAndCopyToDescriptor(value, " ", errmsg, offset);
+ stat = CheckAndCopyCharsToDescriptor(value, " ", errmsg, offset);
if (!shouldContinue(stat)) {
return stat;
}
- stat = CheckAndCopyToDescriptor(
+ stat = CheckAndCopyCharsToDescriptor(
value, executionEnvironment.argv[i], errmsg, offset);
if (!shouldContinue(stat)) {
return stat;
@@ -136,6 +195,14 @@ std::int32_t RTNAME(GetCommand)(const Descriptor *value,
return stat;
}
+static std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
+ std::size_t s{d.ElementBytes() - 1};
+ while (*d.OffsetElement(s) == ' ') {
+ --s;
+ }
+ return s + 1;
+}
+
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) {
@@ -169,7 +236,7 @@ std::int32_t RTNAME(GetEnvVariable)(const Descriptor &name,
}
if (value) {
- return CopyToDescriptor(*value, rawValue, varLen, errmsg);
+ return CopyCharsToDescriptor(*value, rawValue, varLen, errmsg);
}
return StatOk;
}
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index b8000726af6411..e892d81bc6c587 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -43,6 +43,25 @@ enum CMD_STAT {
SIGNAL_ERR = 4
};
+// Override CopyCharsToDescriptor in tools.h
+void CopyCharsToDescriptor(const Descriptor &value, const char *rawValue){
+ CopyCharsToDescriptor(value, rawValue, std::strlen(rawValue));
+}
+
+void CheckAndCopyCharsToDescriptor(
+ const Descriptor *value, const char *rawValue) {
+ if (value) {
+ CopyCharsToDescriptor(*value, rawValue);
+ }
+}
+
+void CheckAndStoreIntToDescriptor(
+ const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
+ if (intVal) {
+ StoreIntToDescriptor(intVal, value, terminator);
+ }
+}
+
// If a condition occurs that would assign a nonzero value to CMDSTAT but
// the CMDSTAT variable is not present, error termination is initiated.
int TerminationCheck(int status, const Descriptor *cmdstat,
@@ -52,7 +71,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("Execution error with system status code: %d", status);
} else {
CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
- CopyCharToDescriptor(*cmdmsg, "Execution error");
+ CopyCharsToDescriptor(*cmdmsg, "Execution error", 16);
}
}
#ifdef _WIN32
@@ -68,7 +87,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
"Invalid command quit with exit status code: %d", exitStatusVal);
} else {
CheckAndStoreIntToDescriptor(cmdstat, INVALID_CL_ERR, terminator);
- CopyCharToDescriptor(*cmdmsg, "Invalid command line");
+ CopyCharsToDescriptor(*cmdmsg, "Invalid command line");
}
}
#if defined(WIFSIGNALED) && defined(WTERMSIG)
@@ -77,7 +96,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("killed by signal: %d", WTERMSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyCharToDescriptor(*cmdmsg, "killed by signal");
+ CopyCharsToDescriptor(*cmdmsg, "killed by signal");
}
}
#endif
@@ -87,7 +106,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("stopped by signal: %d", WSTOPSIG(status));
} else {
CheckAndStoreIntToDescriptor(cmdstat, SIGNAL_ERR, terminator);
- CopyCharToDescriptor(*cmdmsg, "stopped by signal");
+ CopyCharsToDescriptor(*cmdmsg, "stopped by signal");
}
}
#endif
@@ -156,7 +175,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
"CreateProcess failed with error code: %lu.", GetLastError());
} else {
StoreIntToDescriptor(cmdstat, (uint32_t)GetLastError(), terminator);
- CheckAndCopyCharToDescriptor(cmdmsg, "CreateProcess failed.");
+ CheckAndCopyCharsToDescriptor(cmdmsg, "CreateProcess failed.");
}
}
FreeMemory((void *)wcmd);
@@ -169,7 +188,7 @@ void RTNAME(ExecuteCommandLine)(const Descriptor &command, bool wait,
terminator.Crash("Fork failed with pid: %d.", pid);
} else {
StoreIntToDescriptor(cmdstat, FORK_ERR, terminator);
- CheckAndCopyCharToDescriptor(cmdmsg, "Fork failed");
+ CheckAndCopyCharsToDescriptor(cmdmsg, "Fork failed");
}
} else if (pid == 0) {
int status{std::system(newCmd)};
diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp
index 582b2ece0902f6..25b262d766718d 100644
--- a/flang/runtime/tools.cpp
+++ b/flang/runtime/tools.cpp
@@ -185,44 +185,21 @@ RT_API_ATTRS const char *EnsureNullTerminated(
}
}
-RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d) {
- std::size_t s{d.ElementBytes() - 1};
- while (*d.OffsetElement(s) == ' ') {
- --s;
- }
- return s + 1;
-}
-
-// Returns the length of the \p string. Assumes \p string is valid.
-RT_API_ATTRS std::int64_t StringLength(const char *string) {
- return static_cast<std::int64_t>(std::strlen(string));
-}
-
-// Assumes Descriptor \p value is not nullptr.
RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value) {
return value && value->IsAllocated() &&
value->type() == TypeCode(TypeCategory::Character, 1) &&
value->rank() == 0;
}
-// Assumes Descriptor \p intVal is not nullptr.
RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal) {
- auto typeCode{intVal->type().GetCategoryAndKind()};
// Check that our descriptor is allocated and is a scalar integer with
// kind != 1 (i.e. with a large enough decimal exponent range).
- return intVal->IsAllocated() && intVal->rank() == 0 &&
- intVal->type().IsInteger() && typeCode && typeCode->second != 1;
-}
-
-// Assume Descriptor \p value is valid: pass IsValidCharDescriptor check.
-RT_API_ATTRS void FillWithSpaces(const Descriptor &value, std::size_t offset) {
- if (offset < value.ElementBytes()) {
- std::memset(
- value.OffsetElement(offset), ' ', value.ElementBytes() - offset);
- }
+ return intVal && intVal->IsAllocated() && intVal->rank() == 0 &&
+ intVal->type().IsInteger() && intVal->type().GetCategoryAndKind() &&
+ intVal->type().GetCategoryAndKind()->second != 1;
}
-RT_API_ATTRS std::int32_t CopyToDescriptor(const Descriptor &value,
+RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value,
const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
std::size_t offset) {
@@ -241,40 +218,6 @@ RT_API_ATTRS std::int32_t CopyToDescriptor(const Descriptor &value,
return StatOk;
}
-RT_API_ATTRS void CopyCharToDescriptor(
- const Descriptor &value, const char *rawValue, std::size_t offset) {
- auto toCopy{std::min(std::strlen(rawValue), value.ElementBytes() - offset)};
- std::memcpy(value.OffsetElement(offset), rawValue, toCopy);
-}
-
-RT_API_ATTRS std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
- const char *rawValue, const Descriptor *errmsg, std::size_t &offset) {
- bool haveValue{IsValidCharDescriptor(value)};
-
- std::int64_t len{StringLength(rawValue)};
- if (len <= 0) {
- if (haveValue) {
- FillWithSpaces(*value);
- }
- return ToErrmsg(errmsg, StatMissingArgument);
- }
-
- std::int32_t stat{StatOk};
- if (haveValue) {
- stat = CopyToDescriptor(*value, rawValue, len, errmsg, offset);
- }
-
- offset += len;
- return stat;
-}
-
-RT_API_ATTRS void CheckAndCopyCharToDescriptor(
- const Descriptor *value, const char *rawValue, std::size_t offset) {
- if (value) {
- CopyCharToDescriptor(*value, rawValue, offset);
- }
-}
-
RT_API_ATTRS void StoreIntToDescriptor(
const Descriptor *length, std::int64_t value, Terminator &terminator) {
auto typeCode{length->type().GetCategoryAndKind()};
@@ -283,13 +226,6 @@ RT_API_ATTRS void StoreIntToDescriptor(
kind, terminator, *length, /* atIndex = */ 0, value);
}
-RT_API_ATTRS void CheckAndStoreIntToDescriptor(
- const Descriptor *intVal, std::int64_t value, Terminator &terminator) {
- if (intVal) {
- StoreIntToDescriptor(intVal, value, terminator);
- }
-}
-
template <int KIND> struct FitsInIntegerKind {
RT_API_ATTRS bool operator()([[maybe_unused]] std::int64_t value) {
if constexpr (KIND >= 8) {
@@ -302,12 +238,5 @@ template <int KIND> struct FitsInIntegerKind {
}
};
-RT_API_ATTRS bool FitsInDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator) {
- auto typeCode{length->type().GetCategoryAndKind()};
- int kind{typeCode->second};
- return ApplyIntegerKind<FitsInIntegerKind, bool>(kind, terminator, value);
-}
-
RT_OFFLOAD_API_GROUP_END
} // namespace Fortran::runtime
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 25fc443b6e0da0..3baef17c3b43b8 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -121,7 +121,7 @@ inline RT_API_ATTRS bool SetInteger(INT &x, int kind, std::int64_t value) {
template <template <TypeCategory, int> class FUNC, typename RESULT,
typename... A>
inline RT_API_ATTRS RESULT ApplyType(
- TypeCategory cat, int kind, Terminator &terminator, A &&...x) {
+ TypeCategory cat, int kind, Terminator &terminator, A &&... x) {
switch (cat) {
case TypeCategory::Integer:
switch (kind) {
@@ -222,7 +222,7 @@ inline RT_API_ATTRS RESULT ApplyType(
// a function object template and calls it with the supplied arguments.
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyIntegerKind(
- int kind, Terminator &terminator, A &&...x) {
+ int kind, Terminator &terminator, A &&... x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
@@ -243,7 +243,7 @@ inline RT_API_ATTRS RESULT ApplyIntegerKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
- int kind, Terminator &terminator, A &&...x) {
+ int kind, Terminator &terminator, A &&... x) {
switch (kind) {
#if 0 // TODO: REAL/COMPLEX (2 & 3)
case 2:
@@ -271,7 +271,7 @@ inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyCharacterKind(
- int kind, Terminator &terminator, A &&...x) {
+ int kind, Terminator &terminator, A &&... x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
@@ -286,7 +286,7 @@ inline RT_API_ATTRS RESULT ApplyCharacterKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyLogicalKind(
- int kind, Terminator &terminator, A &&...x) {
+ int kind, Terminator &terminator, A &&... x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
@@ -415,45 +415,21 @@ RT_API_ATTRS void ShallowCopy(const Descriptor &to, const Descriptor &from);
RT_API_ATTRS const char *EnsureNullTerminated(
const char *str, size_t length, Terminator &terminator);
-RT_API_ATTRS std::size_t LengthWithoutTrailingSpaces(const Descriptor &d);
-
-// Returns the length of the \p string. Assumes \p string is valid.
-RT_API_ATTRS std::int64_t StringLength(const char *string);
-
-// Assumes Descriptor \p value is not nullptr.
RT_API_ATTRS bool IsValidCharDescriptor(const Descriptor *value);
-// Assumes Descriptor \p intVal is not nullptr.
RT_API_ATTRS bool IsValidIntDescriptor(const Descriptor *intVal);
-// Assume Descriptor \p value is valid: pass IsValidCharDescriptor check.
-RT_API_ATTRS void FillWithSpaces(
- const Descriptor &value, std::size_t offset = 0);
-
-RT_API_ATTRS std::int32_t CopyToDescriptor(const Descriptor &value,
- const char *rawValue, std::int64_t rawValueLength, const Descriptor *errmsg,
- std::size_t offset = 0);
-
-void CopyCharToDescriptor(
- const Descriptor &value, const char *rawValue, std::size_t offset = 0);
-
-RT_API_ATTRS std::int32_t CheckAndCopyToDescriptor(const Descriptor *value,
- const char *rawValue, const Descriptor *errmsg, std::size_t &offset);
-
-RT_API_ATTRS void CheckAndCopyCharToDescriptor(
- const Descriptor *value, const char *rawValue, std::size_t offset = 0);
+// Copy a null-terminated character array \p rawValue to descriptor \p value.
+// The copy starts at the given \p offset, if not present then start at 0.
+// If descriptor `errmsg` is provided, error messages will be stored to it.
+// Returns stats specified in standard.
+RT_API_ATTRS std::int32_t CopyCharsToDescriptor(const Descriptor &value,
+ const char *rawValue, std::int64_t rawValueLength,
+ const Descriptor *errmsg = nullptr, std::size_t offset = 0);
RT_API_ATTRS void StoreIntToDescriptor(
const Descriptor *length, std::int64_t value, Terminator &terminator);
-RT_API_ATTRS void CheckAndStoreIntToDescriptor(
- const Descriptor *intVal, std::int64_t value, Terminator &terminator);
-
-template <int KIND> struct FitsInIntegerKind;
-
-RT_API_ATTRS bool FitsInDescriptor(
- const Descriptor *length, std::int64_t value, Terminator &terminator);
-
// Defines a utility function for copying and padding characters
template <typename TO, typename FROM>
RT_API_ATTRS void CopyAndPad(
>From 4a1b5a4939c03660d9c687edcd1a397464ff8143 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 21 Dec 2023 19:22:21 +0000
Subject: [PATCH 33/34] small fixes
---
flang/runtime/execute.cpp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index e892d81bc6c587..2e87b44257a8b4 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -43,7 +43,7 @@ enum CMD_STAT {
SIGNAL_ERR = 4
};
-// Override CopyCharsToDescriptor in tools.h
+// Override CopyCharsToDescriptor in tools.h, pass string directly
void CopyCharsToDescriptor(const Descriptor &value, const char *rawValue){
CopyCharsToDescriptor(value, rawValue, std::strlen(rawValue));
}
@@ -71,7 +71,7 @@ int TerminationCheck(int status, const Descriptor *cmdstat,
terminator.Crash("Execution error with system status code: %d", status);
} else {
CheckAndStoreIntToDescriptor(cmdstat, EXECL_ERR, terminator);
- CopyCharsToDescriptor(*cmdmsg, "Execution error", 16);
+ CopyCharsToDescriptor(*cmdmsg, "Execution error");
}
}
#ifdef _WIN32
>From 51c967081a526abeffe437fde1c3f1499a5b8c02 Mon Sep 17 00:00:00 2001
From: Yi Wu <yi.wu2 at arm.com>
Date: Thu, 21 Dec 2023 19:25:52 +0000
Subject: [PATCH 34/34] clang-format
---
flang/runtime/execute.cpp | 2 +-
flang/runtime/tools.h | 10 +++++-----
2 files changed, 6 insertions(+), 6 deletions(-)
diff --git a/flang/runtime/execute.cpp b/flang/runtime/execute.cpp
index 2e87b44257a8b4..aa650e0bac41ef 100644
--- a/flang/runtime/execute.cpp
+++ b/flang/runtime/execute.cpp
@@ -44,7 +44,7 @@ enum CMD_STAT {
};
// Override CopyCharsToDescriptor in tools.h, pass string directly
-void CopyCharsToDescriptor(const Descriptor &value, const char *rawValue){
+void CopyCharsToDescriptor(const Descriptor &value, const char *rawValue) {
CopyCharsToDescriptor(value, rawValue, std::strlen(rawValue));
}
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index 3baef17c3b43b8..714847ee14f335 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -121,7 +121,7 @@ inline RT_API_ATTRS bool SetInteger(INT &x, int kind, std::int64_t value) {
template <template <TypeCategory, int> class FUNC, typename RESULT,
typename... A>
inline RT_API_ATTRS RESULT ApplyType(
- TypeCategory cat, int kind, Terminator &terminator, A &&... x) {
+ TypeCategory cat, int kind, Terminator &terminator, A &&...x) {
switch (cat) {
case TypeCategory::Integer:
switch (kind) {
@@ -222,7 +222,7 @@ inline RT_API_ATTRS RESULT ApplyType(
// a function object template and calls it with the supplied arguments.
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyIntegerKind(
- int kind, Terminator &terminator, A &&... x) {
+ int kind, Terminator &terminator, A &&...x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
@@ -243,7 +243,7 @@ inline RT_API_ATTRS RESULT ApplyIntegerKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
- int kind, Terminator &terminator, A &&... x) {
+ int kind, Terminator &terminator, A &&...x) {
switch (kind) {
#if 0 // TODO: REAL/COMPLEX (2 & 3)
case 2:
@@ -271,7 +271,7 @@ inline RT_API_ATTRS RESULT ApplyFloatingPointKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyCharacterKind(
- int kind, Terminator &terminator, A &&... x) {
+ int kind, Terminator &terminator, A &&...x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
@@ -286,7 +286,7 @@ inline RT_API_ATTRS RESULT ApplyCharacterKind(
template <template <int KIND> class FUNC, typename RESULT, typename... A>
inline RT_API_ATTRS RESULT ApplyLogicalKind(
- int kind, Terminator &terminator, A &&... x) {
+ int kind, Terminator &terminator, A &&...x) {
switch (kind) {
case 1:
return FUNC<1>{}(std::forward<A>(x)...);
More information about the flang-commits
mailing list