Commit 46fbd9cd authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.32.22: better strcat and UIOP utilities for strings.

Some test script tweaks.
parent e24c1db0
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.32.21" ;; to be automatically updated by make bump-version
:version "2.32.22" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.32.21: Another System Definition Facility.
;;; This is ASDF 2.32.22: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -25,13 +25,13 @@ usage () {
unset DEBUG_ASDF_TEST upgrade clean_load load_systems test_interactively extract_all
SHELL=/bin/sh
export SHELL
export SHELL DEBUG_ASDF_TEST GCL_ANSI ASDF_OUTPUT_TRANSLATIONS
while getopts "cdtHulhu" OPTION
do
case $OPTION in
d)
export DEBUG_ASDF_TEST=t
DEBUG_ASDF_TEST=t
;;
u)
upgrade=t
......@@ -183,12 +183,12 @@ case "$lisp" in
flags="-norc -eval (ext::install-bytecodes-compiler)"
eval="-eval" ;;
gcl)
export GCL_ANSI=t
GCL_ANSI=t
command="${GCL:-gcl}"
flags="-batch"
eval="-eval" ;;
gclcvs)
export GCL_ANSI=t
GCL_ANSI=t
command="${GCLCVS:-gclcvs}"
flags="-batch"
eval="-eval" ;;
......@@ -332,7 +332,6 @@ run_upgrade_tests () {
mkdir -p build/results/
rm -f build/*.*f* uiop/*.*f* test/*.*f* ## Remove stale FASLs from ASDF 1.x, especially when different implementations have same name
ASDF_OUTPUT_TRANSLATIONS="(:output-translations (\"${ASDFDIR}\" (\"${ASDFDIR}/build/fasls/\" :implementation \"asdf/\")) (t (\"${ASDFDIR}/build/fasls/\" :implementation \"root/\")) :ignore-inherited-configuration)"
export ASDF_OUTPUT_TRANSLATIONS
su=test/script-support.lisp
for tag in `upgrade_tags` ; do
for method in `upgrade_methods` ; do
......
......@@ -135,11 +135,11 @@
asdf/lisp-action:try-recompiling
;; types
asdf/bundle:user-system
#+sbcl uiop/lisp-build:sb-grovel-unknown-constant-condition
;; on some implementations only
asdf/bundle:bundle-system
asdf/bundle:register-pre-built-system
asdf/bundle:static-library
uiop/lisp-build:sb-grovel-unknown-constant-condition
uiop/os:parse-file-location-info
uiop/os:parse-windows-shortcut
uiop/os:read-little-endian
......
......@@ -18,7 +18,9 @@
#:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists
#:remove-plist-keys #:remove-plist-key ;; plists
#:emptyp ;; sequences
#:strcat #:first-char #:last-char #:split-string ;; strings
#:+non-base-chars-exist-p+ ;; characters
#:base-string-p #:strings-common-element-type #:reduce/strcat #:strcat ;; strings
#:first-char #:last-char #:split-string
#:string-prefix-p #:string-enclosed-p #:string-suffix-p
#:find-class* ;; CLOS
#:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps
......@@ -183,10 +185,37 @@ Returns two values: \(A B C\) and \(1 2 3\)."
(or (null x) (and (vectorp x) (zerop (length x))))))
;;; Characters
(with-upgradability ()
(defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char))))
;;; Strings
(with-upgradability ()
(defun base-string-p (string)
(declare (ignorable string))
#.(or +non-base-chars-exist-p+ '(eq 'base-char (array-element-type string))))
(defun strings-common-element-type (strings)
#.(if +non-base-chars-exist-p+
'(if (loop :for s :in strings :always (or (null s) (base-string-p s)))
'base-char 'character)
''character))
(defun reduce/strcat (strings &key key start end)
"Reduce a list as if by STRCAT, accepting KEY START and END keywords like REDUCE"
(when (or start end) (setf strings (subseq strings start end)))
(when key (setf strings (mapcar key strings)))
(loop :with output = (make-string (loop :for s :in strings :sum (length s))
:element-type (strings-common-element-type strings))
:for input :in strings
:for pos = 0 :then (+ pos l)
:for l = (length input)
:do (replace output input :start1 pos)
:finally (return output)))
(defun strcat (&rest strings)
(apply 'concatenate 'string strings))
(reduce/strcat strings))
(defun first-char (s)
(and (stringp s) (plusp (length s)) (char s 0)))
......
......@@ -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.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
(asdf-version "2.32.21")
(asdf-version "2.32.22")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-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