path-dir?, path-file?, path-exists? in (liii path) (#24)

goldfish/liii/os.scm

@@ -57,14 +57,11 @@
   (cond ((not (file-exists? path))
          (file-not-found-error
            (string-append "No such file or directory: '" path "'")))
-        ((not (isdir path))
+        ((not (g_isdir path))
          (not-a-directory-error
            (string-append "Not a directory: '" path "'")))
         (else (f path))))
 
-(define (isdir path)
-  (g_isdir path))
-
 (define (mkdir path)
   (if (file-exists? path)
     (file-exists-error (string-append "File exists: '" path "'"))

goldfish/liii/path.scm

@@ -0,0 +1,34 @@
+;
+; 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 path)
+(export
+  path-dir? path-file? path-exists?
+)
+(import (liii error))
+(begin
+
+(define (path-dir? path)
+  (g_isdir path))
+
+(define (path-file? path)
+  (g_isfile path))
+
+(define (path-exists? path)
+  (file-exists? path))
+
+)
+)

src/goldfish.hpp

@@ -230,7 +230,24 @@ f_isdir (s7_scheme* sc, s7_pointer args) {
   tb_file_info_t info;
   bool           ret= false;
   if (tb_file_info (dir_c, &info)) {
-    if (info.type == TB_FILE_TYPE_DIRECTORY) {
+    switch (info.type) {
+    case TB_FILE_TYPE_DIRECTORY:
+    case TB_FILE_TYPE_DOT:
+    case TB_FILE_TYPE_DOT2:
+      ret= true;
+    }
+  }
+  return s7_make_boolean (sc, ret);
+}
+
+static s7_pointer
+f_isfile (s7_scheme* sc, s7_pointer args) {
+  const char*    dir_c= s7_string (s7_car (args));
+  tb_file_info_t info;
+  bool           ret= false;
+  if (tb_file_info (dir_c, &info)) {
+    switch (info.type) {
+    case TB_FILE_TYPE_FILE:
       ret= true;
     }
   }
@@ -322,6 +339,8 @@ glue_liii_os (s7_scheme* sc) {
   const char* d_os_temp_dir= "(g_os-temp-dir) => string";
   const char* s_isdir      = "g_isdir";
   const char* d_isdir      = "(g_isdir string) => boolean";
+  const char* s_isfile     = "g_isfile";
+  const char* d_isfile     = "(g_isfile string) => boolean";
   const char* s_mkdir      = "g_mkdir";
   const char* d_mkdir      = "(g_mkdir string) => boolean";
   const char* s_listdir    = "g_listdir";
@@ -350,6 +369,9 @@ glue_liii_os (s7_scheme* sc) {
   s7_define (sc, cur_env, s7_make_symbol (sc, s_isdir),
              s7_make_typed_function (sc, s_isdir, f_isdir, 1, 0, false, d_isdir,
                                      NULL));
+  s7_define (sc, cur_env, s7_make_symbol (sc, s_isfile),
+             s7_make_typed_function (sc, s_isfile, f_isfile, 1, 0, false,
+                                     d_isfile, NULL));
   s7_define (sc, cur_env, s7_make_symbol (sc, s_mkdir),
              s7_make_typed_function (sc, s_mkdir, f_mkdir, 1, 0, false, d_mkdir,
                                      NULL));

tests/liii/os-test.scm

@@ -43,8 +43,6 @@
 (when (os-linux?)
   (check (os-temp-dir) => "/tmp"))
 
-(check (isdir (os-temp-dir)) => #t)
-
 (when (not (os-windows?))
   (check-catch 'file-exists-error
     (lambda () (mkdir "/tmp")))

tests/liii/path-test.scm

@@ -0,0 +1,41 @@
+;
+; 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 (liii path)
+        (liii check)
+        (liii os))
+
+(check-set-mode! 'report-failed)
+
+(check (path-dir? ".") => #t)
+(check (path-dir? "..") => #t)
+
+(when (not (os-windows?))
+  (check (path-dir? "/") => #t)
+  (check (path-dir? "/tmp") => #t)
+  (check (path-dir? "/no_such_dir") => #f))
+
+(when (os-windows?)
+  (check (path-dir? "C:/") => #t)
+  (check (path-dir? "C:/no_such_dir/") => #f))
+
+(check (path-file? ".") => #f)
+(check (path-file? "..") => #f)
+
+(when (os-linux?)
+  (check (path-file? "/etc/passwd") => #t))
+
+(check-report)

tests/test_all.scm

@@ -17,7 +17,7 @@
 (import (liii list)
         (liii string)
         (liii os)
-        (srfi srfi-1))
+        (liii path))
 
 (define (listdir2 dir)
   (map (lambda (x) (string-append dir "/" x))
@@ -26,9 +26,9 @@
 ; (display (listdir2 "tests"))
 (define (all-tests)
   (((apply list-view (listdir2 "tests"))
-    filter isdir
+    filter path-dir?
     flatmap listdir2
-    filter (lambda (x) (not (isdir x)))
+    filter (lambda (x) (path-file? x))
     filter (lambda (x) (not (string-suffix? "srfi-78-test.scm" x))))))
 
 (define (goldfish-cmd)