Interlisp.medley/internal/test/LANGUAGE/AUTO/PACKAGE-ARS.TEST

;;
;;	Creation date:  Jan 26, 1987
;;
;;	Created by:     Karin M. Sye
;;
;;	Regression tests for the Lyric Package System Ars
;;
;;	AR 6713
;;
(do-test "package-ar6713: (PACKAGE-NICKNAMES package) returns the primary name of a package"
	(prog2 
		(make-package "pac" :nicknames '("pac1" "pac2" "pac3" ))
		(notany #'(lambda (x y) (find x (package-nicknames y) #'string=)) '("LISP" "pac") '(lisp "pac"))
		(xcl:delete-package "pac")
	 )
)
;;
;;	AR 6632 
;;
(do-test "package-ar6632: CTYPECASE should be in the LISP package"
	(find-symbol "CTYPECASE" 'lisp))
;;
;;	AR 6652
;;
(do-test "package-ar6652: ARG NOT PACKAGE wrong error attempting to read PHYLEX:PARC:XEROX"
   (and 
	(catch 'bar (handler-bind  (( xcl:missing-package  #'(lambda (x) (throw 'bar t))  )
						  ( xcl:condition        #'(lambda (x) (throw 'bar nil))   )
						 )
				
				(progn
						(read (make-string-input-stream "PHYLEX:PARC"))
						 nil
				)
			  )
	)
	(catch 'bar (handler-bind  (( xcl:symbol-colon-error  #'(lambda (x) (throw 'bar t))  )
						  ( xcl:condition        #'(lambda (x) (throw 'bar nil))   )
						 )
				
				(progn
						(read (make-string-input-stream "PHYLEX:PARC:XEROX"))
						 nil
				)
			  )
	)
  )
) 
								
;;
;;	AR 6700
;;
(do-test "package-ar6700: Symbols in wrong package"
   (and
	(every #'(lambda(x) (find-symbol x 'lisp)) '(copy-symbol make-symbol intern gentemp keywordp))
	(find-symbol 'make-keyword 'il)
   )
)
;;
;;	AR 6742
;;
(do-test "package-ar6742: Shadowing-Import does not seem to add imported symbols to the shadowing-symbols list"
	(unwind-protect
			(progn	(make-package 'abc :use nil)
					(shadowing-import '(lisp:if lisp:numberp) 'abc)
					(or (equal (package-shadowing-symbols 'abc) '(if numberp))
					    (equal (package-shadowing-symbols 'abc) '(numberp if))))
			(xcl:delete-package 'abc)
	)
)
;;
;;	AR 6822
;;
(do-test "package-ar6822: Various package related bugs in cmlarray and friends (adjustable-array-p, *default-PUSH-EXTENSION-SIZE*, and CHAR were in the wrong place)"

	(and (find-symbol 'adjustable-array-p 'lisp)
		(find-symbol '*default-PUSH-EXTENSION-SIZE* 'xcl)
		(find-symbol 'CHAR 'lisp)
	)
)
;;
;;	AR 6835
;;
(do-test "package-ar6835: DEFPACKAGE fails for shadowing-import or shadow"
	(prog1
		  (and  (xcl:defpackage "foo" (:shadow bar))
			   (xcl:defpackage "fooo" (:shadowing-import cl:*)))
		  (xcl:delete-package "foo")
		  (xcl:delete-package "fooo")
	)
)	   
;;
;;	AR 6858 
;;
(do-test "package-ar6858: The variable *modules* should be in CML package rather than in Interlisp package"
	(string= (package-name (symbol-package '*modules*)) "LISP"))

;;
;;	AR 6888
;;
(do-test "package-ar6888 :  XCL:DELETE-PACKAGE should un-USE the dying package"
	(and
		(unwind-protect
			(progn
				(make-package 'p1)
				(make-package 'p2)
				(use-package 'p1 (find-package 'p2))
				(xcl:delete-package (find-package 'p2))
				(null (package-used-by-list (find-package 'p1)))
			)
			(xcl:delete-package (find-package 'p1))
		)
 
		(unwind-protect 
			(progn 
				(make-package "p3" :use nil)
				(make-package "p2" :use "p3")
				(make-package "p1" :use "p2")
				(xcl:delete-package "p2")
				(null (or (package-used-by-list "p3") (package-use-list "p1")))
			)
		     (xcl:delete-package "p1") 
			(xcl:delete-package "p3")
		)
	)
)
;;
;;	AR 6889
;;
(do-test "package-ar6889: Export interns NIL in package being exported from"
	(unwind-protect (progn
						(make-package 'pack :use nil)
						(intern "PRIVATE" 'pack)
						(export (intern "PUBLIC" 'pack) 'pack)
						(null (multiple-value-bind (name where) (find-symbol 'nil 'pack) where))
				)
				(xcl:delete-package 'pack)
	)
)
;;
;;	AR 6908
;;
(do-test "package-ar6908: Need do-internal-symbols for consistency"
	(let ((pac (make-package  "PAC" :use nil)) buf)
		(progn
				(import '(cl:if cl:do cl:when cl:unless cl:let) pac)
				(xcl:do-internal-symbols (x pac (xcl:delete-package pac)) (push (symbol-name x) buf))
				(every #'(lambda (x) (find x buf :test #'equal)) '("IF" "DO" "WHEN" "UNLESS" "LET"))
		)
	)
)

;;
;;	AR 6909
;;
(do-test "package-ar6909shadowing-use-package removed from system"
	(not (fboundp 'shadowing-use-package))
)
;;
;;	AR 6941
;;
(do-test "package-ar6941: INTERN FOO NIL should make an uninterned symbol"
	(null (symbol-package (intern "FOO" NIL)))
)

;;
;;	AR 7157
;;
(do-test "package-ar7157: Exec symbols not exported [xcl::*eval-function* xcl::*exec-prompt* xcl::*debugger-prompt*]"

	(every #'(lambda (x) (eq :external (second (multiple-value-list (find-symbol x 'xcl))))) 
					'(*eval-function* *exec-prompt* *debugger-prompt*))
)
;;
;;	AR 7233
;;
(do-test "package-ar7233:  IMPORT function interns NIL in package being imported to"
	
	(progn
		(make-package "pac" :use nil)
		(import 'cl:if (find-package "pac"))
		(prog1 
			(null (multiple-value-bind (name where) (find-symbol 'nil "pac") where))
			(xcl:delete-package "pac")
		)
	)
)
;;
;;	AR 7240
;;
(do-test "package-ar7240: UNINTERN fails to remove the symbol from the package's shadowing-symbols list"
	(progn
		(make-package 'pac :use nil)
		(shadowing-import 'lisp:if 'pac)
		(unintern 'if 'pac)
		(prog1
			(null (package-shadowing-symbols 'pac))
			(xcl:delete-package 'pac)
		)
	)
) 
;;
;;	AR 7285 
;;
(do-test "package-ar7285: symbol-colon-error conditrion should be exported from the XCL package"
	
	(eq :external (cadr (multiple-value-list (find-symbol 'symbol-colon-error 'xcl))))
)
;;
;;	AR 7344
(do-test "package-ar7344: import returns nil instead of t in 21-Jan-87 sysout"

	(prog2
		(make-package 'pac :use nil)
		(import 'il:plus 'pac)
		(xcl:delete-package 'pac)
	)
)
;;
;;	AR 8057
;;
(do-test "package-ar8057: Missing symbols from the LISP package"

	(every
		#'(lambda (name) (multiple-value-bind (symbol where) (find-symbol name "LISP") (eq where :external) ))
		'("SPEED" "SPACE" "SAFETY" "COMPILATION-SPEED")
	)
)
;;
;;	AR 8130
;;
(do-test "defpackage foo (:use nil)) breaks"

	(prog2
		(if (find-package 'foo) (xcl:delete-package 'foo))
		(defpackage foo (:use nil))
		(xcl:delete-package 'foo)
	)
)

STOP