Changeset 5628

Timestamp:

Dec 18, 2006, 11:57:49 AM (18 years ago)

Author:

Gary Byers

Message:

Try (halfheartedly) to maintain PATHNAME-VERSION of physical
pathnames. (Totally meaningless, but failing to do this leads to many
test failures.)

File:

• trunk/ccl/level-1/l1-files.lisp (modified) (7 diffs)

trunk/ccl/level-1/l1-files.lisp

@@ -204 +204 @@
 (defun %pathname-version (pathname)
   (if (logical-pathname-p pathname)
-      (%logical-pathname-version pathname)
-      :newest))
+    (%logical-pathname-version pathname)
+    (%physical-pathname-version pathname)))
 
 
@@ -215 +215 @@
 (defun pathname-version (thing)  ; redefined later in this file
   (declare (ignore thing))
-  :unspecific)
+  nil)
 
 (defmethod print-object ((pathname pathname) stream)
@@ -339 +339 @@
 (defun file-namestring (path)
   "Return a string representation of the name used in the pathname."
-  (let* ((name (pathname-name path))
+  (let* ((path (pathname path))
+         (name (pathname-name path))
          (type (pathname-type path))
-         (version (pathname-version path)))
+         (version (if (typep path 'logical-pathname) (pathname-version path))))
     (file-namestring-from-parts name type version)))
 
@@ -408 +409 @@
   (if (neq host :unspecific)
     (%cons-logical-pathname dir name type host version)
-    (%cons-pathname dir name type)))
+    (%cons-pathname dir name type version)))
 
 (defun pathname (path)
@@ -452 +453 @@
         (setq name (%std-name-component (%substr sstr start-pos end-pos))))
       (if (eq host :unspecific)
-        (%cons-pathname directory name type)
+        (%cons-pathname directory name type version)
         (%cons-logical-pathname directory name type host version)))))
 
@@ -510 +511 @@
   (setq path
         (if (eq host :unspecific)
-          (%cons-pathname directory name type)
+          (%cons-pathname directory name type version)
           (%cons-logical-pathname
            (or directory
@@ -751 +752 @@
   (typecase path
     (logical-pathname (%logical-pathname-version path))
-    (pathname :unspecific)
+    (pathname (%physical-pathname-version path))
     (string
      (multiple-value-bind (sstr start end) (get-sstring path)
        (multiple-value-bind (newstart host) (pathname-directory-end sstr start end)
          (if (eq host :unspecific)
-           :unspecific
+           nil
            (pathname-version-sstr sstr newstart end)))))
     (t (report-bad-arg path pathname-arg-type))))