cdeeb2fead
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
91 lines
3.9 KiB
Common Lisp
91 lines
3.9 KiB
Common Lisp
;;; Copyright 2013 Google Inc.
|
|
;;;
|
|
;;; 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.
|
|
|
|
(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))
|
|
(assert-equal :equilateral (triangle 10 10 10)))
|
|
|
|
(define-test isosceles-triangles
|
|
;; Isosceles triangles have two sides of equal length,
|
|
(assert-equal :isosceles (triangle 3 4 4))
|
|
(assert-equal :isosceles (triangle 4 3 4))
|
|
(assert-equal :isosceles (triangle 4 4 3))
|
|
(assert-equal :isosceles (triangle 2 2 3))
|
|
(assert-equal :isosceles (triangle 10 10 2)))
|
|
|
|
(define-test scalene-triangles
|
|
;; Scalene triangles have three sides of different lengths.
|
|
(assert-equal :scalene (triangle 3 4 5))
|
|
(assert-equal :scalene (triangle 10 11 12))
|
|
(assert-equal :scalene (triangle 5 4 2)))
|
|
|
|
(defun triangle-failure (a b c)
|
|
(handler-case (progn (triangle a b c) (error "Test failure"))
|
|
(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)))))
|