From: Pascal J.B. <pj...@in...> - 2005-04-26 00:52:50
|
Ok, stranger. When I first set (logical-pathname-translations "PACKAGE"), translate-logical-pathname doesn't work, but when I reset (logical-pathname-translations "PACKAGE") with it's own "self-mangled" value, it works. Ie. setting logical-pathname-translations with pathnames made with MERGE-PATHNAMES makes the bug appear, but setting it with #P paths doesn't. ------------------------------------------------------------------------ [7]> (setf (logical-pathname-translations "EX")(list (list "EX:**;*.*" (merge-pathnames "**/*.*" "/ex/")))) ((#P"EX:**;*.*" #P"/ex/**/*.*")) [8]> (translate-logical-pathname "EX:A;B;C") *** - TRANSLATE-PATHNAME: replacement pieces ((:DIRECTORY "a" "b") "c" NIL NIL) do not fit into #P"/ex/**/*.*" The following restarts are available: ABORT :R1 ABORT Break 1 [9]> :a [10]> (setf (logical-pathname-translations "EX")(list (list "EX:**;*.*" "/ex/**/*.*"))) ((#P"EX:**;*.*" "/ex/**/*.*")) [11]> (translate-logical-pathname "EX:A;B;C") #P"/ex/a/b/c" [12]> (merge-pathnames "**/*.*" "/ex/") #P"/ex/**/*.*" [13]> (setf (logical-pathname-translations "EX")(list (list "EX:**;*.*" #P"/ex/**/*.*"))) ((#P"EX:**;*.*" #P"/ex/**/*.*")) [14]> (translate-logical-pathname "EX:A;B;C") #P"/ex/a/b/c" [15]> (setf (logical-pathname-translations "EX")(list (list "EX:**;*.*" (merge-pathnames "**/*.*" "/ex/")))) ((#P"EX:**;*.*" #P"/ex/**/*.*")) [16]> (translate-logical-pathname "EX:A;B;C") *** - TRANSLATE-PATHNAME: replacement pieces ((:DIRECTORY "a" "b") "c" NIL NIL) do not fit into #P"/ex/**/*.*" The following restarts are available: ABORT :R1 ABORT Break 1 [17]> :a [18]> (setf (logical-pathname-translations "EX")(list (list "EX:**;*.*" (make-pathname :directory '(:absolute "ex" :wild-inferiors) :name :wild :type :wild)))) ((#P"EX:**;*.*" #P"/ex/**/*.*")) [19]> (translate-logical-pathname "EX:A;B;C") #P"/ex/a/b/c" ------------------------------------------------------------------------ So the problem seems to lie in MERGE-PATHNAMES in 2.33.83 (it worked in 2.33.2). ------------------------------------------------------------------------ [pjb@thalassa bellerophon]$ $BASE/bin/clisp -norc -ansi -q -K full -m 32M -I -E ISO-8859-1 -Eterminal UTF-8 -x '(load "test.lisp")' [1]> ;; Loading file test.lisp ... LISP-IMPLEMENTATION-TYPE "CLISP" LISP-IMPLEMENTATION-VERSION "2.33.83 (2005-03-14) (built 3323445155) (memory 3323446250)" SOFTWARE-TYPE "gcc -W -Wswitch -Wcomment -Wpointer-arith -Wimplicit -Wreturn-type -Wno-sign-compare -O2 -fexpensive-optimizations -DUNICODE -DDYNAMIC_FFI -DNO_SIGSEGV -I. -x none libcharset.a libavcall.a libcallback.a -lreadline -lncurses -ldl -L/usr/X11R6/lib -lX11 SAFETY=0 HEAPCODES LINUX_NOEXEC_HEAPCODES SPVW_BLOCKS SPVW_MIXED TRIVIALMAP_MEMORY" SOFTWARE-VERSION "GNU C 3.3 20030226 (prerelease) (SuSE Linux)" MACHINE-INSTANCE "thalassa.informatimago.com [62.93.174.79]" MACHINE-TYPE "I686" MACHINE-VERSION "I686" (("PACKAGES:**;*.*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*.*") ("PACKAGES:**;*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*")) ((#P"PACKAGES:**;*.*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*.*") (#P"PACKAGES:**;*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*") ("PACKAGES:NET;COMON-LISP;UCW;**;*.*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/net/common-lisp/ucw-0.3.7/**/*.*") ("PACKAGES:NET;COMON-LISP;UCW;**;*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/net/common-lisp/ucw-0.3.7/**/*")) (TRANSLATE-PATHNAME "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE" "PACKAGES:**;*.*" "/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/**/*.*") --> #P"/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/com/informatimago/common-lisp/package" (TRANSLATE-LOGICAL-PATHNAME "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE") --> TRANSLATE-PATHNAME: replacement pieces ((:DIRECTORY "com" "informatimago" "common-lisp") "package" NIL NIL) do not fit into #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*.*" ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HERE IT DOESN'T WORK. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; NIL (EVAL (READ-FROM-STRING (WRITE-TO-STRING `(SETF (LOGICAL-PATHNAME-TRANSLATIONS "PACKAGES") ',(LOGICAL-PATHNAME-TRANSLATIONS "PACKAGES"))))) --> ((#P"PACKAGES:**;*.*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*.*") (#P"PACKAGES:**;*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/**/*") (#P"PACKAGES:NET;COMON-LISP;UCW;**;*.*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/net/common-lisp/ucw-0.3.7/**/*.*") (#P"PACKAGES:NET;COMON-LISP;UCW;**;*" #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/net/common-lisp/ucw-0.3.7/**/*")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; WE RESET TO THE SAME (theorically; logical pathname strings are now #P paths). ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (TRANSLATE-PATHNAME "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE" "PACKAGES:**;*.*" "/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/**/*.*") --> #P"/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/com/informatimago/common-lisp/package" (TRANSLATE-LOGICAL-PATHNAME "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE") --> #P"/home/pjb/src/lisp/encours/bellerophon/install/install/share/lisp/packages/com/informatimago/common-lisp/package" ;; Loaded file test.lisp ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; NOW IT WORKS! ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; T [pjb@thalassa bellerophon]$ cat test.lisp (setf (getenv "BASE") "/home/pjb/src/lisp/encours/bellerophon/install") (defun print-bug-report-info () (format t "~2%~{~28A ~S~%~}~2%" (list "LISP-IMPLEMENTATION-TYPE" (lisp-implementation-type) "LISP-IMPLEMENTATION-VERSION" (lisp-implementation-version) "SOFTWARE-TYPE" (software-type) "SOFTWARE-VERSION" (software-version) "MACHINE-INSTANCE" (machine-instance) "MACHINE-TYPE" (machine-type) "MACHINE-VERSION" (machine-version)))) (print-bug-report-info) (LET ((BASE (MAKE-PATHNAME :DIRECTORY (PATHNAME-DIRECTORY (if (getenv "BASE") (CONCATENATE 'STRING (GETENV "BASE") "/") *LOAD-PATHNAME*))))) (FLET ((MP (SUB) (MERGE-PATHNAMES SUB BASE)) (concat (&rest args) (apply (function concatenate) 'string args))) ((LAMBDA (&REST SPECS) (DOLIST (SPEC SPECS) (SETF (LOGICAL-PATHNAME-TRANSLATIONS (FIRST SPEC)) (print (NCONC (HANDLER-CASE (LOGICAL-PATHNAME-TRANSLATIONS (FIRST SPEC)) (ERROR () NIL)) (MAPCAR (LAMBDA (REST) (if (consp rest) (LIST (concat (SECOND SPEC) (first REST)) (MP (concat (THIRD SPEC) (second REST)))) (LIST (concat (SECOND SPEC) REST) (MP (concat (THIRD SPEC) REST))))) #+CLISP '("*.*" "*") #+sbcl '(("*.*.*" "*.*") "*.*" "*") #-(OR CLISP sbcl) '("*" "*.*" ("*.*.*" "*.*")) )))))) '("PACKAGES" "PACKAGES:**;" "install/share/lisp/packages/**/") '("PACKAGES" "PACKAGES:NET;COMON-LISP;UCW;**;" "install/share/lisp/packages/net/common-lisp/ucw-0.3.7/**/")))) (defmacro handling-errors (&body body) `(HANDLER-CASE (progn ,@body) (simple-condition (ERR) (format *error-output* "~&") (apply (function format) *error-output* (simple-condition-format-control err) (simple-condition-format-arguments err)) (format *error-output* "~&")) (condition (ERR) (format *error-output* "~&condition: ~S~%" err)))) (defmacro try (&body body) `(progn (format t "~3%~{~S~%~}-->" ',body) (print (handling-errors ,@body)))) (try (translate-pathname "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE" "PACKAGES:**;*.*" "/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/**/*.*")) (try (translate-logical-pathname "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE")) (try (eval (read-from-string (write-to-string `(SETF (LOGICAL-PATHNAME-TRANSLATIONS "PACKAGES") (quote ,(LOGICAL-PATHNAME-TRANSLATIONS "PACKAGES"))))))) (try (translate-pathname "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE" "PACKAGES:**;*.*" "/local/users/pjb/src/lisp/encours/bellerophon/install/share/lisp/packages/**/*.*")) (try (translate-logical-pathname "PACKAGES:COM;INFORMATIMAGO;COMMON-LISP;PACKAGE")) [pjb@thalassa bellerophon]$ -- __Pascal Bourguignon__ http://www.informatimago.com/ There is no worse tyranny than to force a man to pay for what he does not want merely because you think it would be good for him. -- Robert Heinlein |