Commit 15b373a5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Define and export uiop:argv0, for the sake of a portable buildapp-like dispatched entry.

Fix some issues with SCL:
* 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???
parent 88eda692
......@@ -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.
......
......@@ -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)))
......@@ -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)
......
......@@ -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))
......
......@@ -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)))
......
......@@ -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 ()
......
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