Implement (os-call string) => integer

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

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);

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));
+}

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)))
+;