From 30f9079fa0afe738c7f4d78f0cd61ff7fdd35bd6 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Sat, 31 Aug 2013 15:10:22 -0700 Subject: [PATCH] cref: (package-set-pathname "dir/") => "dir/dir-OS.pkd" --- src/runtime/packag.scm | 34 ++++++++++++++++++++++------------ 1 file changed, 22 insertions(+), 12 deletions(-) diff --git a/src/runtime/packag.scm b/src/runtime/packag.scm index 25eae3f90..70a10f532 100644 --- a/src/runtime/packag.scm +++ b/src/runtime/packag.scm @@ -181,18 +181,28 @@ USA. (define system-loader/enable-query? #f) (define (package-set-pathname pathname #!optional os-type) - (pathname-new-type - (pathname-new-name pathname - (string-append (pathname-name pathname) - "-" - (case (if (default-object? os-type) - microcode-id/operating-system - os-type) - ((NT) "w32") - ((OS/2) "os2") - ((UNIX) "unx") - (else "unk")))) - "pkd")) + (let ((p (->pathname pathname))) + (pathname-new-type + (pathname-new-name p + (string-append + (or (pathname-name p) + ;; Interpret dirname/ as dirname/dirname-OS.pkd. + (let ((dir (pathname-directory p))) + (if (pair? dir) + (let ((name (last dir))) + (if (string? name) + name + "")) + ""))) + "-" + (case (if (default-object? os-type) + microcode-id/operating-system + os-type) + ((NT) "w32") + ((OS/2) "os2") + ((UNIX) "unx") + (else "unk")))) + "pkd"))) (define-integrable (make-package-file tag version descriptions loads) (vector tag version descriptions loads)) -- 2.25.1