clisp-cvs Digest, Vol 27, Issue 49

[<cli...@li...>]

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/modules/syscalls calls.c,1.237,1.238 (Sam Steingold)
   2. clisp/src init.lisp,1.286,1.287 ChangeLog,1.6443,1.6444
      (Sam Steingold)
   3. clisp/tests ChangeLog,1.578,1.579 tests.lisp,1.94,1.95
      (Sam Steingold)
   4. clisp/tests ChangeLog,1.579,1.580 ext-clisp.tst,1.5,1.6
      (Sam Steingold)
   5. clisp/modules/berkeley-db test.tst,1.30,1.31 (Sam Steingold)
   6. clisp/modules/syscalls test.tst,1.72,1.73 (Sam Steingold)
   7. clisp/modules/syscalls test.tst,1.73,1.74 (Sam Steingold)


----------------------------------------------------------------------

Message: 1
Date: Tue, 29 Jul 2008 19:44:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls calls.c,1.237,1.238
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv6642

Modified Files:
	calls.c 
Log Message:
comment


Index: calls.c
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/calls.c,v
retrieving revision 1.237
retrieving revision 1.238
diff -u -d -r1.237 -r1.238
--- calls.c	28 Jul 2008 19:51:49 -0000	1.237
+++ calls.c	29 Jul 2008 19:44:49 -0000	1.238
@@ -397,6 +397,8 @@
   end_system_call();
 }
 
+/* separate from SET-FILE-STAT because it works only on paths
+   while (setf file-size) supports streams as well */
 DEFUN(POSIX::%SET-FILE-SIZE, file new-size) {
   /* http://www.opengroup.org/onlinepubs/009695399/functions/truncate.html
      http://www.opengroup.org/onlinepubs/009695399/functions/ftruncate.html




------------------------------

Message: 2
Date: Wed, 30 Jul 2008 03:36:04 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/src init.lisp,1.286,1.287 ChangeLog,1.6443,1.6444
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv17347/src

Modified Files:
	init.lisp ChangeLog 
Log Message:
(search-file): fix a bug in "wild" code which caused
SEARCH-FILE to return NIL even when it found something


Index: init.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/src/init.lisp,v
retrieving revision 1.286
retrieving revision 1.287
diff -u -d -r1.286 -r1.287
--- init.lisp	23 Jul 2008 21:00:42 -0000	1.286
+++ init.lisp	30 Jul 2008 03:36:01 -0000	1.287
@@ -2203,7 +2203,7 @@
             (when xpathnames
               (setq found
                     (if wild-p
-                      (dolist (xpathname xpathnames)
+                      (dolist (xpathname xpathnames xpathnames)
                         (setf (rest xpathname)
                               (apply #'encode-universal-time
                                      (third xpathname))))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.6443
retrieving revision 1.6444
diff -u -d -r1.6443 -r1.6444
--- ChangeLog	28 Jul 2008 19:34:35 -0000	1.6443
+++ ChangeLog	30 Jul 2008 03:36:01 -0000	1.6444
@@ -1,3 +1,8 @@
+2008-07-29  Sam Steingold  <sd...@gn...>
+
+	* init.lisp (search-file): fix a bug in "wild" code which caused
+	SEARCH-FILE to return NIL even when it found something
+
 2008-07-28 Reini Urban  <ru...@x-...>
 
 	<37_runprog>




------------------------------

Message: 3
Date: Wed, 30 Jul 2008 15:36:14 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.578,1.579 tests.lisp,1.94,1.95
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/tests
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv30588/tests

Modified Files:
	ChangeLog tests.lisp 
Log Message:
(kill-down): kill files at all levels down
(rmrf): kill directories at all levels down


Index: tests.lisp
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/tests.lisp,v
retrieving revision 1.94
retrieving revision 1.95
diff -u -d -r1.94 -r1.95
--- tests.lisp	23 Jul 2008 17:03:22 -0000	1.94
+++ tests.lisp	30 Jul 2008 15:36:12 -0000	1.95
@@ -7,16 +7,16 @@
   (fresh-line) (prin1 object) (terpri) object)
 #+clisp (progn
 (defun kill-down (name)
-  (dolist (f (directory (ext:string-concat name "**")))
-    (format t "~&removing ~S~%" f)
-    (if (pathname-name f)
-        (delete-file f)
-        (ext:delete-directory f))))
+  (dolist (f (directory (ext:string-concat name "**/*")))
+    (format t "~&removing file ~S~%" f)
+    (delete-file f)))
 (defun rmrf (name)
-  (ext:dir (ext:string-concat name "**"))
+  (ext:dir (ext:string-concat name "**/*"))
+  (ext:dir (ext:string-concat name "**/"))
   (kill-down name)
-  (format t "~&removing ~S~%" name)
-  (ext:delete-directory name))
+  (dolist (d (directory (ext:string-concat name "**/")))
+    (format t "~&removing directory ~S~%" d)
+    (ext:delete-directory d)))
 (defun prepare-directory (name)
   (ensure-directories-exist name :verbose t)
   (kill-down name))

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.578
retrieving revision 1.579
diff -u -d -r1.578 -r1.579
--- ChangeLog	27 Jul 2008 18:53:25 -0000	1.578
+++ ChangeLog	30 Jul 2008 15:36:12 -0000	1.579
@@ -1,3 +1,8 @@
+2008-07-30  Sam Steingold  <sd...@gn...>
+
+	* tests.lisp (kill-down): kill files at all levels down
+	(rmrf): kill directories at all levels down
+
 2008-07-27  Sam Steingold  <sd...@gn...>
 
 	* hashtable.tst: test support for circular keys




