[Openmcl-devel] Troubles with logical pathnames

[Gary Byers]

I haven't looked at this yet; I'll try to do so soon.

Please nag if I don't respond in a couple of days.

On Sun, 16 Jul 2006, Richard M Kreuter wrote:

> Hello,
>
> In OpenMCL 1.0 (on GNU/Linux, if it matters), the operators load,
> require, compile-file, and open express the following surprising
> behaviors with relative logical pathnames:
>
> * load and require report that the file named by the relative logical
>  pathname doesn't exist (though probe-file returns non-nil for the
>  same argument),
>
> * compile-file and open act as if they merged the translated relative
>  logical pathname with #P"/"
>
> Below is a short program to demonstrate the behavior, along with the
> output from one run.  If a longer test program that includes checks
> for operators for which a relative logical pathname and its physical
> pathname translation work identically is desired, I can supply that
> too.
>
> Thanks,
> RmK
>
> --
> (in-package :cl-user)
>
> ;; A simple logical host that maps relative logical pathnames with no
> ;; directory to relative pathnames with a relative directory.
> (setf (logical-pathname-translations "foo")
>      `((";*.*.*" ,(make-pathname :directory '(:relative "bar")
> 				  :name :wild :type :wild :version :wild))))
>
> ;; A relative file name.
> (defvar *relative-path* (make-pathname :directory '(:relative "bar")
> 				       :name "file" :type "lisp"))
> ;; A logical pathname that should translate to the same name
> (defvar *relative-logical-path* "foo:;file.lisp.newest")
> ;; A pathname denoting another file in the same directory, for testing
> ;; rename-file.
> (defvar *relative-alt-path* (make-pathname :name "altfile" :type "lisp"))
>
> (defvar *forms*
>  '((namestring (translate-logical-pathname !))
>    (truename (namestring (translate-logical-pathname !)))
>
>    (load !)
>    (require (new-module) !)
>
>    (compile-file !)
>    (with-open-file (*standard-input* !)
>      (read-line))))
>
> (defun new-module ()
>  (loop
>     for i upfrom 0
>     for module = (format nil "FILE~D" i)
>     while (find module *modules* :test #'string=)
>     finally (return module)))
>
> (eval-when (:load-toplevel :execute)
>  (ensure-directories-exist *relative-path*)
>  (mapc
>   (lambda (paths)
>     (destructuring-bind (logical-path physical-path alt-path) paths
>
>       (mapc
> 	(lambda (form)
> 	  (with-open-file (*standard-output* physical-path
> 					     :direction :output
> 					     :if-exists :supersede)
> 	    (write '(eval-when (:compile-toplevel :load-toplevel :execute)
> 		     (write-line "Hello from file.lisp!")
> 		     (force-output))))
> 	  (let ((lform (subst logical-path '! form))
> 		(pform (subst physical-path '! form)))
> 	    (format t "> ~S~%" lform)
> 	    (format t "~{~A~%~}"(multiple-value-list (ignore-errors (eval lform))))
> 	    (format t "> ~S~%" pform)
> 	    (format t "~{~A~%~}"
> 		    (multiple-value-list (ignore-errors (eval pform))))
> 	    (ignore-errors
> 	      (delete-file physical-path)
> 	      (delete-file alt-path))))
> 	*forms*)))
>   (list (list *relative-logical-path* *relative-path* *relative-alt-path*)))
>  (force-output))
> --
>
> $ openmcl -n -l ./openmcl-logical-pathname-warts.lisp
>> (NAMESTRING (TRANSLATE-LOGICAL-PATHNAME "foo:;file.lisp.newest"))
> bar/file.lisp
>> (NAMESTRING (TRANSLATE-LOGICAL-PATHNAME #P"bar/file.lisp"))
> bar/file.lisp
>> (TRUENAME (NAMESTRING (TRANSLATE-LOGICAL-PATHNAME "foo:;file.lisp.newest")))
> /home/kreuter/bar/file.lisp
>> (TRUENAME (NAMESTRING (TRANSLATE-LOGICAL-PATHNAME #P"bar/file.lisp")))
> /home/kreuter/bar/file.lisp
>> (LOAD "foo:;file.lisp.newest")
> NIL
> File "foo:;file.lisp.newest" does not exist.
>> (LOAD #P"bar/file.lisp")
> Hello from file.lisp!
> /home/kreuter/bar/file.lisp
>> (REQUIRE (NEW-MODULE) "foo:;file.lisp.newest")
> NIL
> File "foo:;file.lisp.newest" does not exist.
>> (REQUIRE (NEW-MODULE) #P"bar/file.lisp")
> Hello from file.lisp!
> FILE0
> NIL
>> (COMPILE-FILE "foo:;file.lisp.newest")
> Hello from file.lisp!
> NIL
> Permission denied : "/bar/"
>> (COMPILE-FILE #P"bar/file.lisp")
> Hello from file.lisp!
> /home/kreuter/bar/file.pfsl
> NIL
> NIL
>> (WITH-OPEN-FILE (*STANDARD-INPUT* "foo:;file.lisp.newest") (READ-LINE))
> NIL
> No such file or directory : #P"/bar/file.lisp"
>> (WITH-OPEN-FILE (*STANDARD-INPUT* #P"bar/file.lisp") (READ-LINE))
> (EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (WRITE-LINE "Hello from file.lisp!") (FORCE-OUTPUT))
> T
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
>
>