/[gcl]/gcl/ansi-tests/cons-test-20.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cons-test-20.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by pfdietz, Wed Oct 23 03:10:23 2002 UTC revision 1.4 by pfdietz, Wed Nov 27 04:22:36 2002 UTC
# Line 10  Line 10 
10  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11  ;;; union  ;;; union
12    
 (defun union-with-check (x y &key test test-not)  
   (let ((xcopy (make-scaffold-copy x))  
         (ycopy (make-scaffold-copy y)))  
     (let ((result (cond  
                    (test (union x y :test test))  
                    (test-not (union x y :test-not test-not))  
                    (t (union x y)))))  
       (if  
           (and (check-scaffold-copy x xcopy)  
                (check-scaffold-copy y ycopy))  
           result  
         'failed))))  
   
 (defun union-with-check-and-key (x y key &key test test-not)  
   (let ((xcopy (make-scaffold-copy x))  
         (ycopy (make-scaffold-copy y)))  
     (let ((result  (cond  
                    (test (union x y :key key :test test))  
                    (test-not (union x y :key key :test-not test-not))  
                    (t (union x y :key key)))))  
       (if  
           (and (check-scaffold-copy x xcopy)  
                (check-scaffold-copy y ycopy))  
           result  
         'failed))))  
   
 (defun check-union (x y z)  
   (and (listp x)  
        (listp y)  
        (listp z)  
        (every #'(lambda (e) (or (member e x)  
                                 (member e y)))  
               z)  
        (every #'(lambda (e) (member e z)) x)  
        (every #'(lambda (e) (member e z)) y)  
        t))  
   
13  (deftest union-1  (deftest union-1
14      (union nil nil)      (union nil nil)
15    nil)    nil)
# Line 205  Line 168 
168    
169  ;; Do large numbers of random units  ;; Do large numbers of random units
170    
 (defun do-random-unions (size niters &optional (maxelem (* 2 size)))  
   (let ((state (make-random-state)))  
     (loop  
        for i from 1 to niters do  
           (let ((x (shuffle (loop for j from 1 to size collect  
                                   (random maxelem state))))  
                 (y (shuffle (loop for j from 1 to size collect  
                                   (random maxelem state)))))  
             (let ((z (union x y)))  
               (let ((is-good (check-union x y z)))  
                 (unless is-good (return (values x y z)))))))  
     nil))  
   
171  (deftest union-24  (deftest union-24
172    (do-random-unions 100 100 200)    (do-random-unions 100 100 200)
173    nil)    nil)

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26