Commit 1f4744f6 authored by pfdietz's avatar pfdietz

Moved randomization functions to their own file. Added some new elements to...

Moved randomization functions to their own file.  Added some new elements to *universe*.  Added more class redefinition tests.
parent 71bd45e3
......@@ -405,31 +405,6 @@ the condition to go uncaught if it cannot be classified."
(defun symbol< (x &rest args)
(apply #'string< (symbol-name x) (mapcar #'symbol-name args)))
(defun random-from-seq (seq)
"Generate a random member of a sequence."
(let ((len (length seq)))
(assert (> len 0))
(elt seq (random len))))
(defmacro random-case (&body cases)
(let ((len (length cases)))
(assert (> len 0))
`(case (random ,len)
,@(loop for i from 0 for e in cases collect `(,i ,e))
(t (error "Can't happen?! (in random-case~%")))))
(defun coin (&optional (n 2))
"Flip an n-sided coin."
(eql (random n) 0))
;;; Randomly permute a sequence
(defun random-permute (seq)
(setq seq (copy-seq seq))
(let ((len (length seq)))
(loop for i from len downto 2
do (let ((r (random i)))
(rotatef (elt seq r) (elt seq (1- i))))))
seq)
(defun make-list-expr (args)
"Build an expression for computing (LIST . args), but that evades
......
......@@ -202,4 +202,53 @@
(slot-value (make-instance 'class-0308b :a 'x) 'a))
x)
;;; More class redefinition tests
(deftest class-0309.1
(progn
(setf (find-class 'class-0309) nil)
(let* ((class1 (eval '(defclass class-0309 () ((a) (b) (c)))))
(obj1 (make-instance 'class-0309)))
(setf (class-name class1) nil)
(let ((class2 (eval '(defclass class-0309 () ((a) (b) (c))))))
(values
(eqt (class-of obj1) class1)
(eqt class1 class2)
(typep* obj1 class1)
(typep* obj1 class2)))))
t nil t nil)
(deftest class-0309.2
(progn
(setf (find-class 'class-0310a) nil
(find-class 'class-0310b) nil)
(let* ((class1 (eval '(defclass class-0310a () ((a) (b) (c)))))
(obj1 (make-instance 'class-0310a)))
(setf (class-name class1) 'class-0310b)
(let ((class2 (eval '(defclass class-0310a () ((a) (b) (c))))))
(values
(eqt (class-of obj1) class1)
(eqt class1 class2)
(typep* obj1 class1)
(typep* obj1 class2)
(class-name class1)
(class-name class2)))))
t nil t nil class-0310b class-0310a)
(deftest class-0309.3
(progn
(setf (find-class 'class-0311) nil)
(let* ((class1 (eval '(defclass class-0311 () ((a) (b) (c)))))
(obj1 (make-instance 'class-0311)))
(setf (find-class (class-name class1)) nil)
(let ((class2 (eval '(defclass class-0311 () ((a) (b) (c))))))
(values
(eqt (class-of obj1) class1)
(eqt class1 class2)
(typep* obj1 class1)
(typep* obj1 class2)
(class-name class1)
(class-name class2)
(eqt (find-class 'class-0311) class1)
(eqt (find-class 'class-0311) class2)))))
t nil t nil class-0311 class-0311 nil t)
......@@ -7,6 +7,7 @@
(load "cl-test-package.lsp")
(in-package :cl-test)
(load "universe.lsp")
(compile-and-load "random-aux.lsp")
(compile-and-load "ansi-aux.lsp")
;;; (unless (probe-file "ansi-aux.o") (compile-file "ansi-aux.lsp"))
;;; (load "ansi-aux.o")
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sun Jun 8 06:56:15 2003
;;;; Contains: Aux. functions and macros used for randomization
(in-package :cl-test)
(defun random-from-seq (seq)
"Generate a random member of a sequence."
(let ((len (length seq)))
(assert (> len 0))
(elt seq (random len))))
(defmacro random-case (&body cases)
(let ((len (length cases)))
(assert (> len 0))
`(case (random ,len)
,@(loop for i from 0 for e in cases collect `(,i ,e))
(t (error "Can't happen?! (in random-case~%")))))
(defun coin (&optional (n 2))
"Flip an n-sided coin."
(eql (random n) 0))
;;; Randomly permute a sequence
(defun random-permute (seq)
(setq seq (copy-seq seq))
(let ((len (length seq)))
(loop for i from len downto 2
do (let ((r (random i)))
(rotatef (elt seq r) (elt seq (1- i))))))
seq)
......@@ -347,11 +347,30 @@
(make-bar-structure :x 1 :y 'a :z nil)
))
(defun meaningless-user-function-for-universe (x y z)
(list (+ x 1) (+ y 2) (+ z 3)))
(defgeneric meaningless-user-generic-function-for-universe (x y z)
(:method ((x integer) (y integer) (z integer)) (+ x y z)))
(eval-when (load)
(compile 'meaningless-user-function-for-universe)
(compile 'meaningless-user-generic-function-for-universe)
)
(defvar *functions*
(list #'cons #'car #'append #'values
(macro-function 'cond)
#'meaningless-user-function-for-universe
#'meaningless-user-generic-function-for-universe
#'(lambda (x) x)))
(defvar *methods*
(list
;; Add methods here
))
(defvar *random-states*
(list (make-random-state)))
......@@ -373,6 +392,7 @@
*structures*
*functions*
*random-states*
*methods*
nil)))
(defvar *mini-universe*
......@@ -393,6 +413,7 @@
*readtables*
*structures*
*functions*
*random-states*))
*random-states*
*methods*))
'(;;; Others to fill in gaps
1.2s0 1.3f0 1.5d0 1.8l0 3/5 10000000000000000000000))))
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