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