home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / tests / pack11.tst < prev    next >
Encoding:
Text File  |  1996-04-15  |  7.6 KB  |  512 lines
  1. ;; packages-test
  2. ;  -------------
  3.  
  4. ;;testfile fuer kapitel 11
  5.  
  6. (packagep  *package*)
  7. T
  8. ;;list-all-packages und typtest
  9. (let ((p (list-all-packages)))
  10.      (every #'packagep p))
  11. T
  12.  
  13. ;;11.6 obligate Paketnamen u. deren Abkuerzungen
  14.  
  15. ;;vorhandensein der standardpakete und find-package dafuer
  16.  
  17. (and (find-package 'lisp) t)
  18. T
  19. (and (find-package 'user) t)
  20. T
  21. (and (find-package 'keyword) t)
  22. T
  23. (and (find-package 'system) t)
  24. T
  25. (and (find-package 'sys) t)
  26. T
  27. (and (find-package "sys") t)
  28. NIL
  29. (and (find-package "sys") t)
  30. NIL
  31. (and (find-package "system") t)
  32. NIL
  33. (and (find-package "SYSTEM") t)
  34. T
  35. (and (find-package "SYS") t)
  36. T
  37.  
  38. ;nicknames
  39. (find "SYS" (package-nicknames 'sys) :test #'string=)
  40. "SYS"
  41.  
  42. ;package-name
  43. (package-name 'sys)
  44. "SYSTEM"
  45. (package-name 'system)
  46. "SYSTEM"
  47. (package-name "USER")
  48. "USER"
  49. (package-name "SYS")
  50. "SYSTEM"
  51.  
  52.  
  53. ;;; 11.7 anlegen von paketen, export import ...
  54.  
  55.   ;package-funktionen mit nutzerdefinierten paketen
  56.  
  57. ;falls test1 bereits existiert
  58. (and (find-package 'test1)
  59.      (in-package 'test1)
  60.      (rename-package (find-package 'test1) 'test1-old)
  61.      nil)
  62. nil
  63.  
  64. ;make-package
  65. (package-name (make-package 'test1 :nicknames '(t1 tst1)))
  66. "TEST1"
  67.  
  68. ;package-use-list
  69. ;(package-use-list (find-package 'test1))
  70. ;("LISP")
  71.  
  72.  
  73. (and (in-package 'test1) T)
  74. T
  75.  
  76.  
  77. (export  '(test1::test1-y test1::test1-z)(find-package
  78. '"TEST1"))
  79. T
  80.  
  81. (export  '(test1::test1-a test1::test1-b test1::test1-c) (find-package
  82. 'test1))
  83. T
  84.  
  85. (setf test1-a -2
  86.       test1-b -1
  87.       test1-c  0
  88.       test1-x  1
  89.       test1-y  2
  90.       test1-z  3)
  91. 3
  92.  
  93. ;falls test2 bereits existiert
  94. (and
  95.         (find-package 'test2)
  96.         (rename-package (find-package 'test2) 'test2-old)
  97.         nil)
  98. nil
  99.  
  100. (package-name (in-package 'test2 :nicknames '("T2" "TST2") :use 'test1))
  101. "TEST2"
  102.  
  103. (lisp:package-name (lisp:find-package 'test2))
  104. "TEST2"
  105.  
  106. (lisp:package-name lisp:*package*)
  107. "TEST2"
  108.  
  109. (lisp:import '(lisp:error) (lisp:find-package 'test2))
  110. LISP:T
  111.  
  112. (lisp:and (lisp:boundp 'test1-x) test1-x)
  113. LISP:NIL
  114.  
  115. (lisp:unintern 'test1-x)
  116. LISP:T
  117.  
  118. (eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
  119. #+XCL 1 #-XCL ERROR
  120.  
  121. (lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
  122. 1
  123.  
  124. (lisp:and (lisp:boundp 'test1-y) test1-y)
  125. #+XCL LISP:NIL #-XCL 2
  126.  
  127. (lisp:unintern 'test1-y)
  128. #+XCL LISP:T #-XCL LISP:NIL
  129.  
  130. (lisp:and (lisp:boundp 'test1:test1-y) test1:test1-y)
  131. #+XCL ERROR #-XCL 2
  132.  
  133. (lisp:and (lisp:boundp 'test1::test1-y) test1::test1-y)
  134. 2
  135.  
  136. (lisp:import  '(test1::test1-x test1::test1-y) (lisp:find-package 'test2))
  137. LISP:T
  138.  
  139. (lisp:and (lisp:boundp 'test1-x) test1-x)
  140. 1
  141.  
  142. (eval (read-from-string "(lisp:and (lisp:boundp 'test1:test1-x) test1:test1-x)"))
  143. #+XCL 1 #-XCL ERROR
  144.  
  145. (lisp:and (lisp:boundp 'test1::test1-x) test1::test1-x)
  146. 1
  147.  
  148. (lisp:and (lisp:boundp 'test1-z) test1-z)
  149. #+XCL LISP:NIL #-XCL 3
  150.  
  151. (lisp:unintern 'test1-z (lisp:find-package 'test2))
  152. #+XCL LISP:T #-XCL LISP:NIL
  153.  
  154. (lisp:and (lisp:boundp 'test1:test1-z) test1:test1-z)
  155. #+XCL ERROR #-XCL 3
  156.  
  157. test1::test1-z
  158. 3
  159.  
  160. (lisp:unexport  '(test1::test1-x test1::test1-y) (lisp:find-package 'test1))
  161. LISP:T
  162.  
  163. (lisp:and (lisp:boundp 'test1-x) test1-x)
  164. 1
  165.  
  166. (lisp:and (lisp:boundp 'test1-y) test1-y)
  167. #+XCL LISP:NIL #-XCL 2
  168.  
  169. (lisp:unintern 'test1-x (lisp:find-package 'test2))
  170. LISP:T
  171.  
  172. (eval (read-from-string "test1:test1-x"))
  173. ERROR
  174.  
  175. test1::test1-x
  176. 1
  177.  
  178. test1-z
  179. 3
  180.  
  181. (lisp:unintern 'test1-z (lisp:find-package 'test2))
  182. #+XCL LISP:T #-XCL LISP:NIL
  183.  
  184. test1:test1-z
  185. 3
  186.  
  187. test1::test1-z
  188. 3
  189.  
  190. (lisp:import 'test1::test1-z (lisp:find-package 'test2))
  191. LISP:T
  192.  
  193. test1-z
  194. 3
  195.  
  196. test1:test1-z
  197. 3
  198.  
  199. test1::test1-z
  200. 3
  201.  
  202. test1-c
  203. #+XCL ERROR #-XCL 0
  204.  
  205. (lisp:unintern 'test-c (lisp:find-package 'test2))
  206. LISP:T
  207.  
  208. test1:test1-c
  209. 0
  210.  
  211. test1::test1-c
  212. 0
  213.  
  214. (lisp:import '(test1::test1-a test1::test1-b test1::test1-c)
  215.              (lisp:find-package 'test2))
  216. LISP:T
  217.  
  218. test1-c
  219. 0
  220.  
  221. test1:test1-c
  222. 0
  223.  
  224. test1::test1-c
  225. 0
  226.  
  227. (lisp:eq 'test1-c 'test1::test1-c)
  228. LISP:T
  229.  
  230.   ;Ende nutzerdefinierte Pakete
  231.  
  232. ;; test in standardmaessig vorgegebenen paketen
  233.  
  234. ; export | import | unintern
  235.  
  236. (lisp:and (lisp:in-package 'user) lisp:T)
  237. LISP:T
  238.  
  239. (setf x 1 y 2 z 3)
  240. 3
  241.  
  242. (and(in-package 'editor)T)
  243. T
  244.  
  245. (unintern 'x)
  246. T
  247.  
  248. (unintern 'y)
  249. T
  250.  
  251. (unintern 'z)
  252. T
  253.  
  254. user::x
  255. 1
  256.  
  257. (eval (read-from-string "user:x"))
  258. ERROR
  259.  
  260. x
  261. error
  262.  
  263. (eq 'x 'user::x)
  264. NIL
  265.  
  266. (unintern 'x)
  267. T
  268.  
  269. (export '(user::x user::y) (find-package 'user))
  270. T
  271.  
  272. user::x
  273. 1
  274.  
  275. user:x
  276. 1
  277.  
  278. x
  279. error
  280.  
  281. (unintern 'x)
  282. T
  283.  
  284. (import 'user:x (find-package 'editor))
  285. T
  286.  
  287. x
  288. 1
  289.  
  290. (eq 'x 'user::x)
  291. t
  292.  
  293. (eq 'x 'user:x)
  294. t
  295.  
  296. (eq 'editor::x 'user::x)
  297. t
  298.  
  299. ;; unexport
  300.  
  301. (and (in-package 'user) T)
  302. T
  303.  
  304. (unexport 'y)
  305. T
  306.  
  307. (and (in-package 'editor) T)
  308. T
  309.  
  310. y
  311. ERROR
  312.  
  313. (eval (read-from-string "user:y"))
  314. ERROR
  315.  
  316. user::y
  317. 2
  318.  
  319. ;; shadowing-import -- zunaechst ohne geerbte symbole!!
  320.  
  321. (and (in-package 'user)(package-name *package*))
  322. "USER"
  323.  
  324. (setf d 4 e 5 f 6 y 111 x 222)
  325. 222
  326.  
  327. (export '(user::a user::b user::c user::y user::x) (find-package 'user))
  328. T
  329.  
  330. (import '(user::a user::b user::c user::y) (find-package 'editor))
  331. ERROR
  332.  
  333. (and (make-package 'shadow-test)(in-package 'shadow-test)t)
  334. T
  335.  
  336. (setf x 'shadow-test)
  337. shadow-test
  338.  
  339. (shadowing-import '(user::d user::e user::f user::x)(find-package 'shadow-test))
  340. T
  341.  
  342. x
  343. 222
  344.  
  345. (eq user::x x)
  346. T
  347.  
  348. ; shadow
  349.  
  350. (shadow '(e f) (find-package 'shadow-test))
  351. t
  352.  
  353. (setf e 'shadow-test-e)
  354. shadow-test-e
  355.  
  356. (eq 'e 'user::e)
  357. #+XCL nil #-XCL t
  358.  
  359. e
  360. shadow-test-e
  361.  
  362. (eval (read-from-string "user:e"))
  363. error
  364.  
  365. user::e
  366. #+XCL 5 #-XCL shadow-test-e
  367.  
  368. ; use-package | unuse-package
  369.  
  370. (and (make-package 'use-test)(in-package 'use-test) t)
  371. t
  372.  
  373. (use-package '(user))
  374. T
  375.  
  376. user::d
  377. 4
  378.  
  379. (eval (read-from-string "user:d"))
  380. #+XCL 4 #-XCL ERROR
  381.  
  382. d
  383. ERROR
  384.  
  385. (unuse-package 'user)
  386. T
  387.  
  388. user::d
  389. 4
  390.  
  391. (eval (read-from-string "user:d"))
  392. ERROR
  393.  
  394. d
  395. ERROR
  396.  
  397. ;make-package mit beutzung eines paketes, dass geerbte symbole enthaelt
  398.  
  399. (and (make-package 'inherit :nicknames '(inh i) )(in-package 'inherit) T)
  400. T
  401.  
  402. (setf a 'inherita b 'inheritb)
  403. inheritb
  404.  
  405. (export '(a b) (find-package 'inherit))
  406. T
  407.  
  408. (and (make-package 'inherit1 :use 'inherit)(in-package 'inherit1) T)
  409. T
  410.  
  411. a
  412. inherit::inherita
  413.  
  414. b
  415. inherit::inheritb
  416.  
  417. (lisp:setf c 'inherit1c)
  418. inherit1c
  419.  
  420. (lisp:and (lisp:make-package 'inherit2 :use 'inherit1)
  421.           (lisp:in-package 'inherit2) lisp:T)
  422. LISP:T
  423.  
  424. a
  425. #+XCL inherita #-XCL LISP:ERROR
  426.  
  427. b
  428. #+XCL inheritb #-XCL LISP:ERROR
  429.  
  430. c
  431. #+XCL inherit1c #-XCL LISP:ERROR
  432.  
  433. (eval (read-from-string "(lisp:eq 'c 'inherit1:c)"))
  434. #+XCL LISP:T #-XCL LISP:ERROR
  435.  
  436. (eval (read-from-string "(lisp:eq 'a 'inherit:a)"))
  437. #+XCL LISP:T #-XCL LISP:ERROR
  438.  
  439. (eval (read-from-string "(lisp:eq 'b 'inherit:b)"))
  440. #+XCL LISP:T #-XCL LISP:ERROR
  441.  
  442. (lisp:eq 'c 'inherit1::c)
  443. #+XCL LISP:T #-XCL LISP:NIL
  444.  
  445. (lisp:eq 'a 'inherit::a)
  446. #+XCL LISP:T #-XCL LISP:NIL
  447.  
  448. (lisp:eq 'b 'inherit::b)
  449. #+XCL LISP:T #-XCL LISP:NIL
  450.  
  451. ;find-all-symbols
  452.  
  453. (lisp:and (lisp:in-package 'user) lisp:T)
  454. LISP:T
  455.  
  456. ; find-all-symbols fehlerhaft
  457. (and (member 'user::x (setf s (find-all-symbols 'x)))T)
  458. T
  459.  
  460. (eval (read-from-string "(and (member 'editor:x s) t)"))
  461. #+XCL T #-XCL ERROR
  462.  
  463. (and (member 'user::x (setf s1 (find-all-symbols 'x)))T)
  464. T
  465.  
  466. (set-difference s s1)
  467. nil                              ;Ende Kommentar
  468.  
  469. ;do-symbols | do-external-symbols | do-all-symbols
  470.  
  471. (setf sym nil
  472.       esym nil
  473.       asym nil
  474. )
  475. nil
  476.  
  477. (do-symbols (s (find-package 'user))(push (symbol-name s) sym))
  478. nil
  479.  
  480. (do-external-symbols (s (find-package 'user))(push (symbol-name s) esym))
  481. nil
  482.  
  483. (do-all-symbols (s)(push (symbol-name s) asym))
  484. nil
  485.  
  486. (find "ESYM" sym :test #'string=)
  487. "ESYM"
  488.  
  489. (find "ESYM" esym :test #'string=)
  490. nil
  491.  
  492. (find "LAMBDA-LIST-KEYWORDS" esym :test #'string=)
  493. #+XCL "LAMBDA-LIST-KEYWORDS" #-XCL NIL
  494.  
  495. ;(count "LAMBDA-LIST-KEYWORDS" asym :test #'string=)
  496. ;T                                                  ;viel zu lang
  497.  
  498. ; modules | provide | (require nicht getestet !)
  499.  
  500. (and *modules* T)
  501. #+XCL T #+CLISP NIL #-(or XCL CLISP) UNKNOWN
  502.  
  503. (and (provide 'provide-test) t)
  504. t
  505.  
  506. (find "PROVIDE-TEST" *modules* :test #'string=)
  507. "PROVIDE-TEST"
  508.  
  509. (format t "End of file")
  510. nil
  511.  
  512.