Hey,
Here are some fixes for a few problems with bundles (especially making a
prebuilt system library a requirement – i.e sb-bsd-sockets or asdf) and
cleaned up the code a bit. Moreover I've enabled load-bundle-op as a
default load operation for ECL and its descendants and removed a
deprecated function `bundle-system'.
Also the "deprecation" comment is removed from `make-build' – IMO it's
totally legit function for ASDF and is part of the ECL build system
(thereof frequently used).
Also I've found a problem with monolithic-dll-op (test-bundle.script)
when running tests the second time, but it's not a regression (it was
present before this patches). I'll probably investigate it soon.
Patches attached below (inlined).
Best regards,
Daniel
>From 25e5a5f2103fc99c7e85abc6a5b78a0d483986fe Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 07:11:54 +0200
Subject: [PATCH 1/9] bundle: system-module-pathname: use general apprach
Use more general approach regarding prebuilt system modules on
implementations Clasp, ECL and MKCL with `system-module-pathname',
instead of separate functions for cmp/asdf/uiop. Thanks to that, we'll
be able to include any prebuilt module with
(make-library-system name)
where name may be "sb-bsd-sockets", "babel" or anything else. This is
important for image-op (therefore program-op) and is a prerequisite to
fix the problem with monolithic boundle-op's not including required
prebuilt systems.
---
bundle.lisp | 44 ++++++++++++++++++++------------------------
1 file changed, 20 insertions(+), 24 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp
index dddea45..30be996 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -520,41 +520,37 @@ for all the linkable object files associated with the system or its dependencies
;;(unless (or #+(or clasp ecl) (use-ecl-byte-compiler-p))
;; (setf *load-system-operation* 'load-bundle-op))
- (defun uiop-library-pathname ()
- #+clasp (probe-file* (compile-file-pathname "sys:uiop" :output-type :object))
- #+ecl (or (probe-file* (compile-file-pathname "sys:uiop" :type :lib)) ;; new style
- (probe-file* (compile-file-pathname "sys:uiop" :type :object))) ;; old style
- #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;uiop"))
-
- (defun asdf-library-pathname ()
- #+clasp (probe-file* (compile-file-pathname "sys:asdf" :output-type :object))
- #+ecl (or (probe-file* (compile-file-pathname "sys:asdf" :type :lib)) ;; new style
- (probe-file* (compile-file-pathname "sys:asdf" :type :object))) ;; old style
- #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;asdf"))
-
- (defun compiler-library-pathname ()
- #+clasp (compile-file-pathname "sys:cmp" :output-type :lib)
- #+ecl (compile-file-pathname "sys:cmp" :type :lib)
- #+mkcl (make-pathname :type (bundle-pathname-type :lib) :defaults #p"sys:cmp"))
-
- (defun make-library-system (name pathname)
- (make-instance 'prebuilt-system
- :name (coerce-name name) :static-library (resolve-symlinks* pathname)))
+ (defun system-module-pathname (module)
+ (let ((name (coerce-name module)))
+ (some
+ #'probe-file
+ (list
+ #+clasp (compile-file-pathname (make-pathname :name name :defaults "sys:") :output-type :object)
+ #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :lib)
+ #+ecl (compile-file-pathname (make-pathname :name name :defaults "sys:") :type :object)
+ #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:")
+ #+mkcl (make-pathname :name name :type (bundle-pathname-type :lib) :defaults #p"sys:contrib;")))))
+
+ (defun make-library-system (name &optional (pathname (system-module-pathname name)))
+ "Creates a prebuilt-system if PATHNAME isn't NIL."
+ (when pathname
+ (make-instance 'prebuilt-system
+ :name (coerce-name name)
+ :static-library (resolve-symlinks* pathname))))
(defmethod component-depends-on :around ((o image-op) (c system))
(destructuring-bind ((lib-op . deps)) (call-next-method)
(flet ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name)))
`((,lib-op
,@(unless (or (no-uiop c) (has-it-p "cmp"))
- `(,(make-library-system
- "cmp" (compiler-library-pathname))))
+ `(,(make-library-system "cmp")))
,@(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))
+ (t `(,@(if-let (uiop (system-module-pathname "uiop"))
`(,(make-library-system "uiop" uiop)))
- ,(make-library-system "asdf" (asdf-library-pathname))))))
+ ,(make-library-system "asdf")))))
,@deps)))))
(defmethod perform ((o link-op) (c system))
--
2.9.3
>From dfb447708945eaf409833abd91ef6fc61855b97f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 07:31:46 +0200
Subject: [PATCH 2/9] bundle: component-depends-on: simplify hairy code
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Create a local function inject-system, which verifies, if the system can
be found, and if not – makes a library system.
This part of code was also buggy, because if it did found `uiop', it
didn't include `asdf', but if none was found, it included `uiop' *and*
`asdf' unconditionally. This inconsistent behaviour was fixed and now we
try to inject `uiop', and if not found – `asdf'.
---
bundle.lisp | 19 +++++++++----------
1 file changed, 9 insertions(+), 10 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp
index 30be996..b8bea09 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -540,17 +540,16 @@ for all the linkable object files associated with the system or its dependencies
(defmethod component-depends-on :around ((o image-op) (c system))
(destructuring-bind ((lib-op . deps)) (call-next-method)
- (flet ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name)))
+ (labels ((has-it-p (x) (find x deps :test 'equal :key 'coerce-name))
+ (inject-system (x) (unless (has-it-p x)
+ (if (system-source-directory x)
+ `(,(find-system x))
+ `(,(make-library-system x))))))
`((,lib-op
- ,@(unless (or (no-uiop c) (has-it-p "cmp"))
- `(,(make-library-system "cmp")))
- ,@(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 (system-module-pathname "uiop"))
- `(,(make-library-system "uiop" uiop)))
- ,(make-library-system "asdf")))))
+ ,@(unless (no-uiop c)
+ (append (inject-system "cmp")
+ (or (inject-system "uiop")
+ (inject-system "asdf"))))
,@deps)))))
(defmethod perform ((o link-op) (c system))
--
2.9.3
>From 9bf2ed0ca999e43889a982a4bcb32978f3965bfa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 14:12:21 +0200
Subject: [PATCH 3/9] bundle: be case-insensitive when recognizing type
`pathname-type-equal-function' was case-sensitive when filtering
`direct-dependency-files' called from `input-files' specialized on
`gather-op'. That caused rejection of the prebuilt system libraries
denoted in upper case like #P"SYS:LIBASDF.A" and as a result any
dependencies on the prebuilt weren't linked in the final image.
---
bundle.lisp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/bundle.lisp b/bundle.lisp
index b8bea09..3ecfd90 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -307,7 +307,7 @@ for all the linkable object files associated with the system or its dependencies
:when (funcall test f) :do (collect f))))))
(defun pathname-type-equal-function (type)
- #'(lambda (p) (equal (pathname-type p) type)))
+ #'(lambda (p) (equalp (pathname-type p) type)))
(defmethod input-files ((o gather-op) (c system))
(unless (eq (bundle-type o) :no-output-file)
--
2.9.3
>From a976a4aa59e2c1bc5f96a72eb1e22004cf48afc9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 14:44:06 +0200
Subject: [PATCH 4/9] *load-system-operation*: set to load-bundle-op
This makes loading system faster. See:
https://common-lisp.net/project/ecl/manual/re56.html
---
bundle.lisp | 10 +++-------
1 file changed, 3 insertions(+), 7 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp
index 3ecfd90..aed4c68 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -512,13 +512,9 @@ for all the linkable object files associated with the system or its dependencies
#+(or clasp ecl mkcl)
(with-upgradability ()
- ;; I think that Juanjo intended for this to be, but it was disabled before 3.1
- ;; due to implementation bugs in ECL and MKCL that seem to have been fixed since
- ;; -- see for ECL test-xach-update-bug.script and test-bundle.script,
- ;; and for MKCL test-logical-pathname.script.
- ;; We should probably reenable these after consulting with ECL and MKCL maintainers.
- ;;(unless (or #+(or clasp ecl) (use-ecl-byte-compiler-p))
- ;; (setf *load-system-operation* 'load-bundle-op))
+
+ (unless (or #+(or clasp ecl) (use-ecl-byte-compiler-p))
+ (setf *load-system-operation* 'load-bundle-op))
(defun system-module-pathname (module)
(let ((name (coerce-name module)))
--
2.9.3
>From 5d178f0ff1b11b6cdedfcacc1005b37731cb4a1a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 14:46:26 +0200
Subject: [PATCH 5/9] bundle: remove deprecated function bundle-system
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Also remove deprecation comment – `make-build' is part of official ECL
build system and is documented here:
https://common-lisp.net/project/ecl/manual/re55.html
---
bundle.lisp | 8 +-------
1 file changed, 1 insertion(+), 7 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp
index aed4c68..ad6dd51 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -328,7 +328,6 @@ for all the linkable object files associated with the system or its dependencies
((:program)
'program-op)))
- ;; DEPRECATED. This is originally from asdf-ecl.lisp. Does anyone use it?
(defun make-build (system &rest args &key (monolithic nil) (type :fasl)
(move-here nil move-here-p)
&allow-other-keys)
@@ -351,12 +350,7 @@ for all the linkable object files associated with the system or its dependencies
:defaults dest-path)
:do (rename-file-overwriting-target f new-f)
:collect new-f)
- files)))
-
- ;; DEPRECATED. Does anyone use this?
- (defun bundle-system (system &rest args &key force (verbose t) version &allow-other-keys)
- (declare (ignore force verbose version))
- (apply #'operate 'deliver-asd-op system args)))
+ files))))
;;;
;;; LOAD-BUNDLE-OP
--
2.9.3
>From 8f1009556500d16b52b42620270c04d6fbbaf905 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 15:03:18 +0200
Subject: [PATCH 6/9] bundle: add regression test for prebuilt systems
---
test/ecl-prebuilt-systems.script | 9 ++++++
test/ecl-prebuilt-systems/hello.lisp | 3 ++
test/ecl-prebuilt-systems/hellow.asd | 4 +++
test/ecl-prebuilt-systems/readme.lisp | 59 +++++++++++++++++++++++++++++++++++
4 files changed, 75 insertions(+)
create mode 100644 test/ecl-prebuilt-systems.script
create mode 100644 test/ecl-prebuilt-systems/hello.lisp
create mode 100644 test/ecl-prebuilt-systems/hellow.asd
create mode 100644 test/ecl-prebuilt-systems/readme.lisp
diff --git a/test/ecl-prebuilt-systems.script b/test/ecl-prebuilt-systems.script
new file mode 100644
index 0000000..62a8406
--- /dev/null
+++ b/test/ecl-prebuilt-systems.script
@@ -0,0 +1,9 @@
+;;; -*- Lisp -*-
+
+(DBG "Regression test: Test if dependencies on prebuilt libraries work.
+Should load from ecl-prebuilt-systems/")
+
+#+(and ecl (not ecl-bytecmp))
+(progn
+ (chdir (subpathname *test-directory* "ecl-prebuilt-systems/"))
+ (load "readme.lisp"))
diff --git a/test/ecl-prebuilt-systems/hello.lisp b/test/ecl-prebuilt-systems/hello.lisp
new file mode 100644
index 0000000..dba21f6
--- /dev/null
+++ b/test/ecl-prebuilt-systems/hello.lisp
@@ -0,0 +1,3 @@
+(in-package #:cl-user)
+
+(print `(:asdf-version ,(asdf:asdf-version)))
diff --git a/test/ecl-prebuilt-systems/hellow.asd b/test/ecl-prebuilt-systems/hellow.asd
new file mode 100644
index 0000000..b418b32
--- /dev/null
+++ b/test/ecl-prebuilt-systems/hellow.asd
@@ -0,0 +1,4 @@
+(asdf:defsystem #:hellow
+ :serial t
+ :depends-on (#:asdf)
+ :components ((:file "hello")))
diff --git a/test/ecl-prebuilt-systems/readme.lisp b/test/ecl-prebuilt-systems/readme.lisp
new file mode 100644
index 0000000..e37e8ca
--- /dev/null
+++ b/test/ecl-prebuilt-systems/readme.lisp
@@ -0,0 +1,59 @@
+;;;
+;;; DESCRIPTION:
+;;;
+;;; This file builds a standalone executable with a dependency on
+;;; ASDF.
+;;;
+;;;
+;;; USE:
+;;;
+;;; Launch a copy of ECL and load this file in it
+;;;
+;;; (load "readme.lisp")
+;;;
+(require 'asdf)
+
+(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)))
+
+;;
+;; * Test the program
+;;
+(format t "
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; TESTING A STANDALONE EXECUTABLE
+;;;
+
+")
+(uiop:run-program (format nil "./~A" +standalone-exe+) :output *standard-output*)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; CLEAN UP
+;;;
+
+(delete-file +standalone-exe+)
--
2.9.3
>From 57c6ed1ab0a69c2ee766ac3efc759e901b4b57bc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 15:16:14 +0200
Subject: [PATCH 7/9] bundle: make-build: be smart on move-here
This is a conveniance mechanism to avoid problems with cross-device
links.
---
bundle.lisp | 5 ++++-
1 file changed, 4 insertions(+), 1 deletion(-)
diff --git a/bundle.lisp b/bundle.lisp
index ad6dd51..e1743f0 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -348,7 +348,10 @@ for all the linkable object files associated with the system or its dependencies
:for new-f = (make-pathname :name (pathname-name f)
:type (pathname-type f)
:defaults dest-path)
- :do (rename-file-overwriting-target f new-f)
+ :do (handler-case (rename-file-overwriting-target f new-f)
+ (file-error (c)
+ (copy-file f new-f)
+ (delete-file-if-exists f)))
:collect new-f)
files))))
--
2.9.3
>From d54dcdd497a9b47cfa8f604ebf763fce029a2b5f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 15:23:44 +0200
Subject: [PATCH 8/9] tests: fix test-program function call
---
test/test-program.script | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/test/test-program.script b/test/test-program.script
index fb48fab..bef7f7c 100644
--- a/test/test-program.script
+++ b/test/test-program.script
@@ -110,8 +110,8 @@
#+(or ecl mkcl)
(progn
(DBG "Now create an program without UIOP")
- (assert (probe-file (asdf/bundle::asdf-library-pathname)))
- (assert (probe-file (asdf/bundle::compiler-library-pathname)))
+ (assert (probe-file (asdf/bundle::system-module-pathname "asdf")))
+ (assert (probe-file (asdf/bundle::system-module-pathname "cmp")))
(def-test-system hello-no-uiop
:class program-system
:no-uiop t
--
2.9.3
>From fdad2f374c8eb528f60123fc496b9b5a0df87287 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 15:49:53 +0200
Subject: [PATCH 9/9] uiop: copy-file: add implementation for ecl
---
uiop/stream.lisp | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/uiop/stream.lisp b/uiop/stream.lisp
index 9e85af4..1731e9a 100644
--- a/uiop/stream.lisp
+++ b/uiop/stream.lisp
@@ -371,7 +371,9 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE."
;; Not available on LW personal edition or LW 6.0 on Mac: (lispworks:copy-file i f)
#+allegro
(excl.osi:copy-file input output)
- #-allegro
+ #+ecl
+ (ext:copy-file input output)
+ #-(or allegro ecl)
(concatenate-files (list input) output))
(defun slurp-stream-string (input &key (element-type 'character) stripped)
--
2.9.3
>From 97ff57c766814eaf40590acd3d39690cddcff3f6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= <dan...@turtleware.eu>
Date: Fri, 9 Sep 2016 16:48:42 +0200
Subject: [PATCH] bundle-system: remove deprecated function
---
bundle.lisp | 2 +-
doc/asdf.texinfo | 4 ++--
doc/exported-functions | 1 -
interface.lisp | 2 +-
test/test-utilities.script | 1 -
5 files changed, 4 insertions(+), 6 deletions(-)
diff --git a/bundle.lisp b/bundle.lisp
index e1743f0..9df74ec 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -8,7 +8,7 @@
:asdf/action :asdf/lisp-action :asdf/plan :asdf/operate :asdf/defsystem)
(:export
#:bundle-op #:bundle-type #:program-system
- #:bundle-system #:bundle-pathname-type #:direct-dependency-files
+ #:bundle-pathname-type #:direct-dependency-files
#:monolithic-op #:monolithic-bundle-op #:operation-monolithic-p
#:basic-compile-bundle-op #:prepare-bundle-op
#:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op
diff --git a/doc/asdf.texinfo b/doc/asdf.texinfo
index 149b7c9..6e6d4ca 100644
--- a/doc/asdf.texinfo
+++ b/doc/asdf.texinfo
@@ -948,8 +948,8 @@ make document-formatting the default operation invoked by @code{make},
instead of loading. If the system developer doesn't specify in the
system definition, the default operation will be loading.
-@c FIXME: We seem to export @findex bundle-system also, that some ECL users seem to rely on.
-@c But it's probably better that bundle operations have their own manual chapter at some point.
+@c It's probably better that bundle operations have their own manual
+@c chapter at some point.
@c FIXME: There should be a @defun for OPERATE, but there isn't. Not
diff --git a/doc/exported-functions b/doc/exported-functions
index 2013d3d..8ffd567 100644
--- a/doc/exported-functions
+++ b/doc/exported-functions
@@ -3,7 +3,6 @@ ALREADY-LOADED-SYSTEMS
APPLY-OUTPUT-TRANSLATIONS
ASDF-MESSAGE
ASDF-VERSION
-BUNDLE-SYSTEM
CLEAR-CONFIGURATION
CLEAR-OUTPUT-TRANSLATIONS
CLEAR-SOURCE-REGISTRY
diff --git a/interface.lisp b/interface.lisp
index f1a086b..5e535d6 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -34,7 +34,7 @@
#:operation-done-p #:explain #:action-description #:component-sideway-dependencies
#:needed-in-image-p
#:component-load-dependencies #:run-shell-command ; deprecated, do not use
- #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file #:bundle-system
+ #:bundle-op #:monolithic-bundle-op #:precompiled-system #:compiled-file
#:program-system #:make-build
#:basic-compile-bundle-op #:prepare-bundle-op
#:compile-bundle-op #:load-bundle-op #:monolithic-compile-bundle-op #:monolithic-load-bundle-op
diff --git a/test/test-utilities.script b/test/test-utilities.script
index a186bb3..2bfbb0f 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -274,7 +274,6 @@
asdf/bundle:user-system
#+sbcl uiop/lisp-build:sb-grovel-unknown-constant-condition
;; on some implementations only
- asdf/bundle:bundle-system
asdf/bundle:static-library
uiop/os:parse-file-location-info
uiop/os:parse-windows-shortcut
--
2.9.3
--
Daniel Kochmański ;; aka jackdaniel | Poznań, Poland
TurtleWare - Daniel Kochmański | www.turtleware.eu
"Be the change that you wish to see in the world." - Mahatma Gandhi
