From 601f79902f819477a10bfb35d87d603345ec9f8f Mon Sep 17 00:00:00 2001
From: Darcy Shen <da@liii.pro>
Date: Sun, 4 Aug 2024 17:14:43 +0800
Subject: [PATCH] Implement (os-call)

---
 goldfish/liii/os.scm   | 25 +++++++++++++++++++++++
 src/goldfish.cpp       |  1 +
 src/goldfish.hpp       | 45 ++++++++++++++++++++++++++++++++++++++++++
 tests/liii/os-test.scm | 27 +++++++++++++++++++++++++
 4 files changed, 98 insertions(+)
 create mode 100644 goldfish/liii/os.scm
 create mode 100644 tests/liii/os-test.scm

diff --git a/goldfish/liii/os.scm b/goldfish/liii/os.scm
new file mode 100644
index 0000000..65ad998
--- /dev/null
+++ b/goldfish/liii/os.scm
@@ -0,0 +1,25 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(define-library (liii os)
+(export os-call)
+(begin
+
+(define (os-call command)
+  (g_os-call command))
+
+) ; end of begin
+) ; end of define-library
diff --git a/src/goldfish.cpp b/src/goldfish.cpp
index 6355aba..37a2568 100644
--- a/src/goldfish.cpp
+++ b/src/goldfish.cpp
@@ -101,6 +101,7 @@ main (int argc, char** argv) {
   glue_goldfish (sc);
   glue_scheme_time (sc);
   glue_scheme_process_context (sc);
+  glue_liii_os (sc);
 
   // Command options
   vector<string> args (argv + 1, argv + argc);
diff --git a/src/goldfish.hpp b/src/goldfish.hpp
index 5e01596..a50da73 100644
--- a/src/goldfish.hpp
+++ b/src/goldfish.hpp
@@ -20,9 +20,15 @@
 #include <string>
 #include <tbox/tbox.h>
 
+#if !defined(_MSC_VER)
+#include <errno.h>
+#include <wordexp.h>
+#endif
+
 inline void glue_goldfish (s7_scheme* sc);
 inline void glue_scheme_time (s7_scheme* sc);
 inline void glue_scheme_process_context (s7_scheme* sc);
+inline void glue_liii_os (s7_scheme* sc);
 
 const int patch_version= 0;                // Goldfish Patch Version
 const int minor_version= S7_MAJOR_VERSION; // S7 Major Version
@@ -116,3 +122,42 @@ glue_scheme_process_context (s7_scheme* sc) {
                                      f_get_environment_variable, 1, 0, false,
                                      d_get_environment_variable, NULL));
 }
+
+// Glue for (liii os)
+static s7_pointer
+f_os_call (s7_scheme* sc, s7_pointer args) {
+  const char*       cmd_c= s7_string (s7_car (args));
+  tb_process_attr_t attr = {tb_null};
+  attr.flags             = TB_PROCESS_FLAG_NO_WINDOW;
+  int ret;
+
+#if _MSC_VER
+  ret= (int) tb_process_run_cmd (cmd_c, &attr);
+#else
+  wordexp_t   p;
+  ret= wordexp (cmd_c, &p, 0);
+  if (ret != 0) {
+    // failed after calling wordexp
+  }
+  else if (p.we_wordc == 0) {
+    wordfree (&p);
+    ret= EINVAL;
+  }
+  else {
+    ret= (int) tb_process_run (p.we_wordv[0], (tb_char_t const**) p.we_wordv,
+                               &attr);
+    wordfree (&p);
+  }
+#endif
+  return s7_make_integer (sc, ret);
+}
+
+inline void
+glue_liii_os (s7_scheme* sc) {
+  s7_pointer  cur_env  = s7_curlet (sc);
+  const char* s_os_call= "g_os-call";
+  const char* d_os_call= "(g_os-call string) => int";
+  s7_define (sc, cur_env, s7_make_symbol (sc, s_os_call),
+             s7_make_typed_function (sc, s_os_call, f_os_call, 1, 0, false,
+                                     d_os_call, NULL));
+}
diff --git a/tests/liii/os-test.scm b/tests/liii/os-test.scm
new file mode 100644
index 0000000..206bfa9
--- /dev/null
+++ b/tests/liii/os-test.scm
@@ -0,0 +1,27 @@
+;
+; Copyright (C) 2024 The Goldfish Scheme Authors
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+; http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
+; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
+; License for the specific language governing permissions and limitations
+; under the License.
+;
+
+(import (srfi srfi-78)
+        (liii os)
+        (scheme time))
+
+(check-set-mode! 'report-failed)
+
+; (let ((t1 (current-second)))
+;   (os-call "sleep 10")
+;   (let ((t2 (current-second)))
+;     (check (floor (- t2 t1)) => 10)))
+;