Menu
▾
▴
clisp-cvs digest, Vol 1 #1312 - 7 msgs
|
From: <cli...@li...> - 2005-11-08 22:21:33
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/src/m4 test.m4,1.2,1.3 (Sam Steingold) 2. clisp/src ChangeLog,1.5065,1.5066 (Sam Steingold) 3. clisp/src/autoconf aclocal.m4,1.164,1.165 (Sam Steingold) 4. clisp/src configure,1.141,1.142 (Sam Steingold) 5. clisp/sacla-tests must-hash-table.lisp,1.2,1.3 (Sam Steingold) 6. clisp/sacla-tests must-package.lisp,1.2,1.3 ChangeLog,1.5,1.6 (Sam Steingold) 7. clisp/src defpackage.lisp,1.13,1.14 NEWS,1.282,1.283 ChangeLog,1.5066,1.5067 (Sam Steingold) --__--__-- Message: 1 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src/m4 test.m4,1.2,1.3 Date: Tue, 08 Nov 2005 15:58:32 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src/m4 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9384/src/m4 Modified Files: test.m4 Log Message: (CL_TEST_NT): TEST_NT defaults to "no" Index: test.m4 =================================================================== RCS file: /cvsroot/clisp/clisp/src/m4/test.m4,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- test.m4 1 Nov 2005 22:33:13 -0000 1.2 +++ test.m4 8 Nov 2005 15:58:30 -0000 1.3 @@ -21,6 +21,6 @@ fi rm -f conftestfile1 ]) -TEST_NT="$cl_cv_test_nt" +TEST_NT=${cl_cv_test_nt-no} AC_SUBST(TEST_NT)dnl ]) --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.5065,1.5066 Date: Tue, 08 Nov 2005 15:58:33 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9384/src Modified Files: ChangeLog Log Message: (CL_TEST_NT): TEST_NT defaults to "no" Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5065 retrieving revision 1.5066 diff -u -d -r1.5065 -r1.5066 --- ChangeLog 7 Nov 2005 23:23:08 -0000 1.5065 +++ ChangeLog 8 Nov 2005 15:58:30 -0000 1.5066 @@ -1,3 +1,7 @@ +2005-11-08 Sam Steingold <sd...@gn...> + + * m4/test.m4 (CL_TEST_NT): TEST_NT defaults to "no" + 2005-11-07 Sam Steingold <sd...@gn...> * makemake.in (SACLA_CLISP): run in ANSI mode --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src/autoconf aclocal.m4,1.164,1.165 Date: Tue, 08 Nov 2005 16:15:42 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src/autoconf In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13605/src/autoconf Modified Files: aclocal.m4 Log Message: regenerated Index: aclocal.m4 =================================================================== RCS file: /cvsroot/clisp/clisp/src/autoconf/aclocal.m4,v retrieving revision 1.164 retrieving revision 1.165 diff -u -d -r1.164 -r1.165 --- aclocal.m4 2 Nov 2005 00:15:34 -0000 1.164 +++ aclocal.m4 8 Nov 2005 16:15:40 -0000 1.165 @@ -7588,7 +7588,7 @@ fi rm -f conftestfile1 ]) -TEST_NT="$cl_cv_test_nt" +TEST_NT=${cl_cv_test_nt-no} AC_SUBST(TEST_NT)dnl ]) --__--__-- Message: 4 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src configure,1.141,1.142 Date: Tue, 08 Nov 2005 16:15:43 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13605/src Modified Files: configure Log Message: regenerated Index: configure =================================================================== RCS file: /cvsroot/clisp/clisp/src/configure,v retrieving revision 1.141 retrieving revision 1.142 diff -u -d -r1.141 -r1.142 --- configure 2 Nov 2005 00:15:34 -0000 1.141 +++ configure 8 Nov 2005 16:15:40 -0000 1.142 @@ -4272,7 +4272,7 @@ fi echo "$as_me:$LINENO: result: $cl_cv_test_nt" >&5 echo "${ECHO_T}$cl_cv_test_nt" >&6 -TEST_NT="$cl_cv_test_nt" +TEST_NT=${cl_cv_test_nt-no} { echo "$as_me:$LINENO: * checks for system features" >&5 echo "$as_me: * checks for system features" >&6;} --__--__-- Message: 5 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/sacla-tests must-hash-table.lisp,1.2,1.3 Date: Tue, 08 Nov 2005 21:53:44 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/sacla-tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8958/sacla-tests Modified Files: must-hash-table.lisp Log Message: disable a broken test for clisp Index: must-hash-table.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/sacla-tests/must-hash-table.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- must-hash-table.lisp 25 Oct 2004 11:12:52 -0000 1.2 +++ must-hash-table.lisp 8 Nov 2005 21:53:41 -0000 1.3 @@ -1,19 +1,19 @@ ;; Copyright (C) 2002-2004, Yuji Minejima <ggb...@ni...> ;; ALL RIGHTS RESERVED. ;; -;; $ Id: must-hash-table.lisp,v 1.8 2004/08/09 02:49:54 yuji Exp $ -;; +;; $Id$ +;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: -;; +;; ;; * Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; * Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in ;; the documentation and/or other materials provided with the ;; distribution. -;; +;; ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR @@ -30,13 +30,13 @@ (and (hash-table-p table) (eql (setf (gethash "one" table) 1) 1) (equal (multiple-value-list (gethash (copy-seq "one") table)) - '(NIL NIL)))) + '(NIL NIL)))) (let ((table (make-hash-table :test 'equal))) (and (hash-table-p table) (eql (setf (gethash "one" table) 1) 1) (equal (multiple-value-list (gethash (copy-seq "one") table)) - '(1 T)))) + '(1 T)))) (make-hash-table :rehash-size 1.5 :rehash-threshold 0.7) @@ -53,7 +53,7 @@ (let* ((test-function (symbol-function test)) (hash-table (make-hash-table :test test-function))) (unless (and (hash-table-p hash-table) - (eq (hash-table-test hash-table) test)) + (eq (hash-table-test hash-table) test)) (return nil)))) (hash-table-p (make-hash-table :size 0)) @@ -64,7 +64,7 @@ (hash-table-p (make-hash-table :rehash-size 1)) (hash-table-p (make-hash-table :rehash-size 100)) (hash-table-p (make-hash-table :rehash-size 1.5)) -#-clispxxx (hash-table-p (make-hash-table :rehash-size 1.0)) +#-clisp (hash-table-p (make-hash-table :rehash-size 1.0)) (hash-table-p (make-hash-table :rehash-threshold 0)) (hash-table-p (make-hash-table :rehash-threshold 0.0)) (hash-table-p (make-hash-table :rehash-threshold 0.1)) @@ -78,18 +78,18 @@ (let ((table (make-hash-table :size 0 :rehash-size 1.1 :rehash-threshold 0))) (and (dotimes (i 10 t) - (setf (gethash i table) i)) + (setf (gethash i table) i)) (dotimes (i 10 t) - (unless (eql (gethash i table) i) - (return nil))) + (unless (eql (gethash i table) i) + (return nil))) (hash-table-p table))) (let ((table (make-hash-table :size 1 :rehash-size 1 :rehash-threshold 1))) (and (dotimes (i 100 t) - (setf (gethash i table) i)) + (setf (gethash i table) i)) (dotimes (i 100 t) - (unless (eql (gethash i table) i) - (return nil))) + (unless (eql (gethash i table) i) + (return nil))) (hash-table-p table))) @@ -147,10 +147,10 @@ (let* ((table0 (make-hash-table)) (table (make-hash-table - :size (hash-table-size table0) - :test (hash-table-test table0) - :rehash-threshold (hash-table-rehash-threshold table0) - :rehash-size (hash-table-rehash-size table0)))) + :size (hash-table-size table0) + :test (hash-table-test table0) + :rehash-threshold (hash-table-rehash-threshold table0) + :rehash-size (hash-table-rehash-size table0)))) (and (hash-table-p table) (zerop (hash-table-count table)) (eq (type-of table) 'hash-table))) @@ -162,13 +162,13 @@ (equal (setf (gethash 1 table) "one") "one") (equal (setf (gethash 2 table "two") "two") "two") (multiple-value-bind (value present-p) (gethash 1 table) - (and (equal value "one") present-p)) + (and (equal value "one") present-p)) (multiple-value-bind (value present-p) (gethash 2 table) - (and (equal value "two") present-p)) + (and (equal value "two") present-p)) (equal (multiple-value-list (gethash nil table)) '(nil nil)) (null (setf (gethash nil table) nil)) (multiple-value-bind (value present-p) (gethash nil table) - (and (not value) present-p)))) + (and (not value) present-p)))) (multiple-value-bind (value present-p) (gethash 'key (make-hash-table) 'default) @@ -181,49 +181,49 @@ (let ((table (make-hash-table))) (and (multiple-value-bind (value present-p) (gethash 'key table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (eql (setf (gethash 'key table) 100) 100) (multiple-value-bind (value present-p) (gethash 'key table) - (and (eql value 100) present-p)))) + (and (eql value 100) present-p)))) (let ((table (make-hash-table)) (list nil)) (and (eql (setf (gethash (progn (push 0 list) 0) - (progn (push 1 list) table) - (progn (push 2 list) 'default)) - (progn (push 3 list) 9)) - 9) + (progn (push 1 list) table) + (progn (push 2 list) 'default)) + (progn (push 3 list) 9)) + 9) (equal list '(3 2 1 0)))) (let ((table (make-hash-table))) (and (dotimes (i 100 t) - (unless (eql (setf (gethash i table) (* i 10)) (* i 10)) - (return nil))) + (unless (eql (setf (gethash i table) (* i 10)) (* i 10)) + (return nil))) (= (hash-table-count table) 100) (dotimes (i 100 t) - (unless (multiple-value-bind (value present-p) (gethash i table) - (and (eql value (* i 10)) present-p)) - (return nil))))) + (unless (multiple-value-bind (value present-p) (gethash i table) + (and (eql value (* i 10)) present-p)) + (return nil))))) (let ((table (make-hash-table))) (and (equal (setf (gethash 100 table) "C") "C") (multiple-value-bind (value present-p) (gethash 100 table) - (and (equal value "C") present-p)) + (and (equal value "C") present-p)) (remhash 100 table) (multiple-value-bind (value present-p) (gethash 100 table) - (and (not value) (not present-p))) + (and (not value) (not present-p))) (not (remhash 100 table)))) (let ((table (make-hash-table))) (and (zerop (hash-table-count table)) (eql (setf (gethash 'a table) 'abc) 'abc) (multiple-value-bind (value present-p) (gethash 'a table) - (and (eq value 'abc) present-p)) + (and (eq value 'abc) present-p)) (eql (hash-table-count table) 1) (remhash 'a table) (multiple-value-bind (value present-p) (gethash 'a table) - (and (not value) (not present-p))) + (and (not value) (not present-p))) (zerop (hash-table-count table)))) (not (remhash 'key (make-hash-table))) @@ -231,7 +231,7 @@ (with-hash-table-iterator (iterator (make-hash-table)) (macrolet ((test (&environment env) - (if (macro-function 'iterator env) t nil))) + (if (macro-function 'iterator env) t nil))) (test))) @@ -242,7 +242,7 @@ (loop (multiple-value-bind (more key value) (iterator) (unless more - (return)) + (return)) (push (list key value) alist)))) (setq alist (sort alist #'< :key #'car)) (equal alist '((0 0) (1 1) (2 2) (3 3) (4 4) (5 5) (6 6) (7 7) (8 8) (9 9)))) @@ -256,7 +256,7 @@ (multiple-value-bind (more key value) (iterator) (declare (ignore key value)) (unless more - (return))))) + (return))))) (eql eval 1)) @@ -268,33 +268,33 @@ alist0 alist1 alist2) (dotimes (i 100) (setf (gethash i table) i)) (and (with-hash-table-iterator (iterator0 table) - (with-hash-table-iterator (iterator1 table) - (with-hash-table-iterator (iterator2 table) - (loop + (with-hash-table-iterator (iterator1 table) + (with-hash-table-iterator (iterator2 table) + (loop (multiple-value-bind (more0 key0 value0) (iterator0) - (multiple-value-bind (more1 key1 value1) (iterator1) - (multiple-value-bind (more2 key2 value2) (iterator2) - (unless (or (every #'null (list more0 more1 more2)) - (every #'identity (list more0 more1 more2))) - (return nil)) - (when (every #'null (list more0 more1 more2)) - (return t)) - (push (cons key0 value0) alist0) - (push (cons key1 value1) alist1) - (push (cons key2 value2) alist2)))))))) + (multiple-value-bind (more1 key1 value1) (iterator1) + (multiple-value-bind (more2 key2 value2) (iterator2) + (unless (or (every #'null (list more0 more1 more2)) + (every #'identity (list more0 more1 more2))) + (return nil)) + (when (every #'null (list more0 more1 more2)) + (return t)) + (push (cons key0 value0) alist0) + (push (cons key1 value1) alist1) + (push (cons key2 value2) alist2)))))))) (equal (sort alist0 #'< :key #'car) - (setq alist1 (sort alist1 #'< :key #'car))) + (setq alist1 (sort alist1 #'< :key #'car))) (equal alist1 (sort alist2 #'< :key #'car)))) - + (let ((table (make-hash-table :rehash-size 100)) (n 0) (alist nil)) (and (dolist (key '(a b c d e f g h i j k) t) - (unless (eql (setf (gethash key table) n) n) - (return nil)) - (incf n)) + (unless (eql (setf (gethash key table) n) n) + (return nil)) + (incf n)) (remhash 'b table) (remhash 'd table) (remhash 'f table) @@ -307,89 +307,89 @@ (not (remhash 'j table)) (with-hash-table-iterator (iterator table) (loop - (multiple-value-bind (more key value) (iterator) - (unless more - (return t)) - (push (cons key value) alist)))) + (multiple-value-bind (more key value) (iterator) + (unless more + (return t)) + (push (cons key value) alist)))) (equal (sort alist #'< :key #'cdr) - '((a . 0) (c . 2) (e . 4) (g . 6) (i . 8) (k . 10))))) + '((a . 0) (c . 2) (e . 4) (g . 6) (i . 8) (k . 10))))) (let ((table (make-hash-table))) (and (null (dotimes (i 10) (setf (gethash i table) i))) (eql (let ((sum-of-squares 0)) - (maphash #'(lambda (key val) - (let ((square (* val val))) - (incf sum-of-squares square) - (setf (gethash key table) square))) - table) - sum-of-squares) - 285) + (maphash #'(lambda (key val) + (let ((square (* val val))) + (incf sum-of-squares square) + (setf (gethash key table) square))) + table) + sum-of-squares) + 285) (eql (hash-table-count table) 10) (null (maphash #'(lambda (key val) - (when (oddp val) (remhash key table))) - table)) + (when (oddp val) (remhash key table))) + table)) (eql (hash-table-count table) 5) (let ((alist nil)) - (and (null (maphash #'(lambda (key val) - (push (list key val) alist)) - table)) - (equalp (sort alist #'< :key #'car) - '((0 0) (2 4) (4 16) (6 36) (8 64))))))) + (and (null (maphash #'(lambda (key val) + (push (list key val) alist)) + table)) + (equalp (sort alist #'< :key #'car) + '((0 0) (2 4) (4 16) (6 36) (8 64))))))) (let ((table (make-hash-table)) (alist nil)) (and (null (dotimes (i 10) (setf (gethash i table) i))) (null (maphash #'(lambda (key val) - (if (evenp key) - (setf (gethash key table) (* val val)) - (remhash key table))) - table)) + (if (evenp key) + (setf (gethash key table) (* val val)) + (remhash key table))) + table)) (null (maphash #'(lambda (key val) (push (cons key val) alist)) table)) (equal (sort alist #'< :key #'car) - '((0 . 0) (2 . 4) (4 . 16) (6 . 36) (8 . 64))))) + '((0 . 0) (2 . 4) (4 . 16) (6 . 36) (8 . 64))))) (flet ((test-hash-table-iterator (hash-table) (let ((all-entries '()) - (generated-entries '()) - (unique (list nil))) - (maphash #'(lambda (key value) (push (list key value) all-entries)) - hash-table) - (with-hash-table-iterator (generator-fn hash-table) - (loop - (multiple-value-bind (more? key value) (generator-fn) - (unless more? (return)) - (unless (eql value (gethash key hash-table unique)) - (error "Key ~S not found for value ~S" key value)) - (push (list key value) generated-entries)))) - (unless (= (length all-entries) - (length generated-entries) - (length (union all-entries generated-entries - :key #'car - :test (hash-table-test hash-table)))) - (error "Generated entries and Maphash entries don't correspond")) - t))) + (generated-entries '()) + (unique (list nil))) + (maphash #'(lambda (key value) (push (list key value) all-entries)) + hash-table) + (with-hash-table-iterator (generator-fn hash-table) + (loop + (multiple-value-bind (more? key value) (generator-fn) + (unless more? (return)) + (unless (eql value (gethash key hash-table unique)) + (error "Key ~S not found for value ~S" key value)) + (push (list key value) generated-entries)))) + (unless (= (length all-entries) + (length generated-entries) + (length (union all-entries generated-entries + :key #'car + :test (hash-table-test hash-table)))) + (error "Generated entries and Maphash entries don't correspond")) + t))) (let ((table (make-hash-table :rehash-size 100)) - (n 0)) + (n 0)) (and (dolist (key '(a b c d e f g h i j k) t) - (unless (eql (setf (gethash key table) n) n) - (return nil)) - (incf n)) - (remhash 'b table) - (remhash 'd table) - (remhash 'f table) - (remhash 'h table) - (remhash 'j table) - (not (remhash 'b table)) - (not (remhash 'd table)) - (not (remhash 'f table)) - (not (remhash 'h table)) - (not (remhash 'j table)) - (test-hash-table-iterator table) - (test-hash-table-iterator (make-hash-table))))) + (unless (eql (setf (gethash key table) n) n) + (return nil)) + (incf n)) + (remhash 'b table) + (remhash 'd table) + (remhash 'f table) + (remhash 'h table) + (remhash 'j table) + (not (remhash 'b table)) + (not (remhash 'd table)) + (not (remhash 'f table)) + (not (remhash 'h table)) + (not (remhash 'j table)) + (test-hash-table-iterator table) + (test-hash-table-iterator (make-hash-table))))) @@ -398,11 +398,11 @@ (and (null (dotimes (i 100) (setf (gethash i table) (format nil "~R" i)))) (eql (hash-table-count table) 100) (multiple-value-bind (value present-p) (gethash 57 table) - (and (equal value "fifty-seven") present-p)) + (and (equal value "fifty-seven") present-p)) (hash-table-p (clrhash table)) (zerop (hash-table-count table)) (multiple-value-bind (value present-p) (gethash 57 table) - (and (null value) (not present-p))))) + (and (null value) (not present-p))))) (let ((code (sxhash 'a))) @@ -445,9 +445,9 @@ (and (not (eq key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'eql)) (key0 (copy-seq "key")) @@ -455,9 +455,9 @@ (and (not (eql key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'eql)) (key0 1.0) @@ -465,9 +465,9 @@ (and (eql key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'eql)) (key0 #\a) @@ -475,9 +475,9 @@ (and (eql key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'eql)) (key0 #\a) @@ -485,9 +485,9 @@ (and (not (eql key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 16 :test 'equal)) (key0 'key) @@ -496,9 +496,9 @@ (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equal)) (key0 1.0) @@ -506,9 +506,9 @@ (and (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equal)) (key0 #\a) @@ -516,9 +516,9 @@ (and (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equal)) (key0 #\a) @@ -526,9 +526,9 @@ (and (not (equal key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 16 :test 'equal)) (key0 (copy-seq "key")) @@ -537,9 +537,9 @@ (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 16 :test 'equal)) (key0 (copy-seq "key")) @@ -548,9 +548,9 @@ (not (equal key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 10 :test 'equal)) (key0 (copy-seq '(key))) @@ -559,9 +559,9 @@ (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 16 :test 'equal)) (key0 (copy-seq #*1010)) @@ -570,9 +570,9 @@ (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 16 :test 'equal)) (key0 (copy-seq #(a b c))) @@ -581,9 +581,9 @@ (not (equal key0 key1)) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (null value) (not present-p))) + (and (null value) (not present-p))) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 10 :test 'equal)) (key0 (make-pathname)) @@ -592,9 +592,9 @@ (equal key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equalp)) @@ -603,9 +603,9 @@ (and (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equalp)) (key0 1.0) @@ -613,9 +613,9 @@ (and (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 100 :test 'equalp)) (key0 1) @@ -624,9 +624,9 @@ (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 0 :test 'equalp)) (key0 #\a) @@ -634,9 +634,9 @@ (and (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 10 :test 'equalp)) (key0 #\a) @@ -645,9 +645,9 @@ (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 3 :test 'equalp)) (key0 (copy-seq '(#\a))) @@ -656,9 +656,9 @@ (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :size 3 :test 'equalp)) (key0 (copy-seq '(#\a (1)))) @@ -667,9 +667,9 @@ (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table :test 'equalp)) (key0 (make-hash-table)) @@ -678,15 +678,15 @@ (equalp key0 key1) (eq (setf (gethash key0 table) 'value) 'value) (multiple-value-bind (value present-p) (gethash key1 table) - (and (eq value 'value) present-p)) + (and (eq value 'value) present-p)) (multiple-value-bind (value present-p) (gethash key0 table) - (and (eq value 'value) present-p)))) + (and (eq value 'value) present-p)))) (let ((table (make-hash-table))) (and (zerop (hash-table-count table)) (dolist (pair '((a abc) (a bc) (1 "one") (1.0 "ONE") (#\a a) (#\A b)) t) - (unless (eq (setf (gethash (car pair) table) (cadr pair)) (cadr pair)) - (return nil))) + (unless (eq (setf (gethash (car pair) table) (cadr pair)) (cadr pair)) + (return nil))) (eql (hash-table-count table) 5) (eq (gethash 'a table) 'bc) (equal (gethash 1 table) "one") --__--__-- Message: 6 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/sacla-tests must-package.lisp,1.2,1.3 ChangeLog,1.5,1.6 Date: Tue, 08 Nov 2005 22:15:44 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/sacla-tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv13944/sacla-tests Modified Files: must-package.lisp ChangeLog Log Message: find-symbol and intern require strings, not string designators Index: must-package.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/sacla-tests/must-package.lisp,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- must-package.lisp 25 Oct 2004 11:12:52 -0000 1.2 +++ must-package.lisp 8 Nov 2005 22:15:42 -0000 1.3 @@ -768,7 +768,7 @@ (names '(a #\B "C" "BUZ"))) (and (eq (shadow names) t) (every #'(lambda (name) - (eq (cadr (multiple-value-list (find-symbol name))) + (eq (cadr (multiple-value-list (find-symbol (string name)))) :internal)) names) (null (set-difference (mapcar #'find-symbol (mapcar #'string names)) @@ -1990,7 +1990,7 @@ (delete-package "TB-FOO")) (let ((package (make-package "TB-FOO" :use nil))) (dolist (name '(a b c d e f g "S1" "S2" "ss")) - (intern name package)) + (intern (string name) package)) (with-package-iterator (get package :internal) (loop (multiple-value-bind (more symbol status pkg) (get) @@ -2004,7 +2004,7 @@ (delete-package #\a)) (let ((package (make-package #\a :use nil))) (dolist (name '(a b c d e f g "S1" "S2" "ss")) - (intern name package)) + (intern (string name) package)) (with-package-iterator (get #\a :internal) (loop (multiple-value-bind (more symbol status pkg) (get) @@ -2018,7 +2018,7 @@ (delete-package #\a)) (let ((package (make-package #\a :use nil))) (dolist (name '(a b c d e f g "S1" "S2" "ss")) - (intern name package)) + (intern (string name) package)) (with-package-iterator (get (list #\a) :internal) (loop (multiple-value-bind (more symbol status pkg) (get) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/sacla-tests/ChangeLog,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- ChangeLog 7 Nov 2005 23:28:26 -0000 1.5 +++ ChangeLog 8 Nov 2005 22:15:42 -0000 1.6 @@ -1,3 +1,8 @@ +2005-11-08 Sam Steingold <sd...@gn...> + + * must-package.lisp: find-symbol and intern require strings, not + string designators + 2005-11-07 Sam Steingold <sd...@gn...> * tests.lisp: load ../tests/tests and use the functionality --__--__-- Message: 7 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src defpackage.lisp,1.13,1.14 NEWS,1.282,1.283 ChangeLog,1.5066,1.5067 Date: Tue, 08 Nov 2005 22:19:58 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14672/src Modified Files: defpackage.lisp NEWS ChangeLog Log Message: (defpackage): :SHADOWING-IMPORT-FROM, :USE, :IMPORT-FROM accept package designators, not just package names Index: NEWS =================================================================== RCS file: /cvsroot/clisp/clisp/src/NEWS,v retrieving revision 1.282 retrieving revision 1.283 diff -u -d -r1.282 -r1.283 --- NEWS 24 Oct 2005 02:19:48 -0000 1.282 +++ NEWS 8 Nov 2005 22:19:56 -0000 1.283 @@ -31,6 +31,10 @@ XLIB:SHAPE-EXTENTS, XLIB:SHAPE-RECTANGLES, XLIB:DEFAULT-KEYSYM-INDEX. Use MAP instead of ELT for sequence access in NEW-CLX. +* ANSI CL compliance issues: + + DEFPACKAGE options :SHADOWING-IMPORT-FROM, :USE, :IMPORT-FROM + accept package designators, not just package names. + * The command line option -v now affects *LOAD-ECHO* also. See <http://clisp.cons.org/clisp.html#opt-v> for details. Index: defpackage.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/defpackage.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- defpackage.lisp 21 Feb 2005 16:38:01 -0000 1.13 +++ defpackage.lisp 8 Nov 2005 22:19:56 -0000 1.14 @@ -1,6 +1,6 @@ ;;; ANSI-compatible definitions ;;; Bruno Haible 21.7.1994 -;;; Sam Steingold 1999-2004 +;;; Sam Steingold 1999-2005 ;; ============================================================================ @@ -57,7 +57,8 @@ (push name symname-list))) (modernize (name) ;; MODERN: CL ==> CS-CL - (let ((pack (sys::%find-package name))) + (let ((pack (if (packagep name) name + (sys::%find-package (string name))))) (ecase modern ((t) (if (eq pack #.(find-package "COMMON-LISP")) "CS-COMMON-LISP" (package-name pack))) @@ -95,10 +96,10 @@ (push name shadow-list) (record-symname name)))) (:SHADOWING-IMPORT-FROM - (let ((pack (string (second option)))) + (let ((pack (modernize (second option)))) (dolist (name (cddr option)) (setq name (funcall to-string name)) - (let ((name+pack (cons name (modernize pack)))) + (let ((name+pack (cons name pack))) (unless (member name+pack shadowing-list :test #'equal) ; #'string= on car and cdr (push name+pack shadowing-list) (record-symname name)))))) @@ -107,10 +108,10 @@ (push (modernize name) use-list)) (setq use-default nil)) (:IMPORT-FROM - (let ((pack (string (second option)))) + (let ((pack (modernize (second option)))) (dolist (name (cddr option)) (setq name (funcall to-string name)) - (let ((name+pack (cons name (modernize pack)))) + (let ((name+pack (cons name pack))) (unless (member name+pack import-list :test #'equal) ; #'string= on car and cdr (push name+pack import-list) (record-symname name)))))) Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.5066 retrieving revision 1.5067 diff -u -d -r1.5066 -r1.5067 --- ChangeLog 8 Nov 2005 15:58:30 -0000 1.5066 +++ ChangeLog 8 Nov 2005 22:19:56 -0000 1.5067 @@ -1,5 +1,10 @@ 2005-11-08 Sam Steingold <sd...@gn...> + * defpackage.lisp (defpackage): :SHADOWING-IMPORT-FROM, :USE, + :IMPORT-FROM accept package designators, not just package names + +2005-11-08 Sam Steingold <sd...@gn...> + * m4/test.m4 (CL_TEST_NT): TEST_NT defaults to "no" 2005-11-07 Sam Steingold <sd...@gn...> --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |