- osicat-cvs@common-lisp.net - mailman3.common-lisp.net

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 24 Apr '04

24 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv30849 Modified Files: osicat.lisp test-osicat.lisp Log Message: Fixed a dumb USER-INFO typo. Fixed environment.3 test (#.(environment) of course can end up with a value different from (environment)). Removed extraneous fixednam flet. Date: Sat Apr 24 12:40:03 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.19 src/osicat.lisp:1.20 --- src/osicat.lisp:1.19 Thu Apr 22 20:01:20 2004 +++ src/osicat.lisp Sat Apr 24 12:40:02 2004 @@ -101,15 +101,9 @@ :defaults pathspec))) (defun normpath (pathspec &optional absolute) - (flet ((fixedname (path) - (let ((name (pathname-name path))) - (cond ((equal ".." name) :up) - ((equal "." name) nil) - ((stringp name) name)))) - (fixeddir (path) - (let ((dir (pathname-directory (concatenate 'string - (namestring path) - "/")))) + (flet ((fixeddir (path) + (let ((dir (pathname-directory + (concatenate 'string (namestring path) "/")))) (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) @@ -407,7 +401,7 @@ function USER-INFO user-id => alist USER-INFO returns the password entry for the given name or numerical -user ID, as an alist." +user ID, as an assoc-list." (let ((pwent (typecase id (string (with-cstring (name id) (getpwnam name))) (integer (getpwuid id)) @@ -416,6 +410,6 @@ (list (cons :name (osicat-pwent-name pwent)) (cons :user-id (osicat-pwent-uid pwent)) (cons :group-id (osicat-pwent-gid pwent)) - (cons :gecos (osicat-pwent-gid pwent)) + (cons :gecos (osicat-pwent-gecos pwent)) (cons :home (osicat-pwent-home pwent)) (cons :shell (osicat-pwent-shell pwent)))))) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.7 src/test-osicat.lisp:1.8 --- src/test-osicat.lisp:1.7 Thu Apr 22 20:01:20 2004 +++ src/test-osicat.lisp Sat Apr 24 12:40:02 2004 @@ -63,10 +63,12 @@ (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) +;; No-op test to ensure setf environment actually works. (deftest environment.3 - ;; No-op test to ensure setf environment actually works. - (setf (environment) (environment)) - #.(environment)) + (let ((old-env (environment))) + (prog1 (setf (environment) nil) + (setf (environment) old-env))) + nil) (deftest environment-variable.1 (environment-variable 'test-variable)

1 0

[osicat-cvs] CVS update: src/ffi.lisp src/osicat-glue.c src/osicat.lisp src/packages.lisp src/test-osicat.lisp
by Julian E. C. Squires 23 Apr '04

23 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv25938 Modified Files: ffi.lisp osicat-glue.c osicat.lisp packages.lisp test-osicat.lisp Log Message: * Added USER-INFO, a function for accessing passwd entries. * Fixed left-over use of GET-ENVIRON in SETF ENVIRONMENT, and added test case to catch that happening again. Date: Thu Apr 22 20:01:20 2004 Author: jsquires Index: src/ffi.lisp diff -u src/ffi.lisp:1.2 src/ffi.lisp:1.3 --- src/ffi.lisp:1.2 Sun Feb 29 13:10:41 2004 +++ src/ffi.lisp Thu Apr 22 20:01:20 2004 @@ -41,6 +41,34 @@ :module "osicat" :returning :cstring) +(def-function "osicat_pwent_name" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_passwd" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_uid" ((entry :pointer-void)) + :module "osicat" + :returning :int) + +(def-function "osicat_pwent_gid" ((entry :pointer-void)) + :module "osicat" + :returning :int) + +(def-function "osicat_pwent_gecos" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_home" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +(def-function "osicat_pwent_shell" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + ;;;; PLAIN POSIX (def-function "opendir" ((name :cstring)) @@ -73,6 +101,14 @@ (def-array-pointer cstring-array :cstring) (def-foreign-var "environ" 'cstring-array "osicat") + +(def-function "getpwnam" ((name :cstring)) + :module "osicat" + :returning :pointer-void) + +(def-function "getpwuid" ((id :int)) + :module "osicat" + :returning :pointer-void) (def-function "readlink" ((name :cstring) (buffer (* :unsigned-char)) (size :size-t)) Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.7 src/osicat-glue.c:1.8 --- src/osicat-glue.c:1.7 Sun Feb 29 13:10:41 2004 +++ src/osicat-glue.c Thu Apr 22 20:01:20 2004 @@ -73,3 +73,46 @@ } } } + +extern char * +osicat_pwent_name (struct passwd * pwent) +{ + return pwent->pw_name; +} + +extern char * +osicat_pwent_passwd (struct passwd * pwent) +{ + return pwent->pw_passwd; +} + +extern int +osicat_pwent_uid (struct passwd * pwent) +{ + return pwent->pw_uid; +} + +extern int +osicat_pwent_gid (struct passwd * pwent) +{ + return pwent->pw_gid; +} + +extern char * +osicat_pwent_gecos (struct passwd * pwent) +{ + return pwent->pw_gecos; +} + +extern char * +osicat_pwent_home (struct passwd * pwent) +{ + return pwent->pw_dir; +} + +extern char * +osicat_pwent_shell (struct passwd * pwent) +{ + return pwent->pw_shell; +} + Index: src/osicat.lisp diff -u src/osicat.lisp:1.18 src/osicat.lisp:1.19 --- src/osicat.lisp:1.18 Wed Apr 21 18:34:35 2004 +++ src/osicat.lisp Thu Apr 22 20:01:20 2004 @@ -106,9 +106,6 @@ (cond ((equal ".." name) :up) ((equal "." name) nil) ((stringp name) name)))) - (fixedtype (path) - (let ((type (pathname-type path))) - (and (stringp type) type))) (fixeddir (path) (let ((dir (pathname-directory (concatenate 'string (namestring path) @@ -275,7 +272,7 @@ (error "Could not access environment (~S)." e)))) (defun (setf environment) (alist) - (let ((oldenv (get-environ))) + (let ((oldenv (environment))) (loop for (var . val) in alist do (setf (environment-variable var) (string val) oldenv (delete var oldenv @@ -402,3 +399,23 @@ (if (minusp (chdir dir)) (error "Could not change current directory.") pathspec))) + +;;;; USER INFORMATION + +(defun user-info (id) + "function USER-INFO name => alist +function USER-INFO user-id => alist + +USER-INFO returns the password entry for the given name or numerical +user ID, as an alist." + (let ((pwent (typecase id + (string (with-cstring (name id) (getpwnam name))) + (integer (getpwuid id)) + (t (make-null-pointer :pointer-void))))) + (when (not (null-pointer-p pwent)) + (list (cons :name (osicat-pwent-name pwent)) + (cons :user-id (osicat-pwent-uid pwent)) + (cons :group-id (osicat-pwent-gid pwent)) + (cons :gecos (osicat-pwent-gid pwent)) + (cons :home (osicat-pwent-home pwent)) + (cons :shell (osicat-pwent-shell pwent)))))) Index: src/packages.lisp diff -u src/packages.lisp:1.7 src/packages.lisp:1.8 --- src/packages.lisp:1.7 Mon Mar 8 01:41:32 2004 +++ src/packages.lisp Thu Apr 22 20:01:20 2004 @@ -55,6 +55,8 @@ #:make-link ;; Permissions #:file-permissions + ;; Password entries + #:user-info ;; Version info #:*osicat-version* )) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.6 src/test-osicat.lisp:1.7 --- src/test-osicat.lisp:1.6 Wed Apr 21 18:34:35 2004 +++ src/test-osicat.lisp Thu Apr 22 20:01:20 2004 @@ -63,6 +63,11 @@ (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) +(deftest environment.3 + ;; No-op test to ensure setf environment actually works. + (setf (environment) (environment)) + #.(environment)) + (deftest environment-variable.1 (environment-variable 'test-variable) nil) @@ -205,16 +210,48 @@ (delete-directory dir))) (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) +;; Test that directories of form foo.bar/ don't become foo/bar/. (deftest mapdir.4 - ;; Test that directories of form foo.bar/ don't become foo/bar/. (let* ((dir (ensure-directories-exist - (merge-pathnames "mapdir-test.type/" *test-dir*))) - (file (ensure-file "foo.bar" dir))) + (merge-pathnames "mapdir-test.type/" *test-dir*)))) (unwind-protect - (let ((*default-directory-defaults* (truename "/tmp/"))) - (mapdir (lambda (x) - (pathname-directory (merge-pathnames x))) - dir)) - (delete-file file) + (dolist (list (remove-if + #'null + (osicat:mapdir + (lambda (x) (pathname-directory x)) + *test-dir*))) + (when (/= (length list) 2) (error "too many path elements."))) (delete-directory dir))) - (#.(pathname-directory (merge-pathnames "mapdir-test.type/" *test-dir*)))) + nil) + +;; Test behavior in the case of an obviously incorrect username. +(deftest user-info.1 + (user-info "definitely_not_a_user!") + nil) + +;; Does this test still work in the case of su/sudo? It should, I +;; think. +#+sbcl +(deftest user-info.2 + (let ((user-id (cdr (assoc :user-id (user-info (sb-posix:getuid)))))) + (equal user-id (sb-posix:getuid))) + t) + +;; Just get our home directory, and see if it exists. I don't +;; think this will work 100% of the time, but it should for most +;; people testing the package; given that, would it be even better +;; to compare the value to (user-homedir-pathname)? +#+sbcl +(deftest user-info.3 + (let ((home (cdr (assoc :home (user-info (sb-posix:getuid)))))) + (file-kind home)) + :directory) + +;; We'll go out on a limb and assume that not only does the root +;; account exist, but its home directory exists, as well. Note +;; that this is unfortunately not always true. +(deftest user-info.4 + (let ((home (cdr (assoc :home (user-info "root"))))) + (file-kind home)) + :directory) +

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 21 Apr '04

21 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19938 Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed bug where foo.bar/ directories become foo/bar/. Date: Wed Apr 21 18:34:36 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.17 src/osicat.lisp:1.18 --- src/osicat.lisp:1.17 Mon Mar 8 01:41:32 2004 +++ src/osicat.lisp Wed Apr 21 18:34:35 2004 @@ -110,7 +110,9 @@ (let ((type (pathname-type path))) (and (stringp type) type))) (fixeddir (path) - (let ((dir (pathname-directory path))) + (let ((dir (pathname-directory (concatenate 'string + (namestring path) + "/")))) (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) @@ -118,12 +120,7 @@ (with-cstring (cfile (namestring path)) (let ((abspath (if (eq :directory (c-file-kind cfile t)) (make-pathname :name nil :type nil - :directory - (append (fixeddir path) - (remove-if - #'null - (list (fixedname path) - (fixedtype path)))) + :directory (fixeddir path) :defaults path) path))) (if absolute Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.5 src/test-osicat.lisp:1.6 --- src/test-osicat.lisp:1.5 Sun Feb 29 18:52:23 2004 +++ src/test-osicat.lisp Wed Apr 21 18:34:35 2004 @@ -50,14 +50,16 @@ t) (deftest environment.1 - (cdr (assoc "HOME" (environment) :test #'equal)) + (namestring (osicat::normpath (cdr (assoc "HOME" (environment) + :test #'equal)) + t)) #.(namestring (user-homedir-pathname))) (deftest environment.2 (unwind-protect (progn (setf (environment-variable 'test-variable) "TEST-VALUE") - (assoc "TEST-VARIABLE" environment :test 'equal)) + (assoc "TEST-VARIABLE" (environment) :test #'equal)) (makunbound-environment-variable 'test-variable)) ("TEST-VARIABLE" . "TEST-VALUE")) @@ -202,3 +204,17 @@ (delete-file file) (delete-directory dir))) (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) + +(deftest mapdir.4 + ;; Test that directories of form foo.bar/ don't become foo/bar/. + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test.type/" *test-dir*))) + (file (ensure-file "foo.bar" dir))) + (unwind-protect + (let ((*default-directory-defaults* (truename "/tmp/"))) + (mapdir (lambda (x) + (pathname-directory (merge-pathnames x))) + dir)) + (delete-file file) + (delete-directory dir))) + (#.(pathname-directory (merge-pathnames "mapdir-test.type/" *test-dir*))))

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 08 Mar '04

08 Mar '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19603 Modified Files: osicat.lisp packages.lisp Log Message: Shadow directory Date: Mon Mar 8 01:41:32 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.16 src/osicat.lisp:1.17 --- src/osicat.lisp:1.16 Sun Feb 29 18:41:50 2004 +++ src/osicat.lisp Mon Mar 8 01:41:32 2004 @@ -71,17 +71,25 @@ (defun relative-pathname-p (pathspec) (not (eq :absolute (car (pathname-directory pathspec))))) -(defun absolute-pathname - (pathspec &optional (default *default-pathname-defaults*)) - (if (relative-pathname-p pathspec) - (let ((tmp (merge-pathnames - pathspec - (make-pathname :name nil :type nil :version nil - :defaults default)))) - (if (relative-pathname-p tmp) - (merge-pathnames tmp (current-directory)) - tmp)) - pathspec)) +(defun absolute-pathname (pathspec &optional (default *default-pathname-defaults*)) + (if (relative-pathname-p pathspec) + (let ((tmp (merge-pathnames + pathspec + (make-pathname :name nil :type nil :version nil + :defaults default)))) + (if (relative-pathname-p tmp) + (merge-pathnames tmp (current-directory)) + tmp)) + pathspec)) + +(defun escape-wild-name (name) + (declare (simple-string name)) + (let (stack) + (loop for char across name + when (member char '(#\* #\[)) + do (push #\\ stack) + do (push char stack)) + (coerce (nreverse stack) 'simple-string))) (defun unmerge-pathnames (pathspec &optional (known *default-pathname-defaults*)) @@ -107,8 +115,6 @@ dir (cons :relative dir))))) (let ((path (absolute-pathname pathspec))) - (when (wild-pathname-p path) - (error "Pathname is wild: ~S." path)) (with-cstring (cfile (namestring path)) (let ((abspath (if (eq :directory (c-file-kind cfile t)) (make-pathname :name nil :type nil @@ -170,13 +176,13 @@ (let ((entry (readdir ,dp))) (if (null-pointer-p entry) nil - (let ((name + (let ((string (convert-from-cstring (osicat-dirent-name entry)))) - (if (member name '("." "..") + (if (member string '("." "..") :test #'string=) (,one-iter) - (normpath name))))))) + (normpath (escape-wild-name string)))))))) (macrolet ((,iterator () `(,',one-iter))) (setf ,dp (opendir ,cdir)) Index: src/packages.lisp diff -u src/packages.lisp:1.6 src/packages.lisp:1.7 --- src/packages.lisp:1.6 Sun Feb 29 18:43:09 2004 +++ src/packages.lisp Mon Mar 8 01:41:32 2004 @@ -35,6 +35,9 @@ When a relative pathname designator is used as a directory designator it is first resolved agains *default-pathname-default*, and then against the current directory. (With MERGE-PATHNAMES in both cases.)") + (:shadow + ;; DIRECTORY is used as constant internally. Let's not confuse other packages. + #:directory) (:export ;;; Evironment #:environment

1 0

[osicat-cvs] CVS update: src/Makefile
by Nikodemus Siivola 05 Mar '04

05 Mar '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv28608 Modified Files: Makefile Log Message: Added generation of README Date: Fri Mar 5 14:15:15 2004 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.3 src/Makefile:1.4 --- src/Makefile:1.3 Sun Oct 26 09:38:02 2003 +++ src/Makefile Fri Mar 5 14:15:15 2004 @@ -64,6 +64,7 @@ # $(RSYNC_FTP) && $(FTP_PERMS) release: + sbcl --noinform --userinit /dev/null --load make-readme.lisp --eval '(quit)' mkdir -p $(NAME) cp $(FILES) $(NAME)/ tar -czvf $(NAME).tar.gz $(NAME)

1 0

[osicat-cvs] CVS update: src/grovel-constants.lisp src/osicat.asd src/version.txt
by Nikodemus Siivola 05 Mar '04

05 Mar '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv23136 Modified Files: grovel-constants.lisp osicat.asd version.txt Log Message: Fixed *print-case* dependency Date: Fri Mar 5 13:34:54 2004 Author: nsiivola Index: src/grovel-constants.lisp diff -u src/grovel-constants.lisp:1.3 src/grovel-constants.lisp:1.4 --- src/grovel-constants.lisp:1.3 Sun Feb 29 06:29:14 2004 +++ src/grovel-constants.lisp Fri Mar 5 13:34:54 2004 @@ -29,7 +29,8 @@ (defun write-groveler (file constants) (with-open-file (f file :direction :output :if-exists :supersede) - (format f " + (let ((*print-case* :upcase)) + (format f " #include <stdio.h> #include <sys/stat.h> @@ -50,7 +51,7 @@ (format f " return 0; } -"))) +")))) (unless (boundp '*grovel*) (error "No GROVEL hook!")) Index: src/osicat.asd diff -u src/osicat.asd:1.6 src/osicat.asd:1.7 --- src/osicat.asd:1.6 Sun Feb 29 15:29:35 2004 +++ src/osicat.asd Fri Mar 5 13:34:54 2004 @@ -69,6 +69,7 @@ ;;;; SYSTEM (defsystem :osicat + :version "0.3.6" :depends-on (:uffi) :components ((:c-source-file "osicat-glue") Index: src/version.txt diff -u src/version.txt:1.8 src/version.txt:1.9 --- src/version.txt:1.8 Sun Feb 29 18:52:23 2004 +++ src/version.txt Fri Mar 5 13:34:54 2004 @@ -1 +1 @@ -0.3.5 +0.3.6

1 0

[osicat-cvs] CVS update: src/release.txt src/test-osicat.lisp src/version.txt
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv27531 Modified Files: release.txt test-osicat.lisp version.txt Log Message: Last minute fixes for 0.3.5 release. Date: Sun Feb 29 18:52:23 2004 Author: nsiivola Index: src/release.txt diff -u src/release.txt:1.4 src/release.txt:1.5 --- src/release.txt:1.4 Sun Feb 29 06:29:14 2004 +++ src/release.txt Sun Feb 29 18:52:23 2004 @@ -5,5 +5,8 @@ packages.lisp osicat.lisp osicat-glue.c +version.txt +test-tools.lisp +test-osicat.lisp LICENSE README Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.4 src/test-osicat.lisp:1.5 --- src/test-osicat.lisp:1.4 Sun Feb 29 18:28:22 2004 +++ src/test-osicat.lisp Sun Feb 29 18:52:23 2004 @@ -22,12 +22,6 @@ (in-package :osicat-test) (deftest current-directory.1 - (equal (current-directory) - #.(make-pathname :name nil :type nil :version nil - :defaults *compile-file-truename*)) - t) - -(deftest current-directory.2 (let ((old (current-directory))) (unwind-protect (progn Index: src/version.txt diff -u src/version.txt:1.7 src/version.txt:1.8 --- src/version.txt:1.7 Sun Feb 29 07:44:47 2004 +++ src/version.txt Sun Feb 29 18:52:23 2004 @@ -1 +1 @@ -0.3.4 +0.3.5

1 0

[osicat-cvs] CVS update: src/packages.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv27299 Modified Files: packages.lisp Log Message: * Documentation fixes. Date: Sun Feb 29 18:43:09 2004 Author: nsiivola Index: src/packages.lisp diff -u src/packages.lisp:1.5 src/packages.lisp:1.6 --- src/packages.lisp:1.5 Sun Feb 29 18:41:50 2004 +++ src/packages.lisp Sun Feb 29 18:43:09 2004 @@ -33,7 +33,7 @@ Designated directory When a relative pathname designator is used as a directory designator - it is first resolved agains *default-pathname-default*, and the + it is first resolved agains *default-pathname-default*, and then against the current directory. (With MERGE-PATHNAMES in both cases.)") (:export ;;; Evironment

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19329 Modified Files: osicat.lisp packages.lisp Log Message: * Documentation fixes. Date: Sun Feb 29 18:41:50 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.15 src/osicat.lisp:1.16 --- src/osicat.lisp:1.15 Sun Feb 29 18:28:22 2004 +++ src/osicat.lisp Sun Feb 29 18:41:50 2004 @@ -148,9 +148,7 @@ (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value -If pathspec is relative, it is resolved against *default-pathname-defaults*. -If the resulting pathname is still relative, it is further resolved against -current directory. The resulting pathname is then bound to +The directory designated by pathspec is then bound to *default-pathname-defaults* for the dynamic scope of the body. Within the lexical scope of the body, iterator is defined via macrolet @@ -195,7 +193,9 @@ "function MAPDIR function pathspec => list Applies function to each entry in directory designated by pathspec in -turn and returns a list of the results. +turn and returns a list of the results. Binds +*default-pathname-defaults* to the directory designated by pathspec +round to function call. If pathspec designates a symbolic link, it is implicitly resolved. @@ -354,9 +354,9 @@ If pathspec designates a symbolic link, that link is implicitly resolved. -Permission symbols consist of :USER-READ, :USER-WRITE, :USER-EXEC, -:GROUP-READ, :GROUP-WRITE, :GROUP-EXEC, :OTHER-READ, :OTHER-WRITE, -:OTHER-EXEC, :SET-USER-ID, :SET-GROUP-ID, and :STICKY. +Permission symbols consist of :user-read, :user-write, :user-exec, +:group-read, :group-write, :group-exec, :other-read, :other-write, +:other-exec, :set-user-id, :set-group-id, and :sticky. Both signal an error is pathspec is wild, or doesn't designate an exiting file." Index: src/packages.lisp diff -u src/packages.lisp:1.4 src/packages.lisp:1.5 --- src/packages.lisp:1.4 Sun Feb 29 13:10:41 2004 +++ src/packages.lisp Sun Feb 29 18:41:50 2004 @@ -26,7 +26,15 @@ on Unix-platforms. It is not a POSIX-style API, but rather a simple lispy accompaniment to the standard ANSI facilities. -Osicat homepage: http://www.common-lisp.net/project/osicat") +Osicat homepage: http://www.common-lisp.net/project/osicat + +Concepts: + + Designated directory + + When a relative pathname designator is used as a directory designator + it is first resolved agains *default-pathname-default*, and the + against the current directory. (With MERGE-PATHNAMES in both cases.)") (:export ;;; Evironment #:environment

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp src/test-tools.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv20785 Modified Files: osicat.lisp test-osicat.lisp test-tools.lisp Log Message: * More tests. * Miscellaneous fixes. * Dithering around the MAPDIR and W-D-I interfaces: should they bind *d-p-d* or not? Should only one of them do that? Date: Sun Feb 29 18:28:22 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.14 src/osicat.lisp:1.15 --- src/osicat.lisp:1.14 Sun Feb 29 15:52:37 2004 +++ src/osicat.lisp Sun Feb 29 18:28:22 2004 @@ -71,16 +71,28 @@ (defun relative-pathname-p (pathspec) (not (eq :absolute (car (pathname-directory pathspec))))) -(defun merge-directories - (pathspec &optional (other *default-pathname-defaults*)) - (let ((tmp (merge-pathnames pathspec - (make-pathname :name nil :type nil :version nil - :defaults other)))) - (if (relative-pathname-p tmp) - (merge-pathnames tmp (current-directory)) - tmp))) +(defun absolute-pathname + (pathspec &optional (default *default-pathname-defaults*)) + (if (relative-pathname-p pathspec) + (let ((tmp (merge-pathnames + pathspec + (make-pathname :name nil :type nil :version nil + :defaults default)))) + (if (relative-pathname-p tmp) + (merge-pathnames tmp (current-directory)) + tmp)) + pathspec)) + +(defun unmerge-pathnames + (pathspec &optional (known *default-pathname-defaults*)) + (let* ((dir (pathname-directory pathspec)) + (mismatch (mismatch dir (pathname-directory known) :test #'equal))) + (make-pathname + :directory (when mismatch + `(:relative ,@(subseq dir mismatch))) + :defaults pathspec))) -(defun normpath (pathspec &optional merge) +(defun normpath (pathspec &optional absolute) (flet ((fixedname (path) (let ((name (pathname-name path))) (cond ((equal ".." name) :up) @@ -94,22 +106,23 @@ (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) - (let ((path (if (and merge (relative-pathname-p pathspec)) - (merge-directories pathspec) - pathspec))) + (let ((path (absolute-pathname pathspec))) (when (wild-pathname-p path) (error "Pathname is wild: ~S." path)) (with-cstring (cfile (namestring path)) - (if (eq :directory (c-file-kind cfile t)) - (make-pathname :name nil :type nil - :directory - (append (fixeddir path) - (remove-if - #'null - (list (fixedname path) - (fixedtype path)))) - :defaults path) - path))))) + (let ((abspath (if (eq :directory (c-file-kind cfile t)) + (make-pathname :name nil :type nil + :directory + (append (fixeddir path) + (remove-if + #'null + (list (fixedname path) + (fixedtype path)))) + :defaults path) + path))) + (if absolute + abspath + (unmerge-pathnames abspath))))))) ;;;; FILE-KIND @@ -191,7 +204,7 @@ (loop for entry = (next) while entry collect (funcall function entry)))) - + (defun delete-directory (pathspec) "function DELETE-DIRECTORY pathspec => T Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.3 src/test-osicat.lisp:1.4 --- src/test-osicat.lisp:1.3 Sun Feb 29 15:52:37 2004 +++ src/test-osicat.lisp Sun Feb 29 18:28:22 2004 @@ -165,3 +165,46 @@ t) (setf (environment-variable :path) old))) t) + +(deftest mapdir.1 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file1 (ensure-file "file1" dir)) + (file2 (ensure-file "file2.txt" dir)) + (subdir (ensure-directories-exist + (merge-pathnames "subdir/" dir)))) + (unwind-protect + (remove-if #'null (mapdir #'pathname-name dir)) + (delete-file file1) + (delete-file file2) + (delete-directory subdir) + (delete-directory dir))) + ("file1" "file2")) + +(deftest mapdir.2 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file1 (ensure-file "file1" dir)) + (file2 (ensure-file "file2.txt" dir)) + (subdir (ensure-directories-exist + (merge-pathnames "subdir/" dir)))) + (unwind-protect + (mapdir #'namestring dir) + (delete-file file1) + (delete-file file2) + (delete-directory subdir) + (delete-directory dir))) + ("file1" "file2.txt" "subdir/")) + +(deftest mapdir.3 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file (ensure-file "foo" dir))) + (unwind-protect + (let ((*default-directory-defaults* (truename "/tmp/"))) + (mapdir (lambda (x) + (pathname-directory (merge-pathnames x))) + dir)) + (delete-file file) + (delete-directory dir))) + (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) Index: src/test-tools.lisp diff -u src/test-tools.lisp:1.1 src/test-tools.lisp:1.2 --- src/test-tools.lisp:1.1 Sun Feb 29 15:29:35 2004 +++ src/test-tools.lisp Sun Feb 29 18:28:22 2004 @@ -35,8 +35,8 @@ (make-pathname :directory (pathname-directory #.*compile-file-truename*)))) -(defun ensure-file (file) - (let ((file (merge-pathnames file *test-dir*))) +(defun ensure-file (file &optional (dir *test-dir*)) + (let ((file (merge-pathnames file dir))) (or (probe-file file) (with-open-file (f file :direction :output) (probe-file f)))))

1 0