diff --git a/asdf.lisp b/asdf.lisp index b871327980687e1fa37757b2d44217508235982c..cf6399d5f83db3c26d41926b24a8177f9dac0c56 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -147,7 +147,7 @@ (defvar *asdf-revision* ;; the 1+ hair is to ensure that we don't do an inadvertant find and replace - (subseq "REVISION:1.365" (1+ (length "REVISION")))) + (subseq "REVISION:1.366" (1+ (length "REVISION")))) (defvar *resolve-symlinks* t @@ -315,6 +315,21 @@ and NIL NAME and TYPE components" (declare (dynamic-extent format-args)) (apply #'format *verbose-out* format-string format-args)) +(defun split-path-string (s &optional force-directory) + (check-type s string) + (let* ((components (split s nil "/")) + (last-comp (car (last components)))) + (multiple-value-bind (relative components) + (if (equal (first components) "") + (values :absolute (cdr components)) + (values :relative components)) + (cond + ((equal last-comp "") + (values relative (butlast components) nil)) + (force-directory + (values relative components nil)) + (t + (values relative (butlast components) last-comp)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; classes, condiitons @@ -440,9 +455,11 @@ and NIL NAME and TYPE components" (defmethod component-relative-pathname ((component module)) (or (slot-value component 'relative-pathname) - (make-pathname - :directory `(:relative ,(component-name component)) - :host (pathname-host (component-parent-pathname component))))) + (multiple-value-bind (relative path) + (split-path-string (component-name component) t) + (make-pathname + :directory `(,relative ,@path) + :host (pathname-host (component-parent-pathname component)))))) (defmethod component-pathname ((component component)) (let ((*default-pathname-defaults* (component-parent-pathname component))) @@ -725,20 +742,18 @@ to `~a` which is not a directory.~@:>" (defmethod source-file-type ((c static-file) (s module)) nil) (defmethod component-relative-pathname ((component source-file)) - (let ((relative-pathname (slot-value component 'relative-pathname))) - (if relative-pathname - (merge-pathnames + (multiple-value-bind (relative path name) + (split-path-string (component-name component)) + (let ((type (source-file-type component (component-system component))) + (relative-pathname (slot-value component 'relative-pathname)) + (*default-pathname-defaults* (component-parent-pathname component))) + (if relative-pathname + (merge-pathnames relative-pathname - (make-pathname - :type (source-file-type component (component-system component)))) - (let* ((*default-pathname-defaults* - (component-parent-pathname component)) - (name-type - (make-pathname - :name (component-name component) - :type (source-file-type component - (component-system component))))) - name-type)))) + (if type + (make-pathname :name name :type type) + name)) + (make-pathname :directory `(,relative ,@path) :name name :type type))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; operations diff --git a/bin/bump-revision-and-tag.sh b/bin/bump-revision-and-tag.sh index c619dfefa59f485b98c9b2c8d8e0b1e126bfa495..91be9b42441e24298251aaa8b468c1af481c3c71 100755 --- a/bin/bump-revision-and-tag.sh +++ b/bin/bump-revision-and-tag.sh @@ -31,7 +31,7 @@ bumped=`expr $minor + 1` new_version="$major.$bumped" cp asdf.lisp asdf.bak -perl -pi -e "s/REVISION:.*\"/REVISION:$new_version\"/" asdf.lisp +perl -pi -e "s/REVISION:[^\"]*\"/REVISION:$new_version\"/" asdf.lisp echo "Update reversion and commit" git add asdf.lisp diff --git a/test/sources/level1/file1.lisp b/test/sources/level1/file1.lisp new file mode 100644 index 0000000000000000000000000000000000000000..336ddb98d9b5702485292ce77947441f444f86e1 --- /dev/null +++ b/test/sources/level1/file1.lisp @@ -0,0 +1,4 @@ +(defpackage :test-package (:use :cl)) +(in-package :test-package) +(defvar *file-tmp* t) + diff --git a/test/sources/level1/level2/file2.lisp b/test/sources/level1/level2/file2.lisp new file mode 100644 index 0000000000000000000000000000000000000000..09196900d291450616e4fa7d057cae103ef02c4a --- /dev/null +++ b/test/sources/level1/level2/file2.lisp @@ -0,0 +1,3 @@ +(in-package :test-package) +(defvar *file-tmp2* t) + diff --git a/test/test-module-pathnames.asd b/test/test-module-pathnames.asd new file mode 100644 index 0000000000000000000000000000000000000000..b7d3184f8205ecbed6d3df0d6876d4590993d8de --- /dev/null +++ b/test/test-module-pathnames.asd @@ -0,0 +1,11 @@ +;;; -*- Lisp -*- + +(asdf:defsystem test-module-pathnames + :components + ((:module "sources/level1" + :serial t + :components + ((:file "file1") + (:file "level2/file2") + (:static-file "test-tmp.cl"))))) + diff --git a/test/test-module-pathnames.script b/test/test-module-pathnames.script new file mode 100644 index 0000000000000000000000000000000000000000..68549e365c66e77cb699df59faf4fa9bb476742c --- /dev/null +++ b/test/test-module-pathnames.script @@ -0,0 +1,31 @@ +;;; -*- Lisp -*- +(load "script-support") +(load "../asdf") +(quit-on-error + (setf asdf:*central-registry* '(*default-pathname-defaults*)) + (asdf:operate 'asdf:load-op 'test-module-pathnames)) + +(quit-on-error + (assert (find-package :test-package) nil + "package test-package not found") + (assert (find-symbol (symbol-name '*file-tmp*) :test-package) nil + "symbol `*file-tmp*` not found") + (assert (symbol-value (find-symbol (symbol-name '*file-tmp*) :test-package)) + nil "symbol `*file-tmp*` has wrong value") + (assert (probe-file (merge-pathnames + (make-pathname + :name "file1" + :type (pathname-type (compile-file-pathname "x")) + :directory '(:relative "sources" "level1")))) + nil "compiled file not found") + + (assert (find-symbol (symbol-name '*file-tmp2*) :test-package) nil + "symbol `*file-tmp2*` not found") + (assert (symbol-value (find-symbol (symbol-name '*file-tmp2*) :test-package)) + nil "symbol `*file-tmp2*` has wrong value") + (assert (probe-file (merge-pathnames + (make-pathname + :name "file2" + :type (pathname-type (compile-file-pathname "x")) + :directory '(:relative "sources" "level1" "level2")))) + nil "compiled file not found")) diff --git a/test/test-tmp.cl b/test/test-tmp.cl new file mode 100644 index 0000000000000000000000000000000000000000..0a21fc2e1d5c43148d8aa27720ece8467e1a6c9d --- /dev/null +++ b/test/test-tmp.cl @@ -0,0 +1,3 @@ +;; part of the test-module-pathnames test + +(in-package #:test-package)