[Openmcl-devel] Troubles with logical pathnames

[Richard M Kreuter]

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