0.6.12.18:

	added code to initialize *DEFAULT-PATHNAME-DEFAULTS*,
		to start making it a little more ANSI
	started documenting visible-in-the-interface variables
		whose old values are discarded when a core is saved
		and loaded (e.g. *DEFAULT-PATHNAME-DEFAULTS*)
	tweaked side-effectful-pathnames.test.sh so it
		accepts the new more-ANSI behavior of
		*DEFAULT-PATHNAME-DEFAULTS*
	hacked LOAD to physicalize pathnames before merging them,
		to work around apparent MERGE-PATHNAMES problems
		and let tests/filesys.pure.lisp work with new
		nontrivial *DEFAULT-PATHNAME-DEFAULTS*; also
		hacked COMPILE-FILE-PATHNAME similarly
	factored out DEFUN PHYSICALIZE-PATHNAME
	made FILE-LENGTH "work" (up to 32 bits) on OpenBSD again

diff --git a/base-target-features.lisp-expr b/base-target-features.lisp-expr
index 3ae733f..5aa58f7 100644 (file)
--- a/base-target-features.lisp-expr
+++ b/base-target-features.lisp-expr
@@ -3,9 +3,20 @@
 ;;;; CL:*FEATURES* tags which have special meaning to SBCL or which
 ;;;; have a special conventional meaning
 ;;;;
 ;;;; CL:*FEATURES* tags which have special meaning to SBCL or which
 ;;;; have a special conventional meaning
 ;;;;

-;;;; Note that the preferred way to customize the features of a local
-;;;; build of SBCL is not to edit this file, but to tweak
-;;;; customize-target-features.lisp.
+;;;; Note that the recommended way to customize the features of a
+;;;; local build of SBCL is not to edit this file, but instead to
+;;;; tweak customize-target-features.lisp. E.g. you can use code like
+;;;; this:
+;;;;    (lambda (list)
+;;;;      (flet ((enable (x) (pushnew x list))
+;;;;            (disable (x) (setf list (remove x list))))
+;;;;        #+nil (enable :sb-show)
+;;;;        (enable :sb-after-xc-core)
+;;;;        #+nil (disable :sb-doc)
+;;;;        list))
+;;;; That way, because customize-target-features.lisp is in
+;;;; .cvsignore, your local changes will remain local even if you use
+;;;; "cvs diff" to submit patches to SBCL.

 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.

@@ -29,7 +40,7 @@
  :sbcl
 
  ;; Douglas Thomas Crosher's conservative generational GC (the only one
  :sbcl
 
  ;; Douglas Thomas Crosher's conservative generational GC (the only one

- ;; we currently support)
+ ;; we currently support for X86)

  :gencgc
 
  ;; We're running under a UNIX. This is sort of redundant, and it was also
  :gencgc
 
  ;; We're running under a UNIX. This is sort of redundant, and it was also

@@ -257,14 +268,18 @@
  ;; really, really know what you're doing):
  ;; 
  ;; machine architecture features:
  ;; really, really know what you're doing):
  ;; 
  ;; machine architecture features:

- ;;   :x86 ; any Intel 386 or better, or compatibles like the AMD K6 or K7
- ;;   (No others are supported by SBCL as of 0.6.7, but :alpha or 
- ;;   :sparc support could be ported from CMU CL if anyone is
- ;;   sufficiently motivated to do so.)
- ;;   (CMU CL also had a :pentium feature, which affected the definition 
- ;;   of some floating point vops. It was present but not enabled in the
- ;;   CMU CL code that SBCL is derived from, and is present but stale
- ;;   in SBCL as of 0.6.7.)
+ ;;   :x86
+ ;;      any Intel 386 or better, or compatibles like the AMD K6 or K7
+ ;;   :alpha
+ ;;      DEC/Compaq Alpha CPU
+ ;; (No other CPUs are supported by SBCL as of 0.6.12.15, but SPARC or
+ ;; PowerPC support could be ported from CMU CL if anyone is
+ ;; sufficiently motivated to do so, or if you're *really* motivated,
+ ;; you could write a port from scratch for a new CPU architecture.)
+ ;; (CMU CL also had a :pentium feature, which affected the definition
+ ;; of some floating point vops. It was present but not enabled or 
+ ;; documented in the CMU CL code that SBCL is derived from, and is
+ ;; present but stale in SBCL as of 0.6.12.)

  ;;
  ;; operating system features:
  ;;   :linux   = We're intended to run under some version of Linux.
  ;;
  ;; operating system features:
  ;;   :linux   = We're intended to run under some version of Linux.

