Commit 304923f7 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.32.25: make strcat accept characters as string designators.

parent 239901d1
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.32.24" ;; to be automatically updated by make bump-version :version "2.32.25" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.32.24: Another System Definition Facility. ;;; This is ASDF 2.32.25: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -216,7 +216,8 @@ ...@@ -216,7 +216,8 @@
(assert (not (base-string-p (make-string 10 :element-type 'character)))) (assert (not (base-string-p (make-string 10 :element-type 'character))))
(assert (not (base-string-p "abc"))) (assert (not (base-string-p "abc")))
(assert (base-string-p (basify "abc"))) (assert (base-string-p (basify "abc")))
(assert (not (base-string-p (strcat "a" NIL "b" "cd")))) (assert (not (base-string-p (strcat "a" NIL #\b "cd"))))
(assert (base-string-p (reduce/strcat (mapcar 'basify '("a" "b" NIL "cd"))))) (assert (base-string-p (reduce/strcat (mapcar 'basify '("a" "b" NIL "cd")))))
(assert (base-string-p (strcat (basify "ab") (basify "cd")))) (assert (base-string-p (strcat (basify "ab") (basify "cd"))))
(assert (not (base-string-p (strcat (basify "ab") "cd"))))) (assert (not (base-string-p (strcat (basify "ab") #\c "d"))))
(assert (base-string-p (strcat (basify "ab") #\c #\d))))
...@@ -201,19 +201,22 @@ Returns two values: \(A B C\) and \(1 2 3\)." ...@@ -201,19 +201,22 @@ Returns two values: \(A B C\) and \(1 2 3\)."
(declare (ignorable strings)) (declare (ignorable strings))
#-non-base-chars-exist-p 'character #-non-base-chars-exist-p 'character
#+non-base-chars-exist-p #+non-base-chars-exist-p
(if (loop :for s :in strings :always (or (null s) (base-string-p s))) (if (loop :for s :in strings :always (or (null s) (typep s 'base-char) (base-string-p s)))
'base-char 'character)) 'base-char 'character))
(defun reduce/strcat (strings &key key start end) (defun reduce/strcat (strings &key key start end)
"Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE" "Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE.
NIL is interpreted as an empty string. A character is interpreted as a string of length one."
(when (or start end) (setf strings (subseq strings start end))) (when (or start end) (setf strings (subseq strings start end)))
(when key (setf strings (mapcar key strings))) (when key (setf strings (mapcar key strings)))
(loop :with output = (make-string (loop :for s :in strings :sum (length s)) (loop :with output = (make-string (loop :for s :in strings :sum (if (characterp s) 1 (length s)))
:element-type (strings-common-element-type strings)) :element-type (strings-common-element-type strings))
:with pos = 0
:for input :in strings :for input :in strings
:for pos = 0 :then (+ pos l) :do (etypecase input
:for l = (length input) (null)
:do (replace output input :start1 pos) (character (setf (char output pos) input) (incf pos))
(string (replace output input :start1 pos) (incf pos (length input))))
:finally (return output))) :finally (return output)))
(defun strcat (&rest strings) (defun strcat (&rest strings)
......
...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5. ;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "2.32.24") (asdf-version "2.32.25")
(existing-version (asdf-version))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version))) (when (and existing-version (not (equal asdf-version existing-version)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment