Skip to content
Snippets Groups Projects
Commit 34975263 authored by pfdietz's avatar pfdietz
Browse files

Added more argument order/reevaluation tests. Added error cases for some...

Added more argument order/reevaluation tests.  Added error cases for some builtin macros, and for DESTRUCTURING-BIND.
parent 1d9c754d
No related branches found
No related tags found
No related merge requests found
Showing
with 192 additions and 20 deletions
...@@ -166,3 +166,6 @@ ...@@ -166,3 +166,6 @@
(case 'a (b 'b) (otherwise)) (case 'a (b 'b) (otherwise))
nil) nil)
(deftest case.error.1
(classify-error (case))
program-error)
...@@ -167,8 +167,23 @@ ...@@ -167,8 +167,23 @@
y b) y b)
(deftest ccase.30 (deftest ccase.30
(ccase 'a (a)) (let ((x 'a))
(ccase x (a)))
nil) nil)
;;; Need to add tests for continuability of the error, (deftest ccase.31
;;; and resetting of the place. (handler-bind
((type-error #'(lambda (c) (store-value 7 c))))
(let ((x 0))
(ccase x
(1 :bad)
(7 :good)
(2 nil))))
:good)
(deftest ccase.error.1
(classify-error (ccase))
program-error)
...@@ -64,3 +64,12 @@ ...@@ -64,3 +64,12 @@
(cerror "Wooo" 'simple-error) (cerror "Wooo" 'simple-error)
10)) 10))
10) 10)
(deftest cerror.error.1
(classify-error (cerror))
program-error)
(deftest cerror.error.2
(classify-error (cerror "foo"))
program-error)
...@@ -64,11 +64,17 @@ ...@@ -64,11 +64,17 @@
(ctypecase x (integer) (t 'a))) (ctypecase x (integer) (t 'a)))
nil) nil)
(deftest ctypecase.12
(let ((x 1))
(values
(handler-bind
((type-error #'(lambda (c) (store-value 'a c))))
(ctypecase x
(symbol :good)
(float :bad)))
x))
:good a)
(deftest ctypecase.error.1
(classify-error (ctypecase))
program-error)
...@@ -30,7 +30,16 @@ ...@@ -30,7 +30,16 @@
(defconstant test-constant-3 0) (defconstant test-constant-3 0)
test-constant-3) test-constant-3)
(deftest defconstant.error.1
(classify-error (defconstant))
program-error)
(deftest defconstant.error.2
(classify-error (defconstant +ignorable-constant-name+))
program-error)
(deftest defconstant.error.3
(classify-error (defconstant +ignorable-constant-name2+ nil
"This is a docstring"
"This is an unnecessary extra argument."))
program-error)
\ No newline at end of file
...@@ -63,3 +63,21 @@ ...@@ -63,3 +63,21 @@
i)))) i))))
new-incf2 new-incf2
(3 #(0 0 3 0 0) 3)) (3 #(0 0 3 0 0) 3))
(deftest define-modify-macro.error.1
(classify-error (define-modify-macro))
program-error)
(deftest define-modify-macro.error.2
(classify-error (define-modify-macro dfm-error-1))
program-error)
(deftest define-modify-macro.error.2
(classify-error (define-modify-macro dfm-error-2 ()))
program-error)
(deftest define-modify-macro.error.3
(classify-error (define-modify-macro dfm-error-2 () nil "Documentation"
"extra illegal argument"))
program-error)
...@@ -51,4 +51,19 @@ ...@@ -51,4 +51,19 @@
"And ever." "And ever."
300) 300)
(deftest defparameter.error.1
(classify-error (defparameter))
program-error)
(deftest defparameter.error.2
(classify-error (defparameter *ignored-defparameter-name*))
program-error)
(deftest defparameter.error.3
(classify-error (defparameter *ignored-defparameter-name* nil
"documentation"
"illegal extra argument"))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Feb 16 23:40:32 2003
;;;; Contains: Tests of DEFUN
(in-package :cl-test)
;;; DEFUN is used extensively elsewhere, so I'm just putting error
;;; case tests here
(deftest defun.error.1
(classify-error (defun))
program-error)
(deftest defun.error.2
(classify-error (defun ignored-defun-name))
program-error)
;-*- Mode: Lisp -*- `;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz ;;;; Author: Paul Dietz
;;;; Created: Thu Oct 10 23:21:50 2002 ;;;; Created: Thu Oct 10 23:21:50 2002
;;;; Contains: Tests for DEFVAR ;;;; Contains: Tests for DEFVAR
...@@ -53,3 +53,12 @@ ...@@ -53,3 +53,12 @@
"And ever." "And ever."
200 200
0) 0)
(deftest defvar.error.1
(classify-error (defvar))
program-error)
(deftest defvar.error.2
(classify-error (defvar *ignored-defvar-name* nil "documentation"
"illegal extra argument"))
program-error)
...@@ -80,12 +80,20 @@ ...@@ -80,12 +80,20 @@
(destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c)) (destructuring-bind ((&key a b c)) '((:c 1 :b 2)) (values a b c))
nil 2 1) nil 2 1)
;;; Error cases
(deftest destructuring-bind.error.1
(classify-error (destructuring-bind (a b c) nil (list a b c)))
program-error)
(deftest destructuring-bind.error.2
(classify-error (destructuring-bind ((a b c)) nil (list a b c)))
program-error)
(deftest destructuring-bind.error.3
(classify-error (destructuring-bind (a b) 'x (list a b)))
program-error)
(deftest destructuring-bind.error.4
(classify-error (destructuring-bind (a . b) 'x (list a b)))
program-error)
...@@ -21,6 +21,12 @@ ...@@ -21,6 +21,12 @@
(notnot (second ret-vals)))))) (notnot (second ret-vals))))))
3 t) 3 t)
(deftest function-lambda-expression.order.1
(let ((i 0))
(function-lambda-expression (progn (incf i) #'cons))
i)
1)
(deftest function-lambda-expression.error.1 (deftest function-lambda-expression.error.1
(classify-error (function-lambda-expression)) (classify-error (function-lambda-expression))
program-error) program-error)
......
...@@ -80,6 +80,13 @@ ...@@ -80,6 +80,13 @@
(flet ((%f () nil)) (not-mv (functionp #'%f))) (flet ((%f () nil)) (not-mv (functionp #'%f)))
nil) nil)
(deftest functionp.order.1
(let ((i 0))
(values
(notnot (functionp (progn (incf i) #'cons)))
i))
t 1)
(deftest functionp.error.1 (deftest functionp.error.1
(classify-error (functionp)) (classify-error (functionp))
program-error) program-error)
......
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
(load "defconstant.lsp") (load "defconstant.lsp")
(load "define-modify-macro.lsp") (load "define-modify-macro.lsp")
(load "defparameter.lsp") (load "defparameter.lsp")
(load "defun.lsp")
(load "defvar.lsp") (load "defvar.lsp")
(load "destructuring-bind.lsp") (load "destructuring-bind.lsp")
(load "ecase.lsp") (load "ecase.lsp")
......
...@@ -51,6 +51,20 @@ ...@@ -51,6 +51,20 @@
always (if p q (not q))) always (if p q (not q)))
t) t)
(deftest hash-table-p.3
(let ((i 0))
(values (hash-table-p (incf i)) i))
nil 1)
(deftest hash-table-p.error.1
(classify-error (hash-table-p))
program-error)
(deftest hash-table-p.error.2
(classify-error (let ((h (make-hash-table))) (hash-table-p h nil)))
program-error)
......
...@@ -20,6 +20,11 @@ ...@@ -20,6 +20,11 @@
(eqlt x (check-values (identity x)))) (eqlt x (check-values (identity x))))
t) t)
(deftest identity.order.1
(let ((i 0))
(values (identity (incf i)) i))
1 1)
(deftest identity.error.1 (deftest identity.error.1
(classify-error (identity)) (classify-error (identity))
program-error) program-error)
......
...@@ -29,4 +29,20 @@ ...@@ -29,4 +29,20 @@
(deftest if.7 (if nil 'a (values))) (deftest if.7 (if nil 'a (values)))
(deftest if.order.1
(let ((i 0))
(values (if (= (incf i) 1) 't nil) i))
t 1)
(deftest if.error.1
(classify-error (if))
program-error)
(deftest if.error.2
(classify-error (if t 1 2 3))
program-error)
...@@ -86,6 +86,13 @@ ...@@ -86,6 +86,13 @@
y) y)
"edcba") "edcba")
(deftest nreverse.order.1
(let ((i 0))
(values
(nreverse (progn (incf i) (list 'a 'b 'c 'd)))
i))
(d c b a) 1)
(deftest nreverse.error.1 (deftest nreverse.error.1
(classify-error (nreverse 'a)) (classify-error (nreverse 'a))
type-error) type-error)
......
...@@ -89,6 +89,13 @@ ...@@ -89,6 +89,13 @@
y) y)
"edcba") "edcba")
(deftest reverse.order.1
(let ((i 0))
(values
(reverse (progn (incf i) (list 'a 'b 'c 'd)))
i))
(d c b a) 1)
;;; Error cases ;;; Error cases
(deftest reverse.error.1 (deftest reverse.error.1
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment