Commit 2df5d42f authored by pfdietz's avatar pfdietz

Added comments for FUNCTION, FUNCTIONP, FBOUNDP tests. Added tests for more parts of LOOP.

parent 6124d1ca
......@@ -40,19 +40,20 @@
nil)
(deftest fboundp.8
(catch-type-error (fboundp 1))
(classify-error (fboundp 1))
type-error)
(deftest fboundp.9
(catch-type-error (fboundp #\a))
(classify-error (fboundp #\a))
type-error)
(deftest fboundp.10
(catch-type-error (fboundp '(foo)))
(classify-error (fboundp '(foo)))
type-error)
......@@ -14,6 +14,8 @@
(typep nil 'function)
nil)
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, symbols are no longer of type FUNCTION.
(deftest function.2
(typep 'identity 'function)
nil)
......@@ -39,6 +41,8 @@
(typep '(setf car) 'function)
nil)
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, lambda forms are no longer of type FUNCTION.
(deftest function.6
(typep '(lambda (x) x) 'function)
nil)
......@@ -59,10 +63,13 @@
(not (typep (compile nil '(lambda (x) x)) 'function))
nil)
;;; The next test demonstrates an incompatibility between CLtL1 and ANSI CL.
;;; In ANSI CL, symbols and cons can no longer also be of type FUNCTION.
(deftest function.10
(loop for x in *universe*
never
(and (or (numberp x) (characterp x) (symbolp x) (consp x)
(and (or (numberp x) (characterp x)
(symbolp x) (consp x)
(typep x 'array))
(typep x 'function)))
t)
......
......@@ -15,6 +15,7 @@
(functionp nil)
nil)
;;; In ANSI CL, symbols can no longer be functions
(deftest functionp.2
(functionp 'identity)
nil)
......@@ -39,6 +40,7 @@
(functionp '(setf car))
nil)
;;; In ANSI CL, lambda forms are no longer functions
(deftest functionp.6
(functionp '(lambda (x) x))
nil)
......@@ -59,10 +61,12 @@
(not (functionp (compile nil '(lambda (x) x))))
nil)
;;; In ANSI CL, symbols and cons can no longer be functions
(deftest functionp.10
(loop for x in *universe*
never
(and (or (numberp x) (characterp x) (symbolp x) (consp x)
(and (or (numberp x) (characterp x)
(symbolp x) (consp x)
(typep x 'array))
(functionp x)))
t)
......
......@@ -80,6 +80,9 @@
(load "loop4.lsp")
(load "loop5.lsp")
(load "loop6.lsp")
(load "loop7.lsp")
(load "loop8.lsp")
(load "loop9.lsp")
;;; Tests of conses
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Mon Nov 11 21:40:05 2002
;;;; Contains: Tests for FOR-AS-PACKAGE clause for LOOP
(in-package :cl-test)
(defpackage "LOOP.CL-TEST.1"
(:use)
(:intern "FOO" "BAR" "BAZ")
(:export "A" "B" "C"))
(defpackage "LOOP.CL-TEST.2"
(:use "LOOP.CL-TEST.1")
(:intern "X" "Y" "Z"))
(deftest loop.7.1
(sort (mapcar #'symbol-name
(loop for x being the symbols of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.2
(sort (mapcar #'symbol-name
(loop for x being each symbol of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.3
(sort (mapcar #'symbol-name
(loop for x being the symbol of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.4
(sort (mapcar #'symbol-name
(loop for x being each symbols of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.5
(sort (mapcar #'symbol-name
(loop for x being the symbols in "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.6
(sort (mapcar #'symbol-name
(loop for x being each symbol in "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.7
(sort (mapcar #'symbol-name
(loop for x being the symbol in "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.8
(sort (mapcar #'symbol-name
(loop for x being each symbols in "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.9
(sort (mapcar #'symbol-name
(loop for x being the external-symbols of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "C"))
(deftest loop.7.10
(sort (mapcar #'symbol-name
(loop for x being each external-symbol in "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "C"))
(deftest loop.7.11
(sort (mapcar #'symbol-name
(loop for x being each external-symbol in (find-package "LOOP.CL-TEST.1") collect x))
#'string<)
("A" "B" "C"))
(deftest loop.7.12
(sort (mapcar #'symbol-name
(loop for x being each external-symbol in :LOOP.CL-TEST.1 collect x))
#'string<)
("A" "B" "C"))
(deftest loop.7.13
(sort (mapcar #'symbol-name
(loop for x being the symbols of "LOOP.CL-TEST.2" collect x))
#'string<)
("A" "B" "C" "X" "Y" "Z"))
(deftest loop.7.14
(sort (mapcar #'symbol-name
(loop for x being the present-symbols of "LOOP.CL-TEST.2" collect x))
#'string<)
("X" "Y" "Z"))
;;; According to the ANSI CL spec, " If the package for the iteration is not supplied,
;;; the current package is used." Thse next tests are of the cases that the package
;;; is not supplied in the loop form.
(deftest loop.7.15
(let ((*package* (find-package "LOOP.CL-TEST.1")))
(sort (mapcar #'symbol-name (loop for x being each symbol collect x))
#'string<))
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.16
(let ((*package* (find-package "LOOP.CL-TEST.1")))
(sort (mapcar #'symbol-name (loop for x being each external-symbol collect x))
#'string<))
("A" "B" "C"))
(deftest loop.7.17
(let ((*package* (find-package "LOOP.CL-TEST.2")))
(sort (mapcar #'symbol-name (loop for x being each present-symbol collect x))
#'string<))
("X" "Y" "Z"))
;;; Cases where the package doesn't exist. According to the standard,
;;; (section 6.1.2.1.7), this should cause a pacakge-error.
(deftest loop.7.18
(progn
(ignore-errors (delete-package "LOOP.MISSING,PACKAGE"))
(classify-error
(loop for x being each symbol of "LOOP.MISSING.PACKAGE" collect x)))
package-error)
(deftest loop.7.19
(progn
(ignore-errors (delete-package "LOOP.MISSING,PACKAGE"))
(classify-error
(loop for x being each present-symbol of "LOOP.MISSING.PACKAGE" collect x)))
package-error)
(deftest loop.7.20
(progn
(ignore-errors (delete-package "LOOP.MISSING,PACKAGE"))
(classify-error
(loop for x being each external-symbol of "LOOP.MISSING.PACKAGE" collect x)))
package-error)
;;; NIL d-var-specs
(deftest loop.7.21
(loop for nil being the symbols of "LOOP.CL-TEST.1" count t)
6)
(deftest loop.7.22
(loop for nil being the external-symbols of "LOOP.CL-TEST.1" count t)
3)
(deftest loop.7.23
(loop for nil being the present-symbols of "LOOP.CL-TEST.2" count t)
3)
;;; Type specs
(deftest loop.7.24
(loop for x t being the symbols of "LOOP.CL-TEST.1" count x)
6)
(deftest loop.7.25
(loop for x t being the external-symbols of "LOOP.CL-TEST.1" count x)
3)
(deftest loop.7.26
(loop for x t being the present-symbols of "LOOP.CL-TEST.2" count x)
3)
(deftest loop.7.27
(loop for x of-type symbol being the symbols of "LOOP.CL-TEST.1" count x)
6)
(deftest loop.7.28
(loop for x of-type symbol being the external-symbols of "LOOP.CL-TEST.1" count x)
3)
(deftest loop.7.29
(loop for x of-type symbol being the present-symbols of "LOOP.CL-TEST.2" count x)
3)
;;; Tests of the 'as' form
(deftest loop.7.30
(sort (mapcar #'symbol-name
(loop as x being the symbols of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.31
(sort (mapcar #'symbol-name
(loop as x being each symbol of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
(deftest loop.7.32
(sort (mapcar #'symbol-name
(loop as x being the symbol of "LOOP.CL-TEST.1" collect x))
#'string<)
("A" "B" "BAR" "BAZ" "C" "FOO"))
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Nov 12 06:30:14 2002
;;;; Contains: Tests of LOOP local variable initialization
(in-package :cl-test)
(deftest loop.8.1
(loop with x = 1 do (return x))
1)
(deftest loop.8.2
(loop with x = 1
with y = (1+ x) do (return (list x y)))
(1 2))
(deftest loop.8.3
(let ((y 2))
(loop with x = y
with y = (1+ x) do (return (list x y))))
(2 3))
(deftest loop.8.4
(let (a b)
(loop with a = 1
and b = (list a)
and c = (list b)
return (list a b c)))
(1 (nil) (nil)))
;;; type specs
(deftest loop.8.5
(loop with a t = 1 return a)
1)
(deftest loop.8.6
(loop with a fixnum = 2 return a)
2)
(deftest loop.8.7
(loop with a float = 3.0 return a)
3.0)
(deftest loop.8.8
(loop with a of-type string = "abc" return a)
"abc")
(deftest loop.8.9
(loop with (a b) = '(1 2) return (list b a))
(2 1))
(deftest loop.8.10
(loop with (a b) of-type (fixnum fixnum) = '(3 4) return (+ a b))
7)
(deftest loop.8.11
(loop with a of-type fixnum return a)
0)
(deftest loop.8.12
(loop with a of-type float return a)
0.0)
(deftest loop.8.13
(loop with a of-type t return a)
nil)
(deftest loop.8.14
(loop with a t return a)
nil)
(deftest loop.8.15
(loop with a t and b t return (list a b))
(nil nil))
(deftest loop.8.16
(loop with (a b c) of-type (fixnum float t) return (list a b c))
(0 0.0 nil))
(deftest loop.8.17
(loop with nil = nil return nil)
nil)
;;; The NIL block of a loop encloses the entire loop.
(deftest loop.8.18
(loop with nil = (return t) return nil)
t)
(deftest loop.8.19
(loop with (nil a) = '(1 2) return a)
2)
(deftest loop.8.20
(loop with (a nil) = '(1 2) return a)
1)
(deftest loop.8.21
(loop with b = 3
and (a nil) = '(1 2) return (list a b))
(1 3))
(deftest loop.8.22
(loop with b = 3
and (nil a) = '(1 2) return (list a b))
(2 3))
;;; The NIL block of a loop encloses the entire loop.
(deftest loop.8.23
(loop
with a = 1
and b = (return 2)
return 3)
2)
;;; Error cases
;;; According to the spec, it is a program-error for any variable to be bound
;;; more than once in loop clauses in the same loop form.
(deftest loop.8.error.1
(classify-error
(loop with a = 1
and a = 2 return a))
program-error)
(deftest loop.8.error.2
(classify-error
(loop with a = 1
with a = 2 return a))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Thu Nov 14 06:25:21 2002
;;;; Contains: Tests for loop value accumulation clauses
(in-package :cl-test)
;;; Tests of COLLECT, COLLECTING
(deftest loop.9.1
(loop for x in '(2 3 4) collect (1+ x))
(3 4 5))
(deftest loop.9.2
(loop for x in '(2 3 4) collecting (1+ x))
(3 4 5))
(deftest loop.9.3
(loop for x in '(0 1 2)
when (eql x 2) do (return 'good)
collect x)
good)
(deftest loop.9.4
(loop for x in '(a b c)
collect (list x) into foo
finally (return (reverse foo)))
((c) (b) (a)))
(deftest loop.9.5
(loop for x in '(a b c)
collecting (list x) into foo
finally (return (reverse foo)))
((c) (b) (a)))
(deftest loop.9.6
(loop for x from 1 to 10
when (evenp x) collect x into foo
when (oddp x) collect x into bar
finally (return (list foo bar)))
((2 4 6 8 10) (1 3 5 7 9)))
(deftest loop.9.7
(loop for x from 1 to 10
collect (if (> x 5) (loop-finish) x))
(1 2 3 4 5))
(deftest loop.9.8
(loop for x from 1 to 20
when (eql (mod x 5) 0) collect x into foo
when (eql (mod x 5) 2) collect x into foo
finally (return foo))
(2 5 7 10 12 15 17 20))
(deftest loop.9.9
(loop for x from 1 to 20
when (eql (mod x 5) 0) collecting x into foo
when (eql (mod x 5) 2) collecting x into foo
finally (return foo))
(2 5 7 10 12 15 17 20))
(deftest loop.9.10
(classify-error
(loop with foo = '(a b)
for x in '(c d) collect x into foo
finally (return foo)))
program-error)
(deftest loop.9.11
(classify-error
(loop with foo = '(a b)
for x in '(c d) collecting x into foo
finally (return foo)))
program-error)
;;; Tests of APPEND, APPENDING
(deftest loop.9.20
(loop for x in '((a b) (c d) (e f g) () (i)) append x)
(a b c d e f g i))
(deftest loop.9.21
(loop for x in '((a b) (c d) (e f g) () (i)) appending x)
(a b c d e f g i))
(deftest loop.9.22
(loop for x in '((a) (b) (c . whatever)) append x)
(a b c . whatever))
(deftest loop.9.23
(loop for x in '((a) (b) (c . whatever)) appending x)
(a b c . whatever))
;;; More to go here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment