diff --git a/README_ZH.md b/README_ZH.md index 95de5c9..ebff9e6 100644 --- a/README_ZH.md +++ b/README_ZH.md @@ -20,7 +20,7 @@ | [(liii os)](goldfish/liii/os.scm) | 库类似于 Python 的 `os` 模块 | `getenv`, `mkdir` | | [(liii uuid)](goldfish/liii/uuid.scm) | UUID 生成 | `uuid4` | | [(liii sys)](goldfish/liii/sys.scm) | 库类似于 Python 的 `sys` 模块 | `argv` | -| [(liii error)](goldfish/liii/error.scm) | 提供类似Python的错误函数 | `error-os`函数抛出`'os-error`,类似Python的OSError | +| [(liii error)](goldfish/liii/error.scm) | 提供类似Python的错误函数 | `os-error`函数抛出`'os-error`,类似Python的OSError | | [(liii check)](goldfish/liii/check.scm) | 基于SRFI 78的轻量级测试库加强版 | `check`, `check-catch` | ### SRFI diff --git a/goldfish/liii/error.scm b/goldfish/liii/error.scm index 468dd80..616f016 100644 --- a/goldfish/liii/error.scm +++ b/goldfish/liii/error.scm @@ -14,23 +14,37 @@ ; under the License. ; +; see https://docs.python.org/3/library/exceptions.html#exception-hierarchy + (define-library (liii error) -(export error-file-not-found error-os error-not-a-directory - error-file-exists) +(export ??? + os-error file-not-found-error not-a-directory-error file-exists-error + timeout-error + type-error value-error) (import (scheme process-context)) (begin -(define (error-file-not-found msg) - (error 'file-not-found-error msg)) - -(define (error-os msg) +(define (os-error msg) (error 'os-error msg)) -(define (error-not-a-directory msg) +(define (file-not-found-error msg) + (error 'file-not-found-error msg)) + +(define (not-a-directory-error msg) (error 'not-a-directory-error msg)) -(define (error-file-exists msg) +(define (file-exists-error msg) (error 'file-exists-error msg)) +(define (timeout-error args) + (apply (cons 'timeout-error args) error)) + +(define (type-error args) + (apply (cons 'type-error args) error)) + +; nice Scala style to throw the not-implemented-error +(define (???) + (error 'not-implemented-error)) + ) ; begin ) ; define-library diff --git a/goldfish/liii/os.scm b/goldfish/liii/os.scm index e64652c..0d992fe 100644 --- a/goldfish/liii/os.scm +++ b/goldfish/liii/os.scm @@ -48,10 +48,10 @@ (define (%check-dir-andthen path f) (cond ((not (file-exists? path)) - (error-file-not-found + (file-not-found-error (string-append "No such file or directory: '" path "'"))) ((not (isdir path)) - (error-not-a-directory + (not-a-directory-error (string-append "Not a directory: '" path "'"))) (else (f path)))) @@ -60,7 +60,7 @@ (define (mkdir path) (if (file-exists? path) - (error-file-exists (string-append "File exists: '" path "'")) + (file-exists-error (string-append "File exists: '" path "'")) (g_mkdir path))) (define (rmdir path) diff --git a/goldfish/liii/string.scm b/goldfish/liii/string.scm new file mode 100644 index 0000000..33ed080 --- /dev/null +++ b/goldfish/liii/string.scm @@ -0,0 +1,35 @@ +; +; 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 string) +(export + string-null? string-copy string-join + string-every string-any + string-take string-take-right string-drop string-drop-right + string-pad string-pad-right + string-trim string-trim-right string-trim-both + string-prefix? string-suffix? + string-index string-index-right + string-contains string-count + string-reverse + string-tokenize +) +(import (srfi srfi-13) + (srfi srfi-1) + (liii error)) +(begin +) ; end of begin +) ; end of library diff --git a/tests/liii/error-test.scm b/tests/liii/error-test.scm new file mode 100644 index 0000000..7ed6dec --- /dev/null +++ b/tests/liii/error-test.scm @@ -0,0 +1,22 @@ +; +; 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 check) + (liii error)) + +(check-catch 'not-implemented-error (lambda () (???))) + +(check-report) diff --git a/tests/liii/string-test.scm b/tests/liii/string-test.scm new file mode 100644 index 0000000..8f7a348 --- /dev/null +++ b/tests/liii/string-test.scm @@ -0,0 +1,23 @@ +; +; 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 check) + (liii error)) + +(check (mk-string " " (list 1 2 3)) => "1 2 3") +(check (mk-string " " (list )) => "") + +(check-report) diff --git a/tests/scheme/process-context-test.scm b/tests/scheme/process-context-test.scm index da4da8f..ede2ca3 100644 --- a/tests/scheme/process-context-test.scm +++ b/tests/scheme/process-context-test.scm @@ -15,9 +15,15 @@ ; (import (srfi srfi-78) - (scheme process-context)) + (scheme process-context) + (srfi srfi-13) + (liii os)) (check-set-mode! 'report-failed) ; (check (get-environment-variable "USER") => "da") -; (check (get-environment-variable "HOME") => "/home/da") +(when (os-linux?) + (check (string-prefix? "/home" (get-environment-variable "HOME")) + => #t)) + +(check-report)