diff --git a/TODO b/TODO index 6f328292a0718319220fb078577a84531d18b14e..1a907bac21dd19a24842258abe65412d4ad24cf1 100644 --- a/TODO +++ b/TODO @@ -106,6 +106,10 @@ *** `#5(1 ,@`(2 3)))` returns #(1 2 3), rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3). +** SCL has bugs: +*** it doesn't like run-program from a modified directory? +*** it somehow pushes :non-base-chars-exist-p even though +non-base-chars-exist-p+ is NIL??? + ** XCL has bad bugs: *** make-pathname doesn't handle :type nil properly and has massive lossage in logical-pathname support. diff --git a/bin/install-asdf-as-module b/bin/install-asdf-as-module index 39df30a29337ceb7414d860885a6fbe8a69f48b8..a04588bf4b1d3bec4c2121c8523e7338d5901e76 100644 --- a/bin/install-asdf-as-module +++ b/bin/install-asdf-as-module @@ -59,5 +59,4 @@ It notably doesn't work on: (ensure-directories-exist (translate-logical-pathname fasl)) (compile-file (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl))) -(trace compile-file*) -(install-asdf-as-module) +(uiop:writeln (multiple-value-list (install-asdf-as-module))) diff --git a/test/test-sysdef-asdf.script b/test/test-sysdef-asdf.script index 8af5ae09e5658e9993da16d64e85252a0fc0ba53..337acf81b7c4315c5a841ec2e109cb96410635ae 100644 --- a/test/test-sysdef-asdf.script +++ b/test/test-sysdef-asdf.script @@ -58,8 +58,9 @@ 'parse-unix-namestring (remove-if 'emptyp (split-string ;; NB: assumes GNU make - (run-program `("make" "--quiet" "--no-print-directory" ,target) - :output :string :error-output t :directory *asdf-directory*) + (run-program `("make" "-C" ,(native-namestring *asdf-directory*) + "--quiet" "--no-print-directory" ,target) + :output :string :error-output t) :separator #(#\space #\newline #\return #\tab))))) (defmacro compare-files (system target) diff --git a/test/test-utilities.script b/test/test-utilities.script index 7c4957619e321b188574fd1ea270d058e32b67e9..49708b0c55636cb035f370c7c3dc6eb69249079d 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -240,7 +240,7 @@ #-non-base-chars-exist-p (progn - (assert (base-string-p (make-string 10 :element-type 'character))) + (assert (base-string-p (make-string 10 :element-type 'character :initial-element *last-char*))) (assert (typep *last-char* 'base-char))) (defun basify (s) (coerce s 'base-string)) diff --git a/uiop/image.lisp b/uiop/image.lisp index 292786c9ca4e25f54bd40c151962955dea352d1a..bb044a2cf08cdf71ed5511e5f7e5ddc3e32aadd9 100644 --- a/uiop/image.lisp +++ b/uiop/image.lisp @@ -7,7 +7,7 @@ (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os) (:export #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments* - #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments + #:command-line-arguments #:raw-command-line-arguments #:setup-command-line-arguments #:argv0 #:*lisp-interaction* #:*fatal-conditions* #:fatal-condition-p #:handle-fatal-condition #:call-with-fatal-condition-handler #:with-fatal-condition-handler @@ -242,19 +242,27 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" "Extract user arguments from command-line invocation of current process. Assume the calling conventions of a generated script that uses -- if we are not called from a directly executable image." - (declare (ignorable arguments)) - #+abcl arguments - ;; LispWorks command-line processing isn't transparent to the user, and - ;; we need to rely on cl-launch or some other script to set it for us. - #+lispworks *command-line-arguments* - #-(or abcl lispworks) - (let* (#-(or sbcl allegro) - (arguments - (if (eq *image-dumped-p* :executable) - arguments - (member "--" arguments :test 'string-equal)))) + (block nil + #+abcl (return arguments) + ;; SBCL and Allegro already separate user arguments from implementation arguments. + #-(or sbcl allegro) + (unless (eq *image-dumped-p* :executable) + ;; LispWorks command-line processing isn't transparent to the user + ;; unless you create a standalone executable; in that case, + ;; we rely on cl-launch or some other script to set the arguments for us. + #+lispworks (return *command-line-arguments*) + ;; On other implementations, on non-standalone executables, + ;; we trust cl-launch or whichever script starts the program + ;; to use -- as a delimiter between implementation arguments and user arguments. + #-lispworks (setf arguments (member "--" arguments :test 'string-equal))) (rest arguments))) + (defun argv0 () + ;; Not available on ABCL, Genera, MCL. + (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl) + (first (raw-command-line-arguments)) + #+ecl (si:argv 0))) + (defun setup-command-line-arguments () (setf *command-line-arguments* (command-line-arguments))) diff --git a/uiop/utility.lisp b/uiop/utility.lisp index 48dd4759a139a799e184ed813bf6f69ba50634b0..a9c422725781387158983afea8a9f30edfefd599 100644 --- a/uiop/utility.lisp +++ b/uiop/utility.lisp @@ -196,6 +196,7 @@ Returns two values: \(A B C\) and \(1 2 3\)." ;;; Characters (with-upgradability () ;; base-char != character on ECL, LW, SBCL, Genera. LW also has SIMPLE-CHAR. (defconstant +non-base-chars-exist-p+ (not (subtypep 'character 'base-char))) + #-scl ;; In SCL, all characters seem to be 16-bit base-char, but this flag gets set somehow??? (when +non-base-chars-exist-p+ (pushnew :non-base-chars-exist-p *features*))) (with-upgradability ()