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

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
Loading
Loading
Loading
Loading
+4 −0
Original line number Diff line number Diff line
@@ -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.
+1 −2
Original line number Diff line number Diff line
@@ -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)))
+3 −2
Original line number Diff line number Diff line
@@ -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)
+1 −1
Original line number Diff line number Diff line
@@ -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))
+20 −12
Original line number Diff line number Diff line
@@ -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)))

Loading