@@ -275,5 +290,6 @@
  ;;   :openbsd = We're intended to run under FreeBSD.
  ;; (No others are supported by SBCL as of 0.6.7, but :hpux or
  ;; :solaris support could be ported from CMU CL if anyone is
  ;;   :openbsd = We're intended to run under FreeBSD.
  ;; (No others are supported by SBCL as of 0.6.7, but :hpux or
  ;; :solaris support could be ported from CMU CL if anyone is

- ;; sufficiently motivated to do so.)
+ ;; sufficiently motivated to do so, and it'd even be possible,
+ ;; though harder, to port the system to Microsoft Windows.)

  )
  )

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index ee65d18..27f1be3 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -676,6 +676,7 @@ retained, possibly temporariliy, because it might be used internally."
              "CONSTANTLY-T" "CONSTANTLY-NIL" "CONSTANTLY-0"
              "PSXHASH"
              "%BREAK"
              "CONSTANTLY-T" "CONSTANTLY-NIL" "CONSTANTLY-0"
              "PSXHASH"
              "%BREAK"

+             "PHYSICALIZE-PATHNAME"

 
              ;; ..and macros..
              "COLLECT"
 
              ;; ..and macros..
              "COLLECT"

diff --git a/src/code/bsd-os.lisp b/src/code/bsd-os.lisp
index 8e30939..22edc57 100644 (file)
--- a/src/code/bsd-os.lisp
+++ b/src/code/bsd-os.lisp
@@ -31,12 +31,10 @@
                           (sb!ext:run-program "/usr/bin/uname" `("-r")
                                               :output stream))))))
 \f
                           (sb!ext:run-program "/usr/bin/uname" `("-r")
                                               :output stream))))))
 \f

-;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface.
-;;; It sets the values of the global port variables to what they
-;;; should be and calls the functions that set up the argument blocks
-;;; for the server interfaces.

 (defun os-cold-init-or-reinit ()
 (defun os-cold-init-or-reinit ()

-  (setf *software-version* nil))
+  (setf *software-version* nil)
+  (setf *default-pathname-defaults*
+       (pathname (sb!ext::default-directory))))

 
 ;;; Return system time, user time and number of page faults.
 (defun get-system-info ()
 
 ;;; Return system time, user time and number of page faults.
 (defun get-system-info ()

diff --git a/src/code/extensions.lisp b/src/code/extensions.lisp
index 4c6c4e2..7dd9b95 100644 (file)
--- a/src/code/extensions.lisp
+++ b/src/code/extensions.lisp
@@ -854,6 +854,14 @@
         (print-unreadable-object (structure ,stream :type t)
           ,@(nreverse reversed-prints))))))
 \f
         (print-unreadable-object (structure ,stream :type t)
           ,@(nreverse reversed-prints))))))
 \f

