Implement (file-exists? path) (#13)

.github/workflows/ci-debian.yml

@@ -61,4 +61,4 @@ jobs:
         run: xmake build --yes -vD goldfish
 
       - name: run tests
-        run: find tests | grep "test.scm" | xargs -I% bin/goldfish %
+        run: bin/goldfish -l tests/test_all.scm

.github/workflows/ci-macos.yml

@@ -47,5 +47,5 @@ jobs:
         run: xmake build --yes -vD goldfish
 
       - name: run tests
-        run: find tests | grep "test.scm" | xargs -I% bin/goldfish %
+        run: bin/goldfish -l tests/test_all.scm
 

.github/workflows/ci-windows.yml

@@ -0,0 +1,39 @@
+name: Build on windows
+
+on:
+  push:
+    branches: [ main ]
+  pull_request:
+    branches: [ main ]
+  workflow_dispatch:
+
+jobs:
+  windowsbuild:
+    runs-on: windows-2019
+    env:
+        # Force xmake to a specific folder (for cache)
+        XMAKE_GLOBALDIR: ${{ github.workspace }}/.xmake-global
+    steps:
+      - uses: xmake-io/github-action-setup-xmake@v1
+        with:
+          xmake-version: v2.8.9
+      - name: update repo
+        run: xmake repo -u
+      - name: git crlf
+        run: git config --global core.autocrlf false
+      - uses: actions/checkout@v3
+        with:
+          fetch-depth: 1
+      - name: cache xmake
+        uses: actions/cache@v2
+        with:
+          path: |
+            ${{ env.XMAKE_GLOBALDIR }}/.xmake/packages
+            ${{ github.workspace }}/build/.build_cache
+          key: ${{ runner.os }}-xmake-${{ hashFiles('**/xmake.lua') }}
+      - name: config
+        run: xmake config --yes -vD
+      - name: build
+        run: xmake build --yes -vD goldfish
+      - name: test
+        run: bin/goldfish -l tests/test_all.scm

goldfish/scheme/boot.scm

@@ -1,6 +1,11 @@
 ; 0-clause BSD
 ; Adapted from S7 Scheme's r7rs.scm
 
+(define (file-exists? path)
+  (if (string? path)
+    (g_file-exists? path)
+    (error 'wrong-type-arg "(file-exists? path): path should be string")))
+
 (define-macro (define-library libname . body) ; |(lib name)| -> environment
   `(define ,(symbol (object->string libname))
      (with-let (sublet (unlet)

src/goldfish.cpp

@@ -29,6 +29,11 @@ using std::vector;
 using std::filesystem::exists;
 using std::filesystem::path;
 
+using goldfish::glue_goldfish;
+using goldfish::glue_liii_os;
+using goldfish::glue_scheme_process_context;
+using goldfish::glue_scheme_time;
+
 void
 display_help () {
   cout << "Goldfish Scheme " << goldfish_version << " by LiiiLabs" << endl;

src/goldfish.hpp

@@ -15,6 +15,7 @@
 //
 
 #include <chrono>
+#include <filesystem>
 #include <iostream>
 #include <s7.h>
 #include <string>
@@ -25,11 +26,6 @@
 #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
 const int major_version= 17;               // C++ Standard version
@@ -41,12 +37,24 @@ const std::string goldfish_version=
         .append (".")
         .append (std::to_string (patch_version));
 
+namespace goldfish {
+using std::filesystem::exists;
+using std::filesystem::path;
+
 // Glues for Goldfish
 static s7_pointer
 f_version (s7_scheme* sc, s7_pointer args) {
   return s7_make_string (sc, goldfish_version.c_str ());
 }
 
+static s7_pointer
+f_file_exists (s7_scheme* sc, s7_pointer args) {
+  const char* path_c= s7_string (s7_car (args));
+  auto        p     = path (path_c);
+  bool        ret   = exists (p);
+  return s7_make_boolean (sc, ret);
+}
+
 inline void
 glue_goldfish (s7_scheme* sc) {
   s7_pointer cur_env= s7_curlet (sc);
@@ -57,6 +65,12 @@ glue_goldfish (s7_scheme* sc) {
   s7_define (sc, cur_env, s7_make_symbol (sc, s_version),
              s7_make_typed_function (sc, s_version, f_version, 0, 0, false,
                                      d_version, NULL));
+
+  const char* s_file_exists= "g_file-exists?";
+  const char* d_file_exists= "(g_file-exists? string) => boolean";
+  s7_define (sc, cur_env, s7_make_symbol (sc, s_file_exists),
+             s7_make_typed_function (sc, s_file_exists, f_file_exists, 1, 0,
+                                     false, d_file_exists, NULL));
 }
 
 // Glues for (scheme time)
@@ -193,3 +207,5 @@ glue_liii_os (s7_scheme* sc) {
              s7_make_typed_function (sc, s_os_call, f_os_call, 1, 0, false,
                                      d_os_call, NULL));
 }
+
+} // namespace goldfish

tests/liii/os-test.scm

@@ -32,9 +32,9 @@
 
 (when (not (os-windows?))
   (let ((t1 (current-second)))
-    (os-call "sleep 3")
+    (os-call "sleep 1")
     (let ((t2 (current-second)))
-      (check (> (ceiling (- t2 t1)) 3) => #t))))
+      (check (>= (ceiling (- t2 t1)) 1) => #t))))
 
 (check-report)
 (if (check-failed?) (exit -1))

tests/scheme/case-lambda-test.scm

@@ -32,3 +32,5 @@
 (check ((my-func) 3 4) => 7)
 (check ((my-func) 1 2 3 4) => 10)
 
+(check-report)
+(if (check-failed?) (exit -1))

tests/srfi/srfi-16-test.scm

@@ -32,3 +32,5 @@
 (check ((my-func) 3 4) => 7)
 (check ((my-func) 1 2 3 4) => 10)
 
+(check-report)
+(if (check-failed?) (exit -1))

tests/srfi/srfi-39-test.scm

@@ -31,3 +31,5 @@
 
 (check (mp) => "initial value")
 
+(check-report)
+(if (check-failed?) (exit -1))

tests/srfi/srfi-8-test.scm

@@ -24,3 +24,5 @@
   =>
   3)
 
+(check-report)
+(if (check-failed?) (exit -1))

tests/srfi/srfi-9-test.scm

@@ -40,3 +40,5 @@
   =>
   "Darcy")
 
+(check-report)
+(if (check-failed?) (exit -1))

tests/test_all.scm

@@ -0,0 +1,47 @@
+;
+; 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)
+        (srfi srfi-1)
+        (liii os))
+
+(check-set-mode! 'report-failed)
+
+(when (not (os-windows?))
+  (check (file-exists? "/tmp") => #t)
+  (check (file-exists? "/not_exists") => #f))
+
+(when (os-windows?)
+  (check (file-exists? "C:") => #t))
+
+(check-report)
+
+(define (all-tests)
+  (list
+    "tests/scheme/case-lambda-test.scm"
+    "tests/scheme/process-context-test.scm"
+    "tests/srfi/srfi-8-test.scm"
+    "tests/srfi/srfi-9-test.scm"
+    "tests/srfi/srfi-16-test.scm"
+    "tests/srfi/srfi-39-test.scm"
+    "tests/liii/os-test.scm"))
+
+(let ((ret-l
+       (map (lambda (x) (begin (newline) (display "> ") (display x) (newline) (os-call x)))
+         (map (lambda (x) (string-append "bin/goldfish -l " x))
+           (all-tests)))))
+  (when (find (lambda (x) (not (= x 0))) ret-l)
+    (exit -1)))