------------------------------

Message: 4
Date: Wed, 30 Jul 2008 15:37:15 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/tests ChangeLog,1.579,1.580 ext-clisp.tst,1.5,1.6
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/tests
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv31000/tests

Modified Files:
	ChangeLog ext-clisp.tst 
Log Message:
(check-load): test wildcards in *load-paths*


Index: ext-clisp.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ext-clisp.tst,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- ext-clisp.tst	17 Jul 2008 19:51:30 -0000	1.5
+++ ext-clisp.tst	30 Jul 2008 15:37:13 -0000	1.6
@@ -3,6 +3,7 @@
 ;; Many tests already in alltest.tst, map.tst etc., but
 ;; here we avoid using #+clisp all over the place.
 ;; Jörg Höhle, 2007
+;; Sam Steingold, 2007-2008
 
 ;(setf if) 5.1.6
 (mapcar (lambda (x &aux a b) (list (setf (if x a b) 2) a b)) '(t nil))
@@ -246,3 +247,22 @@
           s)))
  :test 'equal)
 "ISO-1234"
+
+(defun check-load (file)
+  (let* ((dir (ext:string-concat (second (pathname-directory file)) "/"))
+         (*load-paths* (list '#p"" (pathname (ext:string-concat dir "**/")))))
+    (unwind-protect
+         (progn
+           (prepare-directory file)
+           (with-open-file (s file :direction :output)
+             (prin1 '(setf (cdr *load-paths*) nil) s))
+           (load (pathname-name file))
+           *load-paths*)
+      (rmrf dir))))
+CHECK-LOAD
+
+(check-load "foo/bar/baz/zot.lisp") (#p"")
+(check-load "foo/bar/baz/zot") (#p"")
+
+(progn (symbol-cleanup 'check-load))
+T

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/tests/ChangeLog,v
retrieving revision 1.579
retrieving revision 1.580
diff -u -d -r1.579 -r1.580
--- ChangeLog	30 Jul 2008 15:36:12 -0000	1.579
+++ ChangeLog	30 Jul 2008 15:37:13 -0000	1.580
@@ -1,5 +1,9 @@
 2008-07-30  Sam Steingold  <sd...@gn...>
 
+	* ext-clisp.tst (check-load): test wildcards in *load-paths*
+
+2008-07-30  Sam Steingold  <sd...@gn...>
+
 	* tests.lisp (kill-down): kill files at all levels down
 	(rmrf): kill directories at all levels down
 




------------------------------

Message: 5
Date: Wed, 30 Jul 2008 15:54:52 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/berkeley-db test.tst,1.30,1.31
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/modules/berkeley-db
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv5292/modules/berkeley-db

Modified Files:
	test.tst 
Log Message:
rmrf now returns NIL


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/test.tst,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -d -r1.30 -r1.31
--- test.tst	1 Jul 2008 14:11:02 -0000	1.30
+++ test.tst	30 Jul 2008 15:54:50 -0000	1.31
@@ -326,5 +326,5 @@
 
 (finish-file "bdb-errors") 2    ; just the two start and stop messages
 (finish-file "bdb-msg") 2
-(rmrf "bdb-home/") T
-(rmrf "bdb-data/") T
+(rmrf "bdb-home/") NIL
+(rmrf "bdb-data/") NIL




------------------------------

Message: 6
Date: Wed, 30 Jul 2008 16:21:11 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls test.tst,1.72,1.73
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv15803/modules/syscalls

Modified Files:
	test.tst 
Log Message:
another test for OS:FILE-SIZE


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- test.tst	28 Jul 2008 17:43:45 -0000	1.72
+++ test.tst	30 Jul 2008 16:21:09 -0000	1.73
@@ -430,6 +430,17 @@
           (= l (file-length s)))))
 (T T)
 
+(let ((file "foo.bar") s)
+  (unwind-protect
+       (progn (setq s (open file :direction :probe :if-does-not-exist :create))
+              (list (os:file-size file)
+                    (setf (os:file-size s) 100)
+                    (os:file-size file)
+                    (setf (os:file-size file) 1000)
+                    (os:file-size s)))
+    (delete-file file)))
+(0 100 100 1000 1000)
+
 #+ffi (defparameter *foo* (os:fopen "foo" "w")) #+ffi *foo*
 #+ffi (os::%fputc 65 *foo*) #+ffi 65
 #+ffi (os:feof *foo*) #+ffi NIL




------------------------------

Message: 7
Date: Wed, 30 Jul 2008 16:21:37 +0000
From: Sam Steingold <sd...@us...>
Subject: clisp/modules/syscalls test.tst,1.73,1.74
To: cli...@li...
Message-ID: <E1K...@ma...>

Update of /cvsroot/clisp/clisp/modules/syscalls
In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv15825/modules/syscalls

Modified Files:
	test.tst 
Log Message:
use SYMBOL-CLEANUP for cleanup


Index: test.tst
===================================================================
RCS file: /cvsroot/clisp/clisp/modules/syscalls/test.tst,v
retrieving revision 1.73
retrieving revision 1.74
diff -u -d -r1.73 -r1.74
--- test.tst	30 Jul 2008 16:21:09 -0000	1.73
+++ test.tst	30 Jul 2008 16:21:35 -0000	1.74
@@ -473,15 +473,15 @@
 (progn (proc-send *proc1* "(close s)(ext:quit)")
        (close (two-way-stream-input-stream *proc1*))
        (close (two-way-stream-output-stream *proc1*))
-       (close *proc1*) (makunbound '*proc1*) (unintern '*proc1*)
+       (close *proc1*) (symbol-cleanup '*proc1*)
        (proc-send *proc2* "(close s)(ext:quit)" )
        (close (two-way-stream-input-stream *proc2*))
        (close (two-way-stream-output-stream *proc2*))
-       (close *proc2*) (makunbound '*proc2*) (unintern '*proc2*)
-       (delete-file *tmp1*) (makunbound '*tmp1*) (unintern '*tmp1*)
-       (delete-file *tmp2*) (makunbound '*tmp2*) (unintern '*tmp2*)
-       (fmakunbound 'flush-clisp) (unintern 'flush-clisp)
-       (fmakunbound 'proc-send) (unintern 'proc-send)
+       (close *proc2*) (symbol-cleanup '*proc2*)
+       (delete-file *tmp1*) (symbol-cleanup '*tmp1*)
+       (delete-file *tmp2*) (symbol-cleanup '*tmp2*)
+       (symbol-cleanup 'flush-clisp)
+       (symbol-cleanup 'proc-send)
        (setq *features* (delete :no-stream-lock *features*))
        T)
 T




------------------------------

-------------------------------------------------------------------------
This SF.Net email is sponsored by the Moblin Your Move Developer's challenge
Build the coolest Linux based applications with Moblin SDK & win great prizes
Grand prize is a trip for two to an Open Source event anywhere in the world
http://moblin-contest.org/redirect.php?banner_id=100&url=/

------------------------------

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest, Vol 27, Issue 49
*****************************************