+;;;; etc.
+
+;;; Given a pathname, return a corresponding physical pathname.
+(defun physicalize-pathname (possibly-logical-pathname)
+  (if (typep possibly-logical-pathname 'logical-pathname)
+      (translate-logical-pathname possibly-logical-pathname)
+      possibly-logical-pathname))
+\f

 #|
 ;;; REMOVEME when done testing byte cross-compiler
 (defun byte-compiled-foo (x y)
 #|
 ;;; REMOVEME when done testing byte cross-compiler
 (defun byte-compiled-foo (x y)

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 5d6e867..583345f 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -858,12 +858,6 @@
     (:charpos
      (fd-stream-char-pos fd-stream))
     (:file-length
     (:charpos
      (fd-stream-char-pos fd-stream))
     (:file-length

-     ;; FIXME: This is broken on OpenBSD until the FFI, or at least
-     ;; UNIX-FSTAT, learns to extract 64-bit values. (As of sbcl-0.6.12.8,
-     ;; UNIX-FSTAT returns a 0 placeholder instead.)
-     #!+openbsd
-     (error "FIXME: internal error, FILE-LENGTH is broken on OpenBSD")
-     #!-openbsd

      (multiple-value-bind (okay dev ino mode nlink uid gid rdev size
                           atime mtime ctime blksize blocks)
         (sb!unix:unix-fstat (fd-stream-fd fd-stream))
      (multiple-value-bind (okay dev ino mode nlink uid gid rdev size
                           atime mtime ctime blksize blocks)
         (sb!unix:unix-fstat (fd-stream-fd fd-stream))

@@ -882,8 +876,7 @@
           (type (or index (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts
           (type (or index (member nil :start :end)) newpos))
   (if (null newpos)
       (sb!sys:without-interrupts

-       ;; First, find the position of the UNIX file descriptor in the
-       ;; file.
+       ;; First, find the position of the UNIX file descriptor in the file.

        (multiple-value-bind (posn errno)
            (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
          (declare (type (or index null) posn))
        (multiple-value-bind (posn errno)
            (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr)
          (declare (type (or index null) posn))

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 6985a3d..e33a94f 100644 (file)
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -746,15 +746,9 @@
   (if (empty-relative-pathname-spec-p pathname-spec)
       "."
       ;; Otherwise, the ordinary rules apply.
   (if (empty-relative-pathname-spec-p pathname-spec)
       "."
       ;; Otherwise, the ordinary rules apply.

-      (let* ((possibly-logical-pathname (pathname pathname-spec))
-            (physical-pathname (if (typep possibly-logical-pathname
-                                          'logical-pathname)
-                                   (namestring (translate-logical-pathname
-                                                possibly-logical-pathname))
-                                   possibly-logical-pathname))
+      (let* ((namestring (physicalize-pathname (pathname pathname-spec)))

             (matches nil)) ; an accumulator for actual matches
             (matches nil)) ; an accumulator for actual matches

-       (enumerate-matches (match physical-pathname nil
-                                 :verify-existence for-input)
+       (enumerate-matches (match namestring nil :verify-existence for-input)

           (push match matches))
        (case (length matches)
          (0 nil)
           (push match matches))
        (case (length matches)
          (0 nil)

@@ -1066,11 +1060,8 @@
   actually exist, and attempt to create them if they do not.
   The MODE argument is a CMUCL/SBCL-specific extension to control
   the Unix permission bits."
   actually exist, and attempt to create them if they do not.
   The MODE argument is a CMUCL/SBCL-specific extension to control
   the Unix permission bits."

-  (let* ((pathname (pathname pathspec))
-        (pathname (if (typep pathname 'logical-pathname)
-                      (translate-logical-pathname pathname)
-                      pathname))
-        (created-p nil))
+  (let ((pathname (physicalize-pathname (pathname pathspec)))
+       (created-p nil))

     (when (wild-pathname-p pathname)
       (error 'simple-file-error
             :format-control "bad place for a wild pathname"
     (when (wild-pathname-p pathname)
       (error 'simple-file-error
             :format-control "bad place for a wild pathname"

diff --git a/src/code/linux-os.lisp b/src/code/linux-os.lisp
index df6ca15..1d87b6f 100644 (file)
--- a/src/code/linux-os.lisp
+++ b/src/code/linux-os.lisp
@@ -33,13 +33,12 @@
                           (sb!ext:run-program "/bin/uname" `("-r")
                                               :output stream))))))
 
                           (sb!ext:run-program "/bin/uname" `("-r")
                                               :output stream))))))
 

-;;; OS-COLD-INIT-OR-REINIT initializes our operating-system interface.
-;;; It sets the values of the global port variables to what they
-;;; should be and calls the functions that set up the argument blocks
-;;; for the server interfaces.

 (defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here
   #!+sparc ;; Can't use #x20000000 thru #xDFFFFFFF, but mach tries to let us.
 (defun os-cold-init-or-reinit () ; KLUDGE: don't know what to do here
   #!+sparc ;; Can't use #x20000000 thru #xDFFFFFFF, but mach tries to let us.

-  (sb!sys:allocate-system-memory-at (sb!sys:int-sap #x20000000) #xc0000000))
+  (sb!sys:allocate-system-memory-at (sb!sys:int-sap #x20000000) #xc0000000)
+  (setf *software-version* nil)
+  (setf *default-pathname-defaults*
+       (pathname (sb!ext::default-directory))))

 
 ;;; Return system time, user time and number of page faults.
 (defun get-system-info ()
 
 ;;; Return system time, user time and number of page faults.
 (defun get-system-info ()

diff --git a/src/code/save.lisp b/src/code/save.lisp
index beb9286..dfaa5cf 100644 (file)
--- a/src/code/save.lisp
+++ b/src/code/save.lisp
@@ -49,27 +49,31 @@
   out early because of some argument error or something).
 
   The following &KEY args are defined:
   out early because of some argument error or something).
 
   The following &KEY args are defined:

+    :TOPLEVEL
+       The function to run when the created core file is resumed.
+       The default function handles command line toplevel option
+       processing and runs the top level read-eval-print loop. This
+       function should not return.
+    :PURIFY
+       If true (the default), do a purifying GC which moves all dynamically
+       allocated objects into static space so that they stay pure. This takes
+       somewhat longer than the normal GC which is otherwise done, but it's
+       only done once, and subsequent GC's will be done less often and will
+       take less time in the resulting core file. See PURIFY.
+    :ROOT-STRUCTURES
+       This should be a list of the main entry points in any newly loaded
+       systems. This need not be supplied, but locality and/or GC performance
+       may be better if they are. Meaningless if :PURIFY is NIL. See PURIFY.
+    :ENVIRONMENT-NAME
+       This is also passed to PURIFY when :PURIFY is T. (rarely used)

 
 

-  :TOPLEVEL
-      The function to run when the created core file is resumed.
-  The default function handles command line toplevel option
-  processing and runs the top level read-eval-print loop. This
-  function should not return.
-
-  :PURIFY
-      If true (the default), do a purifying GC which moves all dynamically
-  allocated objects into static space so that they stay pure. This takes
-  somewhat longer than the normal GC which is otherwise done, but it's only
-  done once, and subsequent GC's will be done less often and will take less
-  time in the resulting core file. See PURIFY.
-
-  :ROOT-STRUCTURES
-      This should be a list of the main entry points in any newly loaded
-  systems. This need not be supplied, but locality and/or GC performance
-  may be better if they are. Meaningless if :PURIFY is NIL. See PURIFY.
-
-  :ENVIRONMENT-NAME
-      This is also passed to PURIFY when :PURIFY is T. (rarely used)"
+  The save/load process changes the values of some global variables:
+    *STANDARD-OUTPUT*, *DEBUG-IO*, etc.
+      Everything related to open streams is necessarily changed, since
+      the OS won't let us preserve a stream across save and load.
+    *DEFAULT-PATHNAME-DEFAULTS*
+      This is reinitialized to reflect the working directory where the
+      saved core is loaded."

 
   #!+mp (sb!mp::shutdown-multi-processing)
   (when (fboundp 'sb!eval:flush-interpreted-function-cache)
 
   #!+mp (sb!mp::shutdown-multi-processing)
   (when (fboundp 'sb!eval:flush-interpreted-function-cache)

diff --git a/src/code/target-load.lisp b/src/code/target-load.lisp
index fe2bd03..bb82e38 100644 (file)
--- a/src/code/target-load.lisp
+++ b/src/code/target-load.lisp
@@ -186,28 +186,37 @@
                        '(unsigned-byte 8)))
             (load-as-fasl filespec verbose print)
             (load-as-source filespec verbose print))
                        '(unsigned-byte 8)))
             (load-as-fasl filespec verbose print)
             (load-as-source filespec verbose print))

-        (let ((pn (merge-pathnames (pathname filespec)
-                                   *default-pathname-defaults*)))
-          (if (wild-pathname-p pn)
-              (let ((files (directory pn)))
+        (let (;; FIXME: MERGE-PATHNAMES doesn't work here for
+              ;; FILESPEC="TEST:Load-Test" and
+              ;; (LOGICAL-PATHNAME-TRANSLATIONS "TEST")
+              ;;   = (("**;*.*.*" "/foo/bar/**/*.*")).
+              ;; Physicalizing the pathname before merging 
+              ;; is a workaround, but the ANSI spec talks about
+              ;; MERGE-PATHNAMES accepting (and returning)
+              ;; logical pathnames, so a true fix would probably
+              ;; include fixing MERGE-PATHNAMES, then probably
+              ;; revisiting this code.
+              (ppn (physicalize-pathname (pathname filespec))))
+          (if (wild-pathname-p ppn)
+              (let ((files (directory ppn)))

                 #!+high-security
                 (when (null files)
                   (error 'file-error :pathname filespec))
                 (dolist (file files t)
                 #!+high-security
                 (when (null files)
                   (error 'file-error :pathname filespec))
                 (dolist (file files t)

-                  (internal-load pn
+                  (internal-load ppn

                                  file
                                  internal-if-does-not-exist
                                  verbose
                                  print)))
                                  file
                                  internal-if-does-not-exist
                                  verbose
                                  print)))

-              (let ((tn (probe-file pn)))
-                (if (or tn (pathname-type pn))
-                    (internal-load pn
+              (let ((tn (probe-file ppn)))
+                (if (or tn (pathname-type ppn))
+                    (internal-load ppn

                                    tn
                                    internal-if-does-not-exist
                                    verbose
                                    print)
                     (internal-load-default-type
                                    tn
                                    internal-if-does-not-exist
                                    verbose
                                    print)
                     (internal-load-default-type

-                     pn
+                     ppn

                      internal-if-does-not-exist
                      verbose
                      print)))))))))
                      internal-if-does-not-exist
                      verbose
                      print)))))))))

diff --git a/src/code/target-pathname.lisp b/src/code/target-pathname.lisp
index f3dd156..cca3068 100644 (file)
--- a/src/code/target-pathname.lisp
+++ b/src/code/target-pathname.lisp
@@ -1198,9 +1198,7 @@ a host-structure or string."
   values)
 
 (defun %enumerate-search-list (pathname function)
   values)
 
 (defun %enumerate-search-list (pathname function)

-  (let* ((pathname (if (typep pathname 'logical-pathname)
-                      (translate-logical-pathname pathname)
-                      pathname))
+  (let* ((pathname (physicalize-pathname pathname))

         (search-list (extract-search-list pathname nil)))
     (cond
      ((not search-list)
         (search-list (extract-search-list pathname nil)))
     (cond
      ((not search-list)

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index b2a99e3..4750013 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -562,24 +562,16 @@
          (slot wrapped-stat 'st-uid)
          (slot wrapped-stat 'st-gid)
          (slot wrapped-stat 'st-rdev)
          (slot wrapped-stat 'st-uid)
          (slot wrapped-stat 'st-gid)
          (slot wrapped-stat 'st-rdev)

-         ;; FIXME: OpenBSD has a 64-bit st_size slot, which is
-         ;; basically a good thing, except that it is too
-         ;; 21st-century for sbcl-0.6.12.8's FFI to handle. As a
-         ;; quick kludgy workaround, we return a 0 placeholder from
-         ;; this function, and downstream we stub out the FILE-LENGTH
-         ;; operation (which is the only place that SBCL actually
-         ;; uses the SIZE value returned from any UNIX-STAT-ish call).
-         #!+openbsd 0
-         #!-openbsd (slot wrapped-stat 'st-size)
+         (slot wrapped-stat 'st-size)

          (slot wrapped-stat 'st-atime)
          (slot wrapped-stat 'st-mtime)
          (slot wrapped-stat 'st-ctime)
          (slot wrapped-stat 'st-blksize)
          (slot wrapped-stat 'st-blocks)))
 
          (slot wrapped-stat 'st-atime)
          (slot wrapped-stat 'st-mtime)
          (slot wrapped-stat 'st-ctime)
          (slot wrapped-stat 'st-blksize)
          (slot wrapped-stat 'st-blocks)))
 

-;;; Unix system calls in the stat(2) family are implemented as calls
-;;; to C-level wrapper functions which copy all the raw "struct
-;;; stat" slots into the system-independent wrapped_stat format.
+;;; Unix system calls in the stat(2) family are handled by calls to
+;;; C-level wrapper functions which copy all the raw "struct stat"
+;;; slots into the system-independent wrapped_stat format.

 ;;;    stat(2) <->  stat_wrapper()
 ;;;   fstat(2) <-> fstat_wrapper()
 ;;;   lstat(2) <-> lstat_wrapper()
 ;;;    stat(2) <->  stat_wrapper()
 ;;;   fstat(2) <-> fstat_wrapper()
 ;;;   lstat(2) <-> lstat_wrapper()

@@ -604,8 +596,8 @@
 \f
 ;;;; time.h
 
 \f
 ;;;; time.h
 

-;; the POSIX.4 structure for a time value. This is like a `struct
-;; timeval' but has nanoseconds instead of microseconds.
+;; the POSIX.4 structure for a time value. This is like a "struct
+;; timeval" but has nanoseconds instead of microseconds.

 (def-alien-type nil
     (struct timespec
            (tv-sec long)   ; seconds
 (def-alien-type nil
     (struct timespec
            (tv-sec long)   ; seconds

@@ -617,14 +609,14 @@
            (tm-sec int)   ; Seconds.   [0-60] (1 leap second)
            (tm-min int)   ; Minutes.   [0-59]
            (tm-hour int)  ; Hours.     [0-23]
            (tm-sec int)   ; Seconds.   [0-60] (1 leap second)
            (tm-min int)   ; Minutes.   [0-59]
            (tm-hour int)  ; Hours.     [0-23]

-           (tm-mday int)  ; Day.               [1-31]
-           (tm-mon int)   ;  Month.    [0-11]
-           (tm-year int)  ; Year       - 1900.
-           (tm-wday int)  ; Day of week.       [0-6]
-           (tm-yday int)  ; Days in year.[0-365]
-           (tm-isdst int) ;  DST.              [-1/0/1]
-           (tm-gmtoff long)    ;  Seconds east of UTC.
-           (tm-zone c-string)))        ; Timezone abbreviation.
+           (tm-mday int)  ; Day.       [1-31]
+           (tm-mon int)   ; Month.     [0-11]
+           (tm-year int)  ; Year - 1900.
+           (tm-wday int)  ; Day of week. [0-6]
+           (tm-yday int)  ; Days in year. [0-365]
+           (tm-isdst int) ; DST.       [-1/0/1]
+           (tm-gmtoff long) ;  Seconds east of UTC.
+           (tm-zone c-string))) ; Timezone abbreviation.

 
 (def-alien-routine get-timezone sb!c-call:void
   (when sb!c-call:long :in)
 
 (def-alien-routine get-timezone sb!c-call:void
   (when sb!c-call:long :in)

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index e359b1a..3f7d8e5 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -1605,7 +1605,17 @@
 ;;; default to the appropriate implementation-defined default type for
 ;;; compiled files.
 (defun cfp-output-file-default (input-file)
 ;;; default to the appropriate implementation-defined default type for
 ;;; compiled files.
 (defun cfp-output-file-default (input-file)

-  (let* ((defaults (merge-pathnames input-file
+  (let* (;; FIXME: I think the PHYSICALIZE-PATHNAME wrapper here
+        ;; shouldn't really be necessary. Unfortunately
+        ;; sbcl-0.6.12.18's MERGE-PATHNAMES doesn't like logical
+        ;; pathnames very much, and doesn't get good results in
+        ;; tests/side-effectful-pathnames.sh for (COMPILE-FILE
+        ;; "TEST:$StudlyCapsStem"), unless I do this. It would be
+        ;; good to straighten out how MERGE-PATHNAMES is really
+        ;; supposed to work for logical pathnames, and add a bunch of
+        ;; test cases to check it, then get rid of this cruft.
+        (defaults (merge-pathnames (physicalize-pathname (pathname
+                                                          input-file))

                                    *default-pathname-defaults*))
         (retyped (make-pathname :type *backend-fasl-file-type*
                                 :defaults defaults)))
                                    *default-pathname-defaults*))
         (retyped (make-pathname :type *backend-fasl-file-type*
                                 :defaults defaults)))

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index 012bdbf..0356cd5 100644 (file)
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -12,16 +12,17 @@
 (in-package "CL-USER")
 
 ;;; In sbcl-0.6.9 FOO-NAMESTRING functions  returned "" instead of NIL.
 (in-package "CL-USER")
 
 ;;; In sbcl-0.6.9 FOO-NAMESTRING functions  returned "" instead of NIL.

-(let ((pathname0  (make-pathname :host nil 
-                                :directory 
-                                (pathname-directory
-                                 *default-pathname-defaults*)
-                                :name "getty"))
+(let ((pathname0 (make-pathname :host nil 
+                               :directory
+                               (pathname-directory
+                                *default-pathname-defaults*)
+                               :name "getty"))

       (pathname1 (make-pathname :host nil 
                                :directory nil
                                :name nil)))
   (assert (equal (file-namestring pathname0) "getty"))
       (pathname1 (make-pathname :host nil 
                                :directory nil
                                :name nil)))
   (assert (equal (file-namestring pathname0) "getty"))

-  (assert (equal (directory-namestring pathname0) ""))
+  (assert (equal (directory-namestring pathname0)
+                (directory-namestring *default-pathname-defaults*)))

   (assert (equal (file-namestring pathname1) ""))
   (assert (equal (directory-namestring pathname1) "")))
 
   (assert (equal (file-namestring pathname1) ""))
   (assert (equal (directory-namestring pathname1) "")))
 

diff --git a/tests/side-effectful-pathnames.test.sh b/tests/side-effectful-pathnames.test.sh
index 464f075..d5c50fb 100644 (file)
--- a/tests/side-effectful-pathnames.test.sh
+++ b/tests/side-effectful-pathnames.test.sh
@@ -35,6 +35,7 @@ $SBCL <<EOF
     (format t "translation=~S~%" translation)
     (format t "expected-translation=~S~%" expected-translation)
     (assert (string= translation expected-translation)))
     (format t "translation=~S~%" translation)
     (format t "expected-translation=~S~%" expected-translation)
     (assert (string= translation expected-translation)))

+  (format t "about to LOAD ~S~%" "TEST:$StudlyCapsStem")

   (load "TEST:$StudlyCapsStem")
   (assert (eq *loaded* :yes))
   (let ((compiled-file-name (namestring (compile-file "TEST:$StudlyCapsStem")))
   (load "TEST:$StudlyCapsStem")
   (assert (eq *loaded* :yes))
   (let ((compiled-file-name (namestring (compile-file "TEST:$StudlyCapsStem")))

diff --git a/version.lisp-expr b/version.lisp-expr
index b6f75fb..d4f6100 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 

-"0.6.12.17"
+"0.6.12.18"