From 361846e40869ec099e90d89128e2f4a2eec82297 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Wed, 9 Oct 2002 12:28:17 +0000 Subject: [PATCH] Added tests for FLET. --- ansi-tests/aux.lsp | 35 ++++++++----- ansi-tests/flet.lsp | 112 ++++++++++++++++++++++++++++++++++++++++ ansi-tests/gclload2.lsp | 1 + 3 files changed, 135 insertions(+), 13 deletions(-) create mode 100644 ansi-tests/flet.lsp diff --git a/ansi-tests/aux.lsp b/ansi-tests/aux.lsp index 6b615ccc..b8d25612 100644 --- a/ansi-tests/aux.lsp +++ b/ansi-tests/aux.lsp @@ -65,7 +65,7 @@ (error (c) c))) |# -;; Use the next macro in place of SAFE +;;; Use the next macro in place of SAFE (defmacro catch-type-error (form) "Evaluate form in safe mode, returning its value if there is no error. @@ -76,12 +76,21 @@ condition itself on other errors." (type-error () 'type-error) (error (c) c)))) -;; -;; A scaffold is a structure that is used to remember the object -;; identities of the cons cells in a (noncircular) data structure. -;; This lets us check if the data structure has been changed by -;; an operation. -;; +(defmacro classify-error (form) +"Evaluate form in safe mode, returning its value if there is no error. +If an error does occur, return a symbol classify the error, or allow +the condition to go uncaught if it cannot be classified." +`(locally (declare (optimize (safety 3))) + (handler-case ,form + (program-error () 'program-error) + (type-error () 'type-error)))) + +;;; +;;; A scaffold is a structure that is used to remember the object +;;; identities of the cons cells in a (noncircular) data structure. +;;; This lets us check if the data structure has been changed by +;;; an operation. +;;; (defstruct scaffold node @@ -112,11 +121,11 @@ condition itself on other errors." (check-scaffold-copy (cdr x) (scaffold-cdr xcopy)))))) -;; -;; The function SUBTYPEP returns two generalized booleans. -;; This auxiliary function returns two booleans instead -;; (which makes it easier to write tests). -;; +;;; +;;; The function SUBTYPEP returns two generalized booleans. +;;; This auxiliary function returns two booleans instead +;;; (which makes it easier to write tests). +;;; (defun subtypep* (obj type) (multiple-value-bind (result good) (subtypep obj type) @@ -169,7 +178,7 @@ condition itself on other errors." "Flip an n-sided coin." (eql (random n) 0)) -;; Randomly permute a sequence +;;; Randomly permute a sequence (defun random-permute (seq) (setq seq (copy-seq seq)) (let ((len (length seq))) diff --git a/ansi-tests/flet.lsp b/ansi-tests/flet.lsp new file mode 100644 index 00000000..525aeca0 --- /dev/null +++ b/ansi-tests/flet.lsp @@ -0,0 +1,112 @@ +;-*- Mode: Lisp -*- +;;;; Author: Paul Dietz +;;;; Created: Tue Oct 8 22:55:02 2002 +;;;; Contains: Tests of FLET + +(in-package :cl-test) + +(deftest flet.1 + (flet ((%f () 1)) + (%f)) + 1) + +(deftest flet.2 + (flet ((%f (x) x)) + (%f 2)) + 2) + +(deftest flet.3 + (flet ((%f (&rest args) args)) + (%f 'a 'b 'c)) + (a b c)) + +;;; The optional arguments are not in the block defined by +;;; the local function declaration +(deftest flet.4 + (block %f + (flet ((%f (&optional (x (return-from %f 10))) + 20)) + (%f))) + 10) + +(deftest flet.5 + (flet ((%f () (return-from %f 15) 35)) + (%f)) + 15) + +;;; The aux parameters are not in the block defined by +;;; the local function declaration +(deftest flet.6 + (block %f + (flet ((%f (&aux (x (return-from %f 10))) + 20)) + (%f))) + 10) + +;;; The function is not visible inside itself +(deftest flet.7 + (flet ((%f (x) (+ x 5))) + (flet ((%f (y) (cond ((eql y 20) 30) + (t (%f 20))))) + (%f 15))) + 25) + +;;; Keyword arguments +(deftest flet.8 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f)) + nil 0 nil) + +(deftest flet.9 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :a 1)) + 1 0 nil) + +(deftest flet.10 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2)) + nil 2 t) + +(deftest flet.11 + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) + (%f :b 2 :a 3)) + 3 2 t) + +;;; Unknown keyword parameter should throw a program-error in safe code +;;; (section 3.5.1.4) +(deftest flet.12 + (classify-error + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :c 4))) + program-error) + +;;; Odd # of keyword args should throw a program-error in safe code +;;; (section 3.5.1.6) +(deftest flet.13 + (classify-error + (flet ((%f (&key a (b 0 b-p)) (values a b (not (not b-p))))) (%f :a))) + program-error) + +;;; Too few arguments (section 3.5.1.2) +(deftest flet.14 + (classify-error (flet ((%f (a) a)) (%f))) + program-error) + +;;; Too many arguments (section 3.5.1.3) +(deftest flet.15 + (classify-error (flet ((%f (a) a)) (%f 1 2))) + program-error) + +;;; Invalid keyword argument (section 3.5.1.5) +(deftest flet.16 + (classify-error (flet ((%f (&key a) a)) (%f '(foo)))) + program-error) + + + + + + + + + + diff --git a/ansi-tests/gclload2.lsp b/ansi-tests/gclload2.lsp index 1daa7411..e1879878 100644 --- a/ansi-tests/gclload2.lsp +++ b/ansi-tests/gclload2.lsp @@ -9,6 +9,7 @@ (load "constantly.lsp") (load "complement.lsp") (load "fboundp.lsp") +(load "flet.lsp") (load "fmakunbound.lsp") (load "function.lsp") (load "functionp.lsp") -- GitLab