Compare commits
5 Commits
f4759c5685
...
ecf12d390d
Author | SHA1 | Date |
---|---|---|
|
ecf12d390d | |
|
063c5c52d1 | |
|
cdeeb2fead | |
|
586f06fbf2 | |
|
b4fe711abb |
|
@ -1 +1,2 @@
|
|||
/.direnv/
|
||||
/music/
|
||||
|
|
|
@ -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))))
|
||||
|
|
|
@ -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)))))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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_
|
||||
|
|
|
@ -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)))))
|
||||
|
|
Loading…
Reference in New Issue