From fc8aa7524a7391eded0e775ebf02f55e12a5dee1 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Thu, 3 Nov 2011 14:24:56 -0400 Subject: [PATCH] 2.018.5: simplifying a few internals, introducing strcat. --- asdf.asd | 2 +- asdf.lisp | 67 +++++++++++++++++++++++++------------------------------ 2 files changed, 32 insertions(+), 37 deletions(-) diff --git a/asdf.asd b/asdf.asd index cddd84a1..cd8a35fa 100644 --- a/asdf.asd +++ b/asdf.asd @@ -14,7 +14,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.018.4" ;; to be automatically updated by bin/bump-revision + :version "2.018.5" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:file "asdf") diff --git a/asdf.lisp b/asdf.lisp index fe31e835..fbc2808a 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- -;;; This is ASDF 2.018.4: Another System Definition Facility. +;;; This is ASDF 2.018.5: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. @@ -86,6 +86,8 @@ (find-symbol (string s) p)) ;; Strip out formatting that is not supported on Genera. ;; Has to be inside the eval-when to make Lispworks happy (!) + (defun strcat (&rest strings) + (apply 'concatenate 'string strings)) (defmacro compatfmt (format) #-(or gcl genera) format #+(or gcl genera) @@ -94,10 +96,8 @@ '(("~3i~_" . "")) #+genera '(("~@<" . "") ("; ~@;" . "; ") ("~@:>" . "") ("~:>" . ""))) :do (loop :for found = (search unsupported format) :while found :do - (setf format - (concatenate 'simple-string - (subseq format 0 found) replacement - (subseq format (+ found (length unsupported))))))) + (setf format (strcat (subseq format 0 found) replacement + (subseq format (+ found (length unsupported))))))) format) (let* (;; For bug reporting sanity, please always bump this version when you modify this file. ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version @@ -107,7 +107,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.018.4") + (asdf-version "2.018.5") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) @@ -185,7 +185,7 @@ (push sym bothly-exported-symbols) (push sym formerly-exported-symbols))) (loop :for sym :in export :do - (unless (member sym bothly-exported-symbols :test 'string-equal) + (unless (member sym bothly-exported-symbols :test 'equal) (push sym newly-exported-symbols))) (loop :for user :in (package-used-by-list package) :for shadowing = (package-shadowing-symbols user) :do @@ -892,24 +892,21 @@ with given pathname and if it exists return its truename." (host (pathname-host pathname)) (port (ext:pathname-port pathname)) (directory (pathname-directory pathname))) - (flet ((not-unspecific (component) - (and (not (eq component :unspecific)) component))) - (cond ((or (not-unspecific port) - (and (not-unspecific host) (plusp (length host))) - (not-unspecific scheme)) - (let ((prefix "")) - (when (not-unspecific port) - (setf prefix (format nil ":~D" port))) - (when (and (not-unspecific host) (plusp (length host))) - (setf prefix (concatenate 'string host prefix))) - (setf prefix (concatenate 'string ":" prefix)) - (when (not-unspecific scheme) - (setf prefix (concatenate 'string scheme prefix))) - (assert (and directory (eq (first directory) :absolute))) - (make-pathname :directory `(:absolute ,prefix ,@(rest directory)) - :defaults pathname))) - (t - pathname))))) + (if (or (ununspecific port) + (and (ununspecific host) (plusp (length host))) + (ununspecific scheme)) + (let ((prefix "")) + (when (ununspecific port) + (setf prefix (format nil ":~D" port))) + (when (and (ununspecific host) (plusp (length host))) + (setf prefix (strcat host prefix))) + (setf prefix (strcat ":" prefix)) + (when (ununspecific scheme) + (setf prefix (strcat scheme prefix))) + (assert (and directory (eq (first directory) :absolute))) + (make-pathname :directory `(:absolute ,prefix ,@(rest directory)) + :defaults pathname))) + pathname)) ;;;; ------------------------------------------------------------------------- ;;;; ASDF Interface, in terms of generic functions. @@ -1449,11 +1446,10 @@ NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3" (file-position s (+ start network-volume-offset #x14)))) - (concatenate 'string - (read-null-terminated-string s) - (progn - (file-position s (+ start remaining-offset)) - (read-null-terminated-string s)))))) + (strcat (read-null-terminated-string s) + (progn + (file-position s (+ start remaining-offset)) + (read-null-terminated-string s)))))) (defun* parse-windows-shortcut (pathname) (with-open-file (s pathname :element-type '(unsigned-byte 8)) @@ -1598,7 +1594,7 @@ Going forward, we recommend new users should be using the source-registry. (let ((shortcut (make-pathname :defaults defaults :version :newest :case :local - :name (concatenate 'string name ".asd") + :name (strcat name ".asd") :type "lnk"))) (when (probe-file* shortcut) (let ((target (parse-windows-shortcut shortcut))) @@ -2635,7 +2631,7 @@ created with the same initargs as the original one. ")) (setf (documentation 'oos 'function) (format nil - "Short for _operate on system_ and an alias for the OPERATE function. ~&~&~a" + "Short for _operate on system_ and an alias for the OPERATE function.~%~%~a" operate-docstring)) (setf (documentation 'operate 'function) operate-docstring)) @@ -2725,8 +2721,7 @@ Returns the new tree (which probably shares structure with the old one)" (defvar *serial-depends-on* nil) (defun* sysdef-error-component (msg type name value) - (sysdef-error (concatenate 'string msg - (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>")) + (sysdef-error (strcat msg (compatfmt "~&~@<The value specified for ~(~A~) ~A is ~S~@:>")) type name value)) (defun* check-component-input (type name weakly-depends-on @@ -2961,7 +2956,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code." (ccl:run-program (cond ((os-unix-p) "/bin/sh") - ((os-windows-p) (format nil "CMD /C ~A" command)) ; BEWARE! + ((os-windows-p) (strcat "CMD /C " command)) ; BEWARE! (t (error "Unsupported OS"))) (if (os-unix-p) (list "-c" command) '()) :input nil :output *verbose-out* :wait t))) @@ -3725,7 +3720,7 @@ effectively disabling the output translation facility." (defun* tmpize-pathname (x) (make-pathname - :name (format nil "ASDF-TMP-~A" (pathname-name x)) + :name (strcat "ASDF-TMP-" (pathname-name x)) :defaults x)) (defun* delete-file-if-exists (x) -- GitLab