koans - triangle

using cond, which is ok (destructuring would be nice)
and signaling errors, copying definitions of errors

and not quite proficient with writing code that has guards against errors
This commit is contained in:
efim 2022-08-16 18:45:59 +00:00
parent 586f06fbf2
commit cdeeb2fead
1 changed files with 52 additions and 27 deletions

View File

@ -14,15 +14,28 @@
(define-condition triangle-error (error) (define-condition triangle-error (error)
;; Fill in the blank with a suitable slot definition. ;; Fill in the blank with a suitable slot definition.
(____)) ((triangle-error-sides :initarg :sides :reader triangle-error-sides)))
(defun triangle (a b c) (defun triangle (a b c)
;; Fill in the blank with a function that satisfies the below tests. ;; Fill in the blank with a function that satisfies the below tests.
____) (cond
((or (<= a 0) (<= b 0) (<= c 0)) (signal (make-condition 'type-error
:datum (car (remove-if-not (lambda (n) (>= 0 n)) (list a b c)))
:expected-type '(real (0)))))
((or (<= (+ a b) c) (<= (+ b c) a) (<= (+ a c) b)) (signal (make-condition 'triangle-error
:sides (list a b c))))
((= a b c) :equilateral)
((or (= a b) (= b c) (= a c)) :isosceles)
(t :scalene)))
(car (remove-if (lambda (n) (>= 0 n)) (list 1 2 -2)))
(triangle 1 1 1)
(triangle 0 0 0)
(define-test equilateral-triangles (define-test equilateral-triangles
;; Equilateral triangles have three sides of equal length, ;; Equilateral triangles have three sides of equal length,
(assert-equal :equilateral (triangle 2 2 2)) (assert-equal :equilateral (triangle 2 2 2))
(assert-equal :equilateral (triangle 10 10 10))) (assert-equal :equilateral (triangle 10 10 10)))
(define-test isosceles-triangles (define-test isosceles-triangles
@ -39,27 +52,39 @@
(assert-equal :scalene (triangle 10 11 12)) (assert-equal :scalene (triangle 10 11 12))
(assert-equal :scalene (triangle 5 4 2))) (assert-equal :scalene (triangle 5 4 2)))
(define-test illegal-triangles (defun triangle-failure (a b c)
;; Not all triplets make valid triangles.
(flet ((triangle-failure (a b c)
(handler-case (progn (triangle a b c) (error "Test failure")) (handler-case (progn (triangle a b c) (error "Test failure"))
(error (condition) condition)))) (error (condition) condition)))
(let ((condition (triangle-failure 0 0 0))) (triangle 0 0 0)
(assert-true (typep condition 'type-error)) (setq condi (triangle-failure 2 -1 1))
(assert-equal 0 (type-error-datum condition)) (type-error-datum condi)
;; The type (REAL (0)) represents all positive numbers. (type-error-expected-type condi)
(assert-true (subtypep (type-error-expected-type condition) '(real (0))))
;; If two type specifiers are SUBTYPEP of one another, then they represent (setq condi (triangle-failure 2 4 2))
;; the same Lisp type. (triangle-error-sides condi)
(assert-true (subtypep '(real (0)) (type-error-expected-type condition))))
(let ((condition (triangle-failure 3 4 -5)))
(assert-true (typep condition 'type-error)) (define-test illegal-triangles
(assert-equal -5 (type-error-datum condition)) ;; Not all triplets make valid triangles.
(assert-true (subtypep (type-error-expected-type condition) '(real (0)))) (flet ((triangle-failure (a b c)
(assert-true (subtypep '(real (0)) (type-error-expected-type condition)))) (handler-case (progn (triangle a b c) (error "Test failure"))
(let ((condition (triangle-failure 1 1 3))) (error (condition) condition))))
(assert-true (typep condition 'triangle-error)) (let ((condition (triangle-failure 0 0 0)))
(assert-equal '(1 1 3) (triangle-error-sides condition))) (assert-true (typep condition 'type-error))
(let ((condition (triangle-failure 2 4 2))) (assert-equal 0 (type-error-datum condition))
(assert-true (typep condition 'triangle-error)) ;; The type (REAL (0)) represents all positive numbers.
(assert-equal '(2 4 2) (triangle-error-sides condition))))) (assert-true (subtypep (type-error-expected-type condition) '(real (0))))
;; If two type specifiers are SUBTYPEP of one another, then they represent
;; the same Lisp type.
(assert-true (subtypep '(real (0)) (type-error-expected-type condition))))
(let ((condition (triangle-failure 3 4 -5)))
(assert-true (typep condition 'type-error))
(assert-equal -5 (type-error-datum condition))
(assert-true (subtypep (type-error-expected-type condition) '(real (0))))
(assert-true (subtypep '(real (0)) (type-error-expected-type condition))))
(let ((condition (triangle-failure 1 1 3)))
(assert-true (typep condition 'triangle-error))
(assert-equal '(1 1 3) (triangle-error-sides condition)))
(let ((condition (triangle-failure 2 4 2)))
(assert-true (typep condition 'triangle-error))
(assert-equal '(2 4 2) (triangle-error-sides condition)))))