/[gcl]/gcl/ansi-tests/cl-test-package.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cl-test-package.lsp

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

revision 1.11 by pfdietz, Mon Nov 1 13:18:43 2004 UTC revision 1.12 by pfdietz, Sat Jun 4 17:37:12 2005 UTC
# Line 3  Line 3 
3  ;;;; Created:  Sat Mar 14 10:13:21 1998  ;;;; Created:  Sat Mar 14 10:13:21 1998
4  ;;;; Contains: CL test case package definition  ;;;; Contains: CL test case package definition
5    
 #|  
 (progn  
   (defpackage :cl-test  
     (:use :cl :regression-test)  
     (:nicknames)  
     (:shadow #:handler-case #:handler-bind)  
     (:import-from "COMMON-LISP-USER" #:compile-and-load)  
     (:export #:random-from-seq #:random-case #:coin #:random-permute))  
   (let ((s (find-symbol "QUIT" "CL-USER")))  
     (when s (import s :cl-test))))  
 |#  
   
6  (let* ((name :cl-test)  (let* ((name :cl-test)
7         (pkg (find-package name)))         (pkg (find-package name)))
8    (unless pkg (setq pkg (make-package name :use '(#-wcl :cl #+wcl :lisp :regression-test))))    (unless pkg (setq pkg (make-package name :use '(:cl :regression-test))))
9    (let ((*package* pkg))    (let ((*package* pkg))
10      (shadow '(#:handler-case #:handler-bind))      (shadow '(#:handler-case #:handler-bind))
11      (import '(#-wcl common-lisp-user::compile-and-load      (import '(common-lisp-user::compile-and-load)
               #+wcl user::compile-and-load)  
12              pkg)              pkg)
13      (export (mapcar #'intern (mapcar #'symbol-name '(#:random-from-seq #:random-case #:coin #:random-permute)))))      (export (mapcar #'intern
14                        (mapcar #'symbol-name
15                                '(#:random-from-seq #:random-case #:coin
16                                  #:random-permute #:*universe* #:*mini-universe*
17                                  #:signals-error #:typef)))))
18    (let ((s (find-symbol "QUIT" "CL-USER")))    (let ((s (find-symbol "QUIT" "CL-USER")))
19      (when s (import s :cl-test))))      (when s (import s :cl-test))))
20    

Legend:
Removed from v.1.11  
changed lines
  Added in v.1.12

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