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)
;; Fill in the blank with a suitable slot definition.
(____))
((triangle-error-sides :initarg :sides :reader triangle-error-sides)))
(defun triangle (a b c)
;; 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
;; Equilateral triangles have three sides of equal length,
(assert-equal :equilateral (triangle 2 2 2))
;; Equilateral triangles have three sides of equal length,
(assert-equal :equilateral (triangle 2 2 2))
(assert-equal :equilateral (triangle 10 10 10)))
(define-test isosceles-triangles
@ -39,27 +52,39 @@
(assert-equal :scalene (triangle 10 11 12))
(assert-equal :scalene (triangle 5 4 2)))
(define-test illegal-triangles
;; Not all triplets make valid triangles.
(flet ((triangle-failure (a b c)
(defun triangle-failure (a b c)
(handler-case (progn (triangle a b c) (error "Test failure"))
(error (condition) condition))))
(let ((condition (triangle-failure 0 0 0)))
(assert-true (typep condition 'type-error))
(assert-equal 0 (type-error-datum condition))
;; The type (REAL (0)) represents all positive numbers.
(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)))))
(error (condition) condition)))
(triangle 0 0 0)
(setq condi (triangle-failure 2 -1 1))
(type-error-datum condi)
(type-error-expected-type condi)
(setq condi (triangle-failure 2 4 2))
(triangle-error-sides condi)
(define-test illegal-triangles
;; Not all triplets make valid triangles.
(flet ((triangle-failure (a b c)
(handler-case (progn (triangle a b c) (error "Test failure"))
(error (condition) condition))))
(let ((condition (triangle-failure 0 0 0)))
(assert-true (typep condition 'type-error))
(assert-equal 0 (type-error-datum condition))
;; The type (REAL (0)) represents all positive numbers.
(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)))))