/[gcl]/gcl/ansi-tests/packages-04.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/packages-04.lsp

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

revision 1.4 by pfdietz, Mon Jan 13 14:11:50 2003 UTC revision 1.5 by pfdietz, Sat Jan 18 18:14:02 2003 UTC
# Line 10  Line 10 
10  ;;; intern  ;;; intern
11    
12  (deftest intern-1  (deftest intern-1
13    (let ((p (make-package "TEMP1")))    (progn
14      (multiple-value-bind (sym1 status1)      (safely-delete-package "TEMP1")
15          (find-symbol "FOO" p)      (let ((p (make-package "TEMP1")))
16        (intern "FOO" p)        (multiple-value-bind (sym1 status1)
       (multiple-value-bind (sym2 status2)  
17            (find-symbol "FOO" p)            (find-symbol "FOO" p)
18          (and (null sym1)          (intern "FOO" p)
19               (null status1)          (multiple-value-bind (sym2 status2)
20               (string= (symbol-name sym2) "FOO")              (find-symbol "FOO" p)
21               (eqt (symbol-package sym2) p)            (and (null sym1)
22               (eqt status2 :internal)                 (null status1)
23               (progn (delete-package p) t)))))                 (string= (symbol-name sym2) "FOO")
24                   (eqt (symbol-package sym2) p)
25                   (eqt status2 :internal)
26                   (progn (delete-package p) t))))))
27    t)    t)
28    
29  (deftest intern-2  (deftest intern-2
30    (let ((p (make-package "TEMP1")))    (progn
31      (multiple-value-bind (sym1 status1)      (safely-delete-package "TEMP1")
32          (find-symbol "FOO" "TEMP1")      (let ((p (make-package "TEMP1")))
33        (intern "FOO" "TEMP1")        (multiple-value-bind (sym1 status1)
34        (multiple-value-bind (sym2 status2)            (find-symbol "FOO" "TEMP1")
35            (find-symbol "FOO" p)          (intern "FOO" "TEMP1")
36          (and (null sym1)          (multiple-value-bind (sym2 status2)
37               (null status1)              (find-symbol "FOO" p)
38               (string= (symbol-name sym2) "FOO")            (and (null sym1)
39               (eqt (symbol-package sym2) p)                 (null status1)
40               (eqt status2 :internal)                 (string= (symbol-name sym2) "FOO")
41               (progn (delete-package p) t)))))                 (eqt (symbol-package sym2) p)
42                   (eqt status2 :internal)
43                   (progn (delete-package p) t))))))
44    t)    t)
45    
46  (deftest intern.error.1  (deftest intern.error.1
# Line 46  Line 50 
50  (deftest intern.error.2  (deftest intern.error.2
51    (classify-error (intern "X" "CL" nil))    (classify-error (intern "X" "CL" nil))
52    program-error)    program-error)
   

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

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