#| 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)")