diff --git a/asdf.asd b/asdf.asd index 05fb1c1ed61c2a07f7261c4b14d48d270fc99fae..a0484881d75955b24d52053ecb253636861e165e 100644 --- a/asdf.asd +++ b/asdf.asd @@ -75,7 +75,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "3.1.5" ;; to be automatically updated by make bump-version + :version "3.1.5.5" ;; to be automatically updated by make bump-version :depends-on () #+asdf3 :encoding #+asdf3 :utf-8 :class #+asdf3.1 package-inferred-system #-asdf3.1 system diff --git a/bundle.lisp b/bundle.lisp index f5f53d0804cb47f4afb29f6b57e953f09cdd9405..d990635f403a5ee961c4219570105ec9e9a976a6 100644 --- a/bundle.lisp +++ b/bundle.lisp @@ -503,12 +503,12 @@ itself.")) ;; operation on a system and its dependencies `(,(make-library-system "cmp" (compiler-library-pathname)))) ,@(unless (or (no-uiop c) (has-it-p "uiop") (has-it-p "asdf")) - `(cond - ((system-source-directory :uiop) `(,(find-system :uiop))) - ((system-source-directory :asdf) `(,(find-system :asdf))) - (t `(,@(if-let (uiop (uiop-library-pathname)) - `(,(make-library-system "uiop" uiop))) - ,(make-library-system "asdf" (asdf-library-pathname)))))) + (cond + ((system-source-directory :uiop) `(,(find-system :uiop))) + ((system-source-directory :asdf) `(,(find-system :asdf))) + (t `(,@(if-let (uiop (uiop-library-pathname)) + `(,(make-library-system "uiop" uiop))) + ,(make-library-system "asdf" (asdf-library-pathname)))))) ,@deps))))) (defmethod perform ((o link-op) (c system)) @@ -540,18 +540,3 @@ itself.")) ;; operation on a system and its dependencies "BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~ To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~ Please report to ASDF-DEVEL if this works for you."))) - - -;;; Backward compatibility with pre-3.1.2 names -;; (defclass fasl-op (selfward-operation) -;; ((selfward-operation :initform 'compile-bundle-op :allocation :class))) -;; (defclass load-fasl-op (selfward-operation) -;; ((selfward-operation :initform 'load-bundle-op :allocation :class))) -;; (defclass binary-op (selfward-operation) -;; ((selfward-operation :initform 'deliver-asd-op :allocation :class))) -;; (defclass monolithic-fasl-op (selfward-operation) -;; ((selfward-operation :initform 'monolithic-compile-bundle-op :allocation :class))) -;; (defclass monolithic-load-fasl-op (selfward-operation) -;; ((selfward-operation :initform 'monolithic-load-bundle-op :allocation :class))) -;; (defclass monolithic-binary-op (selfward-operation) -;; ((selfward-operation :initform 'monolithic-deliver-asd-op :allocation :class))) diff --git a/header.lisp b/header.lisp index 2b2810d0b9868566b7fd0f451030fc2a3bdc4d6b..4d93362797d60c08eae11b88ab17aebb9ebb958b 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.5: Another System Definition Facility. +;;; This is ASDF 3.1.5.5: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/test/ecl-make-image.script b/test/ecl-make-image.script new file mode 100644 index 0000000000000000000000000000000000000000..ba8bea80e35f87c416842d227e519dc27b26d343 --- /dev/null +++ b/test/ecl-make-image.script @@ -0,0 +1,8 @@ +;;; -*- Lisp -*- + +(DBG "Test ld-flags in make-image. Should load from ecl-make-image/") + +#+ecl +(progn + (chdir #P"ecl-make-image/") + (load "readme.lisp")) diff --git a/test/ecl-make-image/hello.lisp b/test/ecl-make-image/hello.lisp new file mode 100644 index 0000000000000000000000000000000000000000..ee28f5d1cc9670e0638be958aea2a0c9e34a73f9 --- /dev/null +++ b/test/ecl-make-image/hello.lisp @@ -0,0 +1,8 @@ +(in-package #:cl-user) + +(ffi::clines "extern const char *hello_string;") + +(ffi::def-foreign-var ("hello_string" +hello-string+) (* :char) nil) + +(print (ffi:convert-from-foreign-string +hello-string+)) + diff --git a/test/ecl-make-image/hello_aux.c b/test/ecl-make-image/hello_aux.c new file mode 100644 index 0000000000000000000000000000000000000000..7b8580f6016da14bffdf2d6b48edcc4be3ae43da --- /dev/null +++ b/test/ecl-make-image/hello_aux.c @@ -0,0 +1 @@ +const char *hello_string = "Hello world!"; diff --git a/test/ecl-make-image/hellow.asd b/test/ecl-make-image/hellow.asd new file mode 100644 index 0000000000000000000000000000000000000000..7e2a49814ec614fd06363823896934c43347522e --- /dev/null +++ b/test/ecl-make-image/hellow.asd @@ -0,0 +1,3 @@ +(defsystem #:hellow + :serial t + :components ((:file "hello"))) diff --git a/test/ecl-make-image/readme.lisp b/test/ecl-make-image/readme.lisp new file mode 100644 index 0000000000000000000000000000000000000000..01a0d4a8bc1ff1051f56b307694d06d42413547d --- /dev/null +++ b/test/ecl-make-image/readme.lisp @@ -0,0 +1,86 @@ +;;; +;;; DESCRIPTION: +;;; +;;; This file uses a "Hellow world!" string which is in an another C +;;; file called hello_aux.c. Both hello.lisp and hello_aux.c are +;;; compiled and linked into either +;;; +;;; 1) a FASL file (see build_fasl.lisp) +;;; 2) a shared library (see build_dll.lisp) +;;; 3) or a standalone executable file. (build_exe.lisp) +;;; +;;; USE: +;;; +;;; Launch a copy of ECL and load this file in it +;;; +;;; (load "readme.lisp") +;;; +(require 'asdf) + +(format t " +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; BUILDING hello_aux.o FILE +;;; +") + +;;; +;;; * We compile hello.lisp and hello_aux.c separately. +;;; +;; (compile-file "hello.lisp" :system-p t) + +(c::compiler-cc "hello_aux.c" (compile-file-pathname "hello_aux.c" :type :object)) + +(format t " +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; BUILDING A STANDALONE EXECUTABLE +;;; +") + +;; +;; * Combine files in a standalone executable. We reuse the files +;; from the previous example +;; + +(defconstant +standalone-exe+ (compile-file-pathname "hellow" :type :program)) + +(push (make-pathname :name nil :type nil :version nil + :defaults *load-truename*) + asdf:*central-registry*) + +(asdf:make-build :hellow + :type :program + :move-here "./" + :prologue-code "printf(\"Good morning sunshine!\");" + :epilogue-code '(progn + (format t "~%Good bye sunshine.~%") + (ext:quit 0)) + :ld-flags + (list (namestring (compile-file-pathname "hello_aux.c" :type :object)))) + +;; This doesnt seem to work +;; (asdf:operate 'asdf:program-op :hellow +;; :ld-flags +;; (list (namestring (compile-file-pathname "hello_aux.c" :type :object)))) + +;; +;; * Test the program +;; +(format t " +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; TESTING A STANDALONE EXECUTABLE +;;; + +") +(uiop:run-program (format nil "./~A" +standalone-exe+) :output *standard-output*) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; CLEAN UP +;;; + +;; (delete-file (compile-file-pathname "hello.lisp" :type :object)) +(delete-file (compile-file-pathname "hello_aux.c" :type :object)) +(delete-file +standalone-exe+) diff --git a/test/sample-system/a.lisp b/test/sample-system/a.lisp new file mode 100644 index 0000000000000000000000000000000000000000..7563fd2dc8d74a7a7213c3deb38112ebdbdda786 --- /dev/null +++ b/test/sample-system/a.lisp @@ -0,0 +1,9 @@ +;;;; a.lisp + +(defpackage :sample + (:use #:cl) + (:export #:loaded)) + +(in-package :sample) +(defparameter loaded t) + diff --git a/test/sample-system/sample-system.asd b/test/sample-system/sample-system.asd new file mode 100644 index 0000000000000000000000000000000000000000..ea858a2b3535e87e63c97e14aaf27be29a1d1a0a --- /dev/null +++ b/test/sample-system/sample-system.asd @@ -0,0 +1,5 @@ +;;;; foo.asd + +(asdf:defsystem #:sample-system + :serial t + :components ((:file "a"))) diff --git a/test/test-make-build.script b/test/test-make-build.script new file mode 100644 index 0000000000000000000000000000000000000000..ca5075774d0f2682b13e790685efcf31ceae6069 --- /dev/null +++ b/test/test-make-build.script @@ -0,0 +1,13 @@ +;;; -*- Lisp -*- + +(unless (or #+(or (and clisp os-unix) clozure cmu + (and ecl (not ecl-bytecmp) (not os-macosx)) lispworks mkcl sbcl scl) t) + (DBG "Creating executables is not supported on your CL implementation") + (leave-test "Skipping test" 0)) + +(DBG "build sample-system. Should load from sample-system/") +(setf *central-registry* (list (subpathname *test-directory* "sample-system/"))) + +(make-build 'sample-system + :type :program :monolithic t + #+ecl :epilogue-code #+ecl '(println "blue sky")) diff --git a/test/test-program.script b/test/test-program.script index 0867dc9040032e9421fcc1827a3e2a4490aaa135..58d1429b3c0a4c92c8c65c891e541c0a60978db4 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -7,8 +7,6 @@ (assert (find-system :hello-world-example)) -(trace run-program #+(and sbcl os-windows) sb-ext:run-program) - ;; Try to load lisp-invocation from xcvb (initialize-source-registry `(:source-registry diff --git a/test/test-run-program.script b/test/test-run-program.script index f59137f60408806c643a9be690ef331ce14a7563..1f68caab4cc2bb59e60239fbf2306ddc0edb37e3 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -1,13 +1,6 @@ ;; -*- Lisp -*- (declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0))) -#+(and clisp os-windows) -(ext:without-package-lock () - (trace uiop:run-program uiop/run-program::%run-program uiop/run-program::%system - ext:shell ext:run-shell-command ext:run-program)) - -#+(and sbcl os-windows) (trace sb-ext:run-program) - ;; On Windows, normalize away CRLF into jut the unixy LF. (defun dewindowize (x) (block () @@ -93,9 +86,6 @@ (with-output-to-string (*standard-output*) (run-program "echo ok" :output t :error-output :output))))) -;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess) -;;#+lispworks (trace system:run-shell-command system:pid-exit-status) - #| Testing run-program |# diff --git a/uiop/lisp-build.lisp b/uiop/lisp-build.lisp index 9f10d7e649147918ef66ff9d0c5fa427e1a28dde..7395db8510611f970ccb7675d448e24ce84f6e6b 100644 --- a/uiop/lisp-build.lisp +++ b/uiop/lisp-build.lisp @@ -672,8 +672,7 @@ it will filter them appropriately." (unless (use-ecl-byte-compiler-p) (or object-file #+ecl(compile-file-pathname output-file :type :object) - #+clasp (compile-file-pathname output-file :output-type :object) - ))) + #+clasp (compile-file-pathname output-file :output-type :object)))) #+mkcl (object-file (or object-file diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index ef7937de6664d3f9601f2fbb5359511b2c901187..eaeebec51bb1e49cbb2017e66293bfc244c4cdf4 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -426,10 +426,10 @@ It returns a process-info plist with possible keys: ;; NB: these implementations have unix vs windows set at compile-time. (declare (ignorable directory if-input-does-not-exist if-output-exists if-error-output-exists)) (assert (not (and wait (member :stream (list input output error-output))))) - #-(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) + #-(or allegro clasp clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl) (progn command keys directory (error "run-program not available")) - #+(or allegro clisp clozure cmu (and lispworks os-unix) mkcl sbcl scl) + #+(or allegro clisp clozure cmu ecl (and lispworks os-unix) mkcl sbcl scl) (let* ((%command (%normalize-command command)) (%input (%normalize-io-specifier input :input)) (%output (%normalize-io-specifier output :output)) @@ -585,7 +585,7 @@ It returns a process-info plist with possible keys: #+allegro (sys:reap-os-subprocess :pid process :wait t) #+clozure (nth-value 1 (ccl:external-process-status process)) #+(or cmu scl) (ext:process-exit-code process) - #+(or clasp ecl) (nth-value 1 (ext:external-process-status process)) + #+(or clasp ecl) (nth-value 1 (ext:external-process-wait process)) #+lispworks (if-let ((stream (or (getf process-info :input-stream) (getf process-info :output-stream) @@ -909,8 +909,11 @@ or an indication of failure via the EXIT-CODE of the process" (setf force-shell t))) (flet ((default (x xp output) (cond (xp x) ((eq output :interactive) :interactive)))) (apply (if (or force-shell - #+(or clasp clisp ecl) (or (not ignore-error-status) t) + #+(or clasp clisp) (or (not ignore-error-status) t) #+clisp (member error-output '(:interactive :output)) + ;; old versions of ecl <= 15.3.7 don't support non-trivial :error + #+ecl (and (nth-value 1 (ignore-errors (slot-value (ext:make-external-process) 'ext::error-stream))) + (not (member error-output '(:interactive :output nil)))) #+(and lispworks os-unix) (%interactivep input output error-output) #+(or abcl cormanlisp gcl (and lispworks os-windows) mcl xcl) t) '%use-system '%use-run-program) @@ -921,4 +924,4 @@ or an indication of failure via the EXIT-CODE of the process" :if-output-exists if-output-exists :if-error-output-exists if-error-output-exists :element-type element-type :external-format external-format - keys)))) + keys)))) diff --git a/uiop/stream.lisp b/uiop/stream.lisp index a31a00141e1ccd4e8e02d4eafc014b3935ee3ccc..4090b37af2b30ed97956e1fb4123c5603daa48be 100644 --- a/uiop/stream.lisp +++ b/uiop/stream.lisp @@ -576,15 +576,17 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e (check-type direction (member :output :io)) (assert (or want-stream-p want-pathname-p)) (loop - :with prefix = (native-namestring - (ensure-absolute-pathname - (or prefix "tmp") - (or (ensure-pathname directory :namestring :native :ensure-directory t) - #'temporary-directory))) - :with results = () + :with prefix-pn = (ensure-absolute-pathname + (or prefix "tmp") + (or (ensure-pathname directory :namestring :native :ensure-directory t) + #'temporary-directory)) + :with prefix-nns = (native-namestring prefix-pn) + :with results = (progn (ensure-directories-exist prefix-pn) + ()) :for counter :from (random (expt 36 #-gcl 8 #+gcl 5)) :for pathname = (parse-native-namestring - (format nil "~A~36R~@[~A~]~@[.~A~]" prefix counter suffix type)) + (format nil "~A~36R~@[~A~]~@[.~A~]" + prefix-nns counter suffix (unless (eq type :unspecific) type))) :for okp = nil :do ;; TODO: on Unix, do something about umask ;; TODO: on Unix, audit the code so we make sure it uses O_CREAT|O_EXCL @@ -593,6 +595,7 @@ Finally, the file will be deleted, unless the KEEP argument when CALL-FUNCTION'e ;; Can we at least design some hook? (unwind-protect (progn + (ensure-directories-exist pathname) (with-open-file (stream pathname :direction direction :element-type element-type @@ -672,8 +675,13 @@ Further KEYS can be passed to MAKE-PATHNAME." :defaults pathname keys)) (defun tmpize-pathname (x) - "Return a new pathname modified from X by adding a trivial deterministic suffix" - (add-pathname-suffix x "-TMP")) + "Return a new pathname modified from X by adding a trivial random suffix. +A new empty file with said temporary pathname is created, to ensure there is no +clash with any concurrent process attempting the same thing." + (let* ((px (ensure-pathname x)) + (prefix (if-let (n (pathname-name px)) (strcat n "-tmp") "tmp")) + (directory (translate-logical-pathname (pathname-directory-pathname px)))) + (get-temporary-file :directory directory :prefix prefix :type (pathname-type px)))) (defun call-with-staging-pathname (pathname fun) "Calls FUN with a staging pathname, and atomically @@ -691,4 +699,3 @@ For the latter case, we ought pick a random suffix and atomically open it." (defmacro with-staging-pathname ((pathname-var &optional (pathname-value pathname-var)) &body body) "Trivial syntax wrapper for CALL-WITH-STAGING-PATHNAME" `(call-with-staging-pathname ,pathname-value #'(lambda (,pathname-var) ,@body)))) - diff --git a/uiop/version.lisp-expr b/uiop/version.lisp-expr index e9c0a2db0c3d6ca012351092bef003dc294da9d0..1dec78862d146c76f6d6c792b17bba59e6b68f2e 100644 --- a/uiop/version.lisp-expr +++ b/uiop/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.5" +"3.1.5.5" diff --git a/upgrade.lisp b/upgrade.lisp index 3a02da054030762236df905d1dadef2a408937d4..c47b45aa44502c084f8fe5ef6b3c4efcacfa4135 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -67,7 +67,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top 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 "3.1.5") + (asdf-version "3.1.5.5") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) diff --git a/version.lisp-expr b/version.lisp-expr index e9c0a2db0c3d6ca012351092bef003dc294da9d0..1dec78862d146c76f6d6c792b17bba59e6b68f2e 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1,2 +1,2 @@ -"3.1.5" +"3.1.5.5"