diff options
author | 2024-12-30 09:52:23 -0500 | |
---|---|---|
committer | 2024-12-30 09:52:23 -0500 | |
commit | 27eaddbc13849e5b0e214bca956048c22fadb1c8 (patch) | |
tree | 1eff0fa16a776b43d5dccd8fb44fee85e0795722 /tests/basic.scm | |
parent | define-record-type/destructor (diff) |
fix define-record-type/destructor and refactor tests
Diffstat (limited to 'tests/basic.scm')
-rw-r--r-- | tests/basic.scm | 70 |
1 files changed, 70 insertions, 0 deletions
diff --git a/tests/basic.scm b/tests/basic.scm new file mode 100644 index 0000000..fdcc0d7 --- /dev/null +++ b/tests/basic.scm @@ -0,0 +1,70 @@ +#| Copyright 2024 Peter McGoron + | + | 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. + |# + +(test-begin "(mcgoron cond-thunk base)") + +(test-assert + "cond-thunk basic" + (cond-thunk + (if #t + (lambda () + #t) + #f) + (else #f))) + +(test-assert + "when-ct true" + (cond-thunk + (when-ct #t #t) + (else #f))) + +(test + "cond-thunk multiple branches" + 'two + (cond-thunk + (when-ct (pair? #f) 'one) + (when-ct (boolean? #f) 'two) + (when-ct (boolean? #f) 'three) + (else #f))) + +(let ((on-pair + (lambda-ct (x) (pair? x) + 'pair)) + (on-boolean + (lambda-ct (x) (boolean? x) + 'boolean))) + (test + "lambda-ct basic" + 'boolean + (cond-thunk + (on-pair #f) + (on-boolean #f) + (else #f)))) + +(let () + (define-ct (on-pair x) (pair? x) + 'pair) + (define-ct (on-boolean x) (boolean? x) + 'boolean) + (test + "define-ct basic" + 'boolean + (cond-thunk + (on-pair #f) + (on-boolean #f) + (else #f)))) + +(test-end "(mcgoron cond-thunk base)") |