From 2634960b306d1076f3dc188bacdf32fddba4ccd6 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 26 Dec 2004 15:58:08 +0000 Subject: [PATCH] Error handling of calls to user-defined functions --- ansi-tests/defun.lsp | 70 +++++++++++++++++++++++++++++++++----------- 1 file changed, 53 insertions(+), 17 deletions(-) diff --git a/ansi-tests/defun.lsp b/ansi-tests/defun.lsp index 5ac3508d..9b4e3299 100644 --- a/ansi-tests/defun.lsp +++ b/ansi-tests/defun.lsp @@ -5,23 +5,6 @@ (in-package :cl-test) -(deftest defun.error.1 - (signals-error (funcall (macro-function 'defun)) - program-error) - t) - -(deftest defun.error.2 - (signals-error (funcall (macro-function 'defun) - '(defun nonexistent-function ())) - program-error) - t) - -(deftest defun.error.3 - (signals-error (funcall (macro-function 'defun) - '(defun nonexistent-function ()) - nil nil) - program-error) - t) ;;; Tests for implicit blocks @@ -60,3 +43,56 @@ (defun (setf defun-test-fun-4) (newval x) (return-from defun-test-fun-4 (setf (car x) newval)))) +;;; Error tests + +(deftest defun.error.1 + (signals-error (funcall (macro-function 'defun)) + program-error) + t) + +(deftest defun.error.2 + (signals-error (funcall (macro-function 'defun) + '(defun nonexistent-function ())) + program-error) + t) + +(deftest defun.error.3 + (signals-error (funcall (macro-function 'defun) + '(defun nonexistent-function ()) + nil nil) + program-error) + t) + +;;; More comprehensive error handling tests of calls to +;;; user-defined functions + +(deftest defun.error.4 + (let* ((name (gensym))) + (loop for i below (min 100 lambda-parameters-limit) + for params = nil then (cons (gensym) params) + for args = nil then (cons nil args) + for expected = '(1 2 3) + for fn = (eval `(prog2 (proclaim '(optimize (safety 0))) + (defun ,name ,params (values ,@expected)) + (proclaim '(optimize safety)))) + when + (cond + ((not (equal (multiple-value-list (apply fn args)) expected)) + (list i :fail1)) + ((not (equal (multiple-value-list + (apply (symbol-function fn) args)) + expected)) + (list i :fail2)) + ((not (equal (multiple-value-list (eval `(,name ,@args))) + expected)) + (list i :fail3)) + ;; Error cases + ((and (> i 0) + (let ((val (eval `(signals-error (,name ,@(cdr args)) program-error)))) + (and (not (eq val t)) :fail4)))) + ((and (< i (1- call-arguments-limit)) + (let ((val (eval `(signals-error (,name nil ,@args) program-error)))) + (and (not (eq val t)) :fail5))))) + collect it)) + nil) + -- GitLab