Compare commits

..

5 Commits

Author SHA1 Message Date
efim ecf12d390d ignoring nested music thing 2022-08-19 10:23:14 +00:00
efim 063c5c52d1 koans, stuff
dice - more practice with signal and clog
backquote - first practice with @,a splicing
macros - some news of common errors:
- capturing outer symbols, so caller expects them to be used, but
invisible internal values take their place
- evaluating "pass by name" forms too many times
- evaluating them in surprising order
2022-08-19 08:38:50 +00:00
efim cdeeb2fead 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
2022-08-16 18:45:59 +00:00
efim 586f06fbf2 previous koans, conditions
complex stuff, unpleasant for now
2022-08-16 18:18:30 +00:00
efim b4fe711abb koans with signals, errors and stuff
this is a bit complicated, espeially with different objects representing conditions
and how hard it is to check inner parts of expressions
2022-08-11 12:36:22 +00:00
7 changed files with 240 additions and 151 deletions

1
.gitignore vendored
View File

@ -1 +1,2 @@
/.direnv/
/music/

View File

@ -19,23 +19,26 @@
(let ((x '(123))
(z '(7 8 9)))
;; ' quotes an expression normally.
(assert-equal ____ '(x 45 6 z))
(assert-equal (list 'x 45 6 'z) '(x 45 6 z))
;; ` backquotes an expression; without any unquotes, it is equivalent to
;; using the normal quote.
(assert-equal ____ `(x 45 6 z))
(assert-equal '(x 45 6 z) `(x 45 6 z))
;; , unquotes a part of the expression.
(assert-equal ____ `(,x 45 6 z))
(assert-equal ____ `(,x 45 6 ,z))
(assert-equal '((123) 45 6 z) `(,x 45 6 z))
(assert-equal '((123) 45 6 (7 8 9)) `(,x 45 6 ,z))
;; ,@ splices an expression into the into the list surrounding it.
(assert-equal ____ `(,x 45 6 ,@z))
(assert-equal ____ `(,@x 45 6 ,@z))))
(assert-equal '((123) 45 6 7 8 9) `(,x 45 6 ,@z))
(assert-equal '(123 45 6 7 8 9) `(,@x 45 6 ,@z))))
(define-test backquote-forms
;; Because of its properties, backquote is useful for constructing Lisp forms
;; that are macroexpansions or parts of macroexpansions.
(let ((variable 'x))
;; Fill in the blank without without using backquote/unquote notation.
(assert-equal ____
(assert-equal '(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error 'type-error :datum x
:expected-type 'string))
`(if (typep ,variable 'string)
(format nil "The value of ~A is ~A" ',variable ,variable)
(error 'type-error :datum ,variable
@ -43,7 +46,9 @@
(let ((error-type 'type-error)
(error-arguments '(:datum x :expected-type 'string)))
;; Fill in the blank without without using backquote/unquote notation.
(assert-equal ____
(assert-equal '(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error 'type-error :datum x :expected-type 'string))
`(if (typep x 'string)
(format nil "The value of ~A is ~A" 'x x)
(error ',error-type ,@error-arguments)))))
@ -51,15 +56,15 @@
(define-test numbers-and-words
(let ((number 5)
(word 'dolphin))
(true-or-false? ____ (equal '(1 3 5) `(1 3 5)))
(true-or-false? ____ (equal '(1 3 5) `(1 3 number)))
(assert-equal ____ `(1 3 ,number))
(assert-equal _____ `(word ,word ,word word))))
(true-or-false? t (equal '(1 3 5) `(1 3 5)))
(true-or-false? nil (equal '(1 3 5) `(1 3 number)))
(assert-equal '(1 3 5) `(1 3 ,number))
(assert-equal '(word dolphin dolphin word) `(word ,word ,word word))))
(define-test splicing
(let ((axis '(x y z)))
(assert-equal '(the axis are ____) `(the axis are ,axis))
(assert-equal '(the axis are ____) `(the axis are ,@axis)))
(assert-equal '(the axis are (x y z)) `(the axis are ,axis))
(assert-equal '(the axis are x y z) `(the axis are ,@axis)))
(let ((coordinates '((43.15 77.6) (42.36 71.06))))
(assert-equal ____ `(the coordinates are ,coordinates))
(assert-equal ____ `(the coordinates are ,@coordinates))))
(assert-equal '(the coordinates are ((43.15 77.6) (42.36 71.06))) `(the coordinates are ,coordinates))
(assert-equal '(the coordinates are (43.15 77.6) (42.36 71.06)) `(the coordinates are ,@coordinates))))

View File

@ -101,7 +101,7 @@
(very-silly-condition #'handle-very-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(signal (make-condition 'most-silly-condition)))
(assert-equal ____ *list*)))
(assert-equal '(:most-silly-condition :very-silly-condition :silly-condition) *list*)))
(define-test multiple-handler-binds
;; It is possible to bind handlers in steps.
@ -110,7 +110,7 @@
(most-silly-condition #'handle-most-silly-condition))
(handler-bind ((very-silly-condition #'handle-very-silly-condition))
(signal (make-condition 'most-silly-condition))))
(assert-equal ____ *list*)))
(assert-equal '(:most-silly-condition :silly-condition :very-silly-condition) *list*)))
(define-test same-handler
;; The same handler may be bound multiple times.
@ -121,7 +121,7 @@
(silly-condition #'handle-silly-condition)
(very-silly-condition #'handle-very-silly-condition))
(signal (make-condition 'most-silly-condition))))
(assert-equal ____ *list*)))
(assert-equal '(:silly-condition :silly-condition :very-silly-condition :silly-condition :very-silly-condition ) *list*)))
(define-test handler-types
;; A handler is not executed if it does not match the condition type.
@ -130,7 +130,7 @@
(very-silly-condition #'handle-very-silly-condition)
(most-silly-condition #'handle-most-silly-condition))
(signal (make-condition 'very-silly-condition)))
(assert-equal ____ *list*)))
(assert-equal '(:very-silly-condition :silly-condition) *list*)))
(define-test handler-transfer-of-control
;; A handler may decline to handle the condition if it returns normally,
@ -143,7 +143,7 @@
(return-from my-block)))
(silly-condition #'handle-silly-condition))
(signal (make-condition 'silly-condition))))
(assert-equal ____ *list*)))
(assert-equal '(:silly-condition) *list*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -163,7 +163,7 @@
(handler-case (signal (make-condition 'my-error))
(error (condition) (handle-error condition))
(my-error (condition) (handle-my-error condition)))
(assert-equal ____ *list*)))
(assert-equal '(:error) *list*))) ; well, I don't really understand that
(define-test handler-case-order
;; The order of handler cases matters.
@ -171,7 +171,7 @@
(handler-case (signal (make-condition 'my-error))
(my-error (condition) (handle-my-error condition))
(error (condition) (handle-error condition)))
(assert-equal ____ *list*)))
(assert-equal '(:my-error) *list*)))
(define-test handler-case-type
;; A handler cases is not executed if it does not match the condition type.
@ -179,7 +179,16 @@
(handler-case (signal (make-condition 'error))
(my-error (condition) (handle-my-error condition))
(error (condition) (handle-error condition)))
(assert-equal ____ *list*)))
(assert-equal '(:error) *list*)))
;;; it seems that difference between #'handler-case and #'handler-bind
;; is that first is like try-catch, where single, first condition for signal is executed
;; (and expressions are not handlers, but things to evaluate)
;; and handler-bind executes all handlers applicable?
;; here handlers are functions
;; http://www.lispworks.com/documentation/HyperSpec/Body/09_ada.htm
;; here it seems that handler can either transfer control - by return-from of return
;; and that "handles" the signal, or "decline" by returning, that that means that following handlers get called
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -199,36 +208,37 @@
(handler-case (divide numerator denominator)
(division-by-zero () :division-by-zero)
(type-error () :type-error))))
(assert-equal ____ (try-to-divide 6 2))
(assert-equal ____ (try-to-divide 6 0))
(assert-equal ____ (try-to-divide 6 :zero))))
(assert-equal 3 (try-to-divide 6 2))
(assert-equal :division-by-zero (try-to-divide 6 0))
(assert-equal :type-error (try-to-divide 6 :zero))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Condition objects can contain metadata about the specific situation that
;;; occurred in the code.
(define-test accessors-division-by-zero
(let ((condition (handler-case (divide 6 0) (division-by-zero (c) c))))
(setq my-cond (handler-case (divide 6 0) (division-by-zero (c) c)))
(let ((my-cond (handler-case (divide 6 0) (division-by-zero (c) c))))
;; Disabled on CLISP and ABCL due to conformance bugs.
;; See https://gitlab.com/gnu-clisp/clisp/-/issues/22
;; See https://github.com/armedbear/abcl/issues/177
#-(or clisp abcl)
(assert-equal ____ (arithmetic-error-operands condition))
(let ((operation (arithmetic-error-operation condition)))
(assert-equal '(6 0) (arithmetic-error-operands my-cond)) ; returns '(6 0)
(let ((operation (arithmetic-error-operation my-cond))) ; returns #'/ holy cow
;; Disabled on ABCL due to a conformance bug.
;; See https://github.com/armedbear/abcl/issues/177
#-abcl
(assert-equal ____ (funcall operation 12 4)))))
(assert-equal 3 (funcall operation 12 4)))))
(setq my-condition (handler-case (divide 6 :zero) (type-error (c) c)))
(define-test accessors-type-error
(let ((condition (handler-case (divide 6 :zero) (type-error (c) c))))
(assert-equal ____ (type-error-datum condition))
(let ((expected-type (type-error-expected-type condition)))
(true-or-false? ____ (typep :zero expected-type))
(true-or-false? ____ (typep 0 expected-type))
(true-or-false? ____ (typep "zero" expected-type))
(true-or-false? ____ (typep 0.0 expected-type)))))
(assert-equal :zero (type-error-datum my-condition))
(let ((expected-type (type-error-expected-type my-condition)))
(true-or-false? nil (typep :zero expected-type))
(true-or-false? t (typep 0 expected-type))
(true-or-false? nil (typep "zero" expected-type))
(true-or-false? t (typep 0.0 expected-type)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -256,12 +266,12 @@
(flet ((try-log-line-type (line)
(handler-case (log-line-type line)
(error (condition) condition))))
(assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39"))
(assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1"))
(assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2"))
(assert-equal :timestamp (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39"))
(assert-equal :http (try-log-line-type "HTTP GET / from 127.0.0.1"))
(assert-equal :login (try-log-line-type "LOGIN administrator:hunter2"))
(let ((condition (try-log-line-type "WARNING: 95% of disk space used")))
(assert-equal ____ (line condition))
(assert-equal ____ (reason condition)))
(assert-equal "WARNING: 95% of disk space used" (line condition))
(assert-equal :unknown-log-line-type (reason condition)))
(let ((condition (try-log-line-type 5555)))
(assert-equal 'string (____ condition))
(assert-equal 5555 (____ condition)))))
(assert-equal 'string (type-error-expected-type condition))
(assert-equal 5555 (type-error-datum condition)))))

View File

@ -18,20 +18,29 @@
(defclass dice-set ()
;; Fill in the blank with a proper slot definition.
(____))
((dice-values :initarg :dice-values)))
(setq *my-dice* (make-instance 'dice-set :dice-values '(1 2 3 5)))
(slot-value *my-dice* 'dice-values)
;;; This method might be unnecessary, depending on how you define the slots of
;;; DICE-SET.
(defmethod dice-values ((object dice-set))
____)
(slot-value object 'dice-values))
(defmethod roll (count (object dice-set))
____)
(unless (and (integerp count) (< 0 count)) (signal (make-condition 'type-error
:datum count
:expected-type 'integer)))
(let ((rolls (mapcar (lambda (x) (declare (ignore x)) (+ 1 (random 6))) (make-list count))))
(setf (slot-value object 'dice-values) rolls)))
(roll 5 *my-dice*)
(define-test make-dice-set
(let ((dice (make-instance 'dice-set)))
(assert-true (typep dice 'dice-set))))
(let ((dice (make-instance 'dice-set)))
(assert-true (typep dice 'dice-set))))
(define-test dice-are-six-sided
(let ((dice (make-instance 'dice-set)))
@ -73,21 +82,34 @@
(assert-equal 100 (length (roll 100 dice)))
(assert-equal 1 (length (roll 1 dice)))))
;; this is about signaling error, rhg
;; but wtf about expected-type being subtype of '(integer 1 6) ???
;; shouldn't it be any integer?
(define-test junk-as-dice-count
(let ((dice (make-instance 'dice-set)))
(labels ((dice-failure (count)
(handler-case (progn (roll count dice)
(error "Test failure"))
(error (condition) condition)))
(test-dice-failure (value)
(let* ((condition (dice-failure value))
(expected-type (type-error-expected-type condition)))
(assert-true (typep condition 'type-error))
(assert-equal value (type-error-datum condition))
(assert-true (subtypep '(integer 1 6) expected-type)))))
(test-dice-failure 0)
(test-dice-failure "0")
(test-dice-failure :zero)
(test-dice-failure 18.0)
(test-dice-failure -7)
(test-dice-failure '(6 6 6)))))
(let ((dice (make-instance 'dice-set)))
(labels ((dice-failure (count)
(handler-case (progn (roll count dice)
(error "Test failure"))
(error (condition) condition)))
(test-dice-failure (value)
(let* ((condition (dice-failure value))
(expected-type (type-error-expected-type condition)))
(assert-true (typep condition 'type-error))
(assert-equal value (type-error-datum condition))
(assert-true (subtypep '(integer 1 6) expected-type)) ; wtf is this?
; surely it's got to be just integer?
)))
(test-dice-failure 0)
(test-dice-failure "0")
(test-dice-failure :zero)
(test-dice-failure 18.0)
(test-dice-failure -7)
(test-dice-failure '(6 6 6)))))
;; (setq dice *my-dice*)
;; (dice-failure "0")
;;; welp. signaling errors is the most unfamiliar thing for me

View File

@ -23,4 +23,4 @@
;;; This is a free form assignment, so approach it however you desire.
(define-test play-greed
(assert-true ____))
(assert-true t))

View File

@ -23,19 +23,22 @@
(cond ((null forms) 'nil)
((null (rest forms)) (first forms))
(t `(when ,(first forms)
,(generate (rest forms)))))))
,(generate (rest forms))))))) ; wowy
(generate forms)))
(when (= 2 3) "hello")
(define-test my-and
;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal
;; to the second form.
(assert-expands (my-and (= 0 (random 6)) (error "Bang!"))
'(when (= 0 (random 6)) (error "Bang!")))
;; ASSERT-EXPANDS macroexpands the first form once and checks if it is equal
;; to the second form.
(assert-expands (my-and (= 0 (random 6)) (error "Bang!"))
'(when (= 0 (random 6)) (error "Bang!")))
(assert-expands (my-and (= 0 (random 6))
(= 0 (random 6))
(= 0 (random 6))
(error "Bang!"))
____))
'(when (= 0 (random 6))
(when (= 0 (random 6)) (when (= 0 (random 6)) (error "Bang!"))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -43,16 +46,19 @@
(define-test variable-capture
(macrolet ((for ((var start stop) &body body)
`(do ((,var ,start (1+ ,var))
(limit ,stop))
((> ,var limit))
,@body)))
`(do ((,var ,start (1+ ,var))
(limit ,stop))
((> ,var limit))
,@body)))
(let ((limit 10)
(result '()))
(for (i 0 3)
(push i result)
(assert-equal ____ limit))
(assert-equal ____ (nreverse result)))))
(push i result)
(assert-equal 3 limit))
(assert-equal '(0 1 2 3) (nreverse result))))) ; didn't get it on first tries, ugh
;; oh, ok - then try to use names that wouldn't happen in outside condext
;; so that explicitly defined things in outside context get overshadowed
;; ok
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -60,20 +66,23 @@
;;; meant to be evaluated once.
(define-test multiple-evaluation
;; We use MACROLET for defining a local macro.
(macrolet ((for ((var start stop) &body body)
`(do ((,var ,start (1+ ,var)))
((> ,var ,stop))
,@body)))
(let ((side-effects '())
(result '()))
;; Our functions RETURN-0 and RETURN-3 have side effects.
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal ____ (nreverse result))
(assert-equal ____ (nreverse side-effects)))))
;; We use MACROLET for defining a local macro.
(macrolet ((for ((var start stop) &body body)
`(do ((,var ,start (1+ ,var)))
((> ,var ,stop))
,@body)))
(let ((side-effects '())
(result '()))
;; Our functions RETURN-0 and RETURN-3 have side effects.
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(0 3 3 3 3 3) (nreverse side-effects)))))
; omg, fuck this guessing
; ok, the ,stop was evaluated on each iteraction
; to check "whether to stop"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -81,36 +90,53 @@
;;; subforms.
(define-test wrong-evaluation-order
(macrolet ((for ((var start stop) &body body)
;; The function GENSYM creates GENerated SYMbols, guaranteed to
;; be unique in the whole Lisp system. Because of that, they
;; cannot capture other symbols, preventing variable capture.
(let ((limit (gensym "LIMIT")))
`(do ((,limit ,stop)
(,var ,start (1+ ,var)))
((> ,var ,limit))
,@body))))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal ____ (nreverse result))
(assert-equal ____ (nreverse side-effects)))))
(macrolet ((for ((var start stop) &body body)
;; The function GENSYM creates GENerated SYMbols, guaranteed to
;; be unique in the whole Lisp system. Because of that, they
;; cannot capture other symbols, preventing variable capture.
(let ((limit (gensym "LIMIT")))
`(do ((,limit ,stop)
(,var ,start (1+ ,var)))
((> ,var ,limit))
,@body))))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(3 0) (nreverse side-effects)))))
;; didn't got on first try,
;; but yes, for gensym limit ,stop is evaluated first
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-test for
(macrolet ((for ((var start stop) &body body)
;; Fill in the blank with a correct FOR macroexpansion that is
;; not affected by the three macro pitfalls mentioned above.
____))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(0 3) (nreverse side-effects)))))
(macrolet ((for ((var start stop) &body body)
;; Fill in the blank with a correct FOR macroexpansion that is
;; not affected by the three macro pitfalls mentioned above.
(let ((initial (gensym "INITIAL"))
(limit (gensym "LIMIT")))
`(do* ((,initial ,start)
(,limit ,stop)
(,var ,initial (1+ ,var)))
((> ,var ,limit))
,@body))))
(let ((side-effects '())
(result '()))
(flet ((return-0 () (push 0 side-effects) 0)
(return-3 () (push 3 side-effects) 3))
(for (i (return-0) (return-3))
(push i result)))
(assert-equal '(0 1 2 3) (nreverse result))
(assert-equal '(0 3) (nreverse side-effects)))))
;; (do* ((a (return-0))
;; (b (return-3))
;; (i a (1+ i)))
;; ((> i b))
;; (push i result))
;;
;; so, my mistake was: using DO and trying to cross reference temp vars
;; and mistyping 1+ as 1_

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