Commit 41f397c9 by Francois-Rene Rideau

Add back make-build on ECL

This provides for backward compatibility with ECL, whose current maintainer Daniel K. has decided to keep supporting the make-build interface and has forked ASDF for that.
parent df2261fe
......@@ -6,7 +6,7 @@
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/session
:asdf/component :asdf/system :asdf/system-registry :asdf/operation :asdf/action
:asdf/lisp-action :asdf/plan :asdf/operate
:asdf/find-system :asdf/parse-defsystem :asdf/output-translations)
:asdf/find-system :asdf/parse-defsystem :asdf/output-translations :asdf/bundle)
(:export
#:*asdf-verbose*
#:operation-error #:compile-error #:compile-failed #:compile-warned
......@@ -17,7 +17,8 @@
#:component-property
#:run-shell-command
#:system-definition-pathname #:system-registered-p #:require-system
#:explain))
#:explain
#+ecl #:make-build))
(in-package :asdf/backward-interface)
;; NB: the warning status of these functions may have to be distinguished later,
......@@ -226,3 +227,52 @@ system or its dependencies if it has already been loaded."
(declare (ignore keys))
(unless (component-loaded-p system)
(load-system system))))
;;; This function is for backward compatibility with ECL only.
#+ecl
(with-asdf-deprecation (:style-warning "3.2" :warning "9999")
(defun make-build (system &rest args
&key (monolithic nil) (type :fasl) (move-here nil move-here-p)
prologue-code epilogue-code no-uiop
prefix-lisp-object-files postfix-lisp-object-files extra-object-files
&allow-other-keys)
(let* ((operation (asdf/bundle::select-bundle-operation type monolithic))
(move-here-path (if (and move-here
(typep move-here '(or pathname string)))
(ensure-pathname move-here :namestring :lisp :ensure-directory t)
(system-relative-pathname system "asdf-output/")))
(extra-build-args (remove-plist-keys
'(:monolithic :type :move-here
:prologue-code :epilogue-code :no-uiop
:prefix-lisp-object-files :postfix-lisp-object-files
:extra-object-files)
args))
(build-system (if (subtypep operation 'image-op)
(eval `(defsystem "asdf.make-build"
:class program-system
:source-file nil
:pathname ,(system-source-directory system)
:build-operation ,operation
:build-pathname ,(subpathname move-here-path
(file-namestring (first (output-files operation system))))
:depends-on (,(coerce-name system))
:prologue-code ,prologue-code
:epilogue-code ,epilogue-code
:no-uiop ,no-uiop
:prefix-lisp-object-files ,prefix-lisp-object-files
:postfix-lisp-object-files ,postfix-lisp-object-files
:extra-object-files ,extra-object-files
:extra-build-args ,extra-build-args))
system))
(files (output-files operation build-system)))
(operate operation build-system)
(if (or move-here
(and (null move-here-p) (member operation '(program-op image-op))))
(loop :with dest-path = (resolve-symlinks* (ensure-directories-exist move-here-path))
:for f :in files
:for new-f = (make-pathname :name (pathname-name f)
:type (pathname-type f)
:defaults dest-path)
:do (rename-file-overwriting-target f new-f)
:collect new-f)
files))))
......@@ -527,7 +527,7 @@ which is probably not what you want; you probably need to tweak your output tran
(defun linkable-system (x)
(or (if-let (s (find-system x))
(and (system-source-file x) (output-files 'lib-op x) s))
(and (output-files 'lib-op s) s))
(if-let (p (system-module-pathname (coerce-name x)))
(make-prebuilt-system x p))))
......
......@@ -31,11 +31,11 @@
#:prepare-source-op #:load-source-op #:test-op #:define-op
#:feature #:version #:version-satisfies #:upgrade-asdf
#:implementation-identifier #:implementation-type #:hostname
#:component-depends-on ; backward-compatible name rather than action-depends-on
#:input-files #:additional-input-files
#:output-files #:output-file #:perform #:perform-with-restarts
#: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
#:program-system
#:basic-compile-bundle-op #:prepare-bundle-op
......@@ -53,20 +53,15 @@
#:operation-monolithic-p
#:required-components
#:component-loaded-p
#:component #:parent-component #:child-component #:system #:module
#:file-component #:source-file #:c-source-file #:java-source-file
#:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp
#:static-file #:doc-file #:html-file
#:file-type #:source-file-type
#:register-preloaded-system #:sysdef-preloaded-system-search
#:register-immutable-system #:sysdef-immutable-system-search
#:package-inferred-system #:register-system-packages
#:package-system ;; backward-compatibility during migration, to be removed in a further release.
#:component-children ; component accessors
#:component-children
#:component-children-by-name
#:component-pathname
#:component-relative-pathname
......@@ -76,13 +71,6 @@
#:component-system
#:component-encoding
#:component-external-format
#:component-depends-on ; backward-compatible name rather than action-depends-on
#:module-components ; backward-compatibility
#:operation-on-warnings #:operation-on-failure ; backward-compatibility
#:component-property ; backward-compatibility
#:traverse ; backward-compatibility
#:system-description
#:system-long-description
#:system-author
......@@ -101,20 +89,15 @@
#:system-defsystem-depends-on
#:system-depends-on
#:system-weakly-depends-on
#:*system-definition-search-functions* ; variables
#:*central-registry*
#:*compile-file-warnings-behaviour*
#:*compile-file-failure-behaviour*
#:*resolve-symlinks*
#:*asdf-verbose* ;; unused. For backward-compatibility only.
#:*verbose-out*
#:asdf-version
#:compile-condition #:compile-file-error #:compile-warned-error #:compile-failed-error
#:compile-warned-warning #:compile-failed-warning
#:operation-error #:compile-failed #:compile-warned #:compile-error ;; backward compatibility
#:error-name
#:error-pathname
#:load-system-definition-error
......@@ -128,20 +111,16 @@
#:duplicate-names #:non-toplevel-system #:non-system-system #:bad-system-name #:system-out-of-date
#:package-inferred-system-missing-package-error
#:operation-definition-warning #:operation-definition-error
#:try-recompiling ; restarts
#:retry
#:accept
#:coerce-entry-to-directory
#:remove-entry-from-registry
#:clear-configuration-and-retry
#:*encoding-detection-hook*
#:*encoding-external-format-hook*
#:*default-encoding*
#:*utf-8-external-format*
#:clear-configuration
#:*output-translations-parameter*
#:initialize-output-translations
......@@ -160,7 +139,6 @@
#:clear-source-registry
#:ensure-source-registry
#:process-source-registry
#:system-registered-p ;; DEPRECATED
#:registered-system #:registered-systems #:already-loaded-systems
#:resolve-location
#:asdf-message
......@@ -173,5 +151,11 @@
#:system-source-registry
#:user-source-registry-directory
#:system-source-registry-directory
))
;; The symbols below are all DEPRECATED, do not use. To be removed in a further release.
#:*asdf-verbose* #:run-shell-command
#:component-load-dependencies #:system-registered-p #:package-system
#+ecl #:make-build
#:operation-on-warnings #:operation-on-failure #:operation-error
#:compile-failed #:compile-warned #:compile-error
#:module-components #:component-property #:traverse))
......@@ -49,6 +49,8 @@
:defaults *load-truename*)
asdf:*central-registry*)
;; Create hellow using program-op
(delete-file-if-exists +standalone-exe+)
(asdf:make "hellow")
;;
......@@ -57,11 +59,37 @@
(format t "
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; TESTING A STANDALONE EXECUTABLE
;;; TESTING A STANDALONE EXECUTABLE. Also test :no-uiop t
;;;
")
(uiop:run-program (format nil "./~A" +standalone-exe+) :output *standard-output*)
(assert-equal
(uiop:run-program (format nil "./~A" +standalone-exe+) :output :lines)
'("Good morning sunshine!" "Hello world!" "Good bye sunshine."))
(format t "
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; AGAIN USING MAKE-BUILD. Also test uiop.
;;;
")
;;; Now create an executable using the legacy make-build interface
(delete-file +standalone-exe+)
(asdf:make-build :hellow
:type :program
:move-here "./"
:prologue-code "printf(\"In the beginning, there was nothing.\\n\");fflush(stdout);"
:epilogue-code '(progn
(uiop:format! t "~%The end.~%")
(uiop:quit 0))
;;:no-uiop t
:ld-flags
(list (namestring (compile-file-pathname "hello_aux.c" :type :object))))
(assert-equal
(uiop:run-program (format nil "./~A" +standalone-exe+) :output :lines)
'("In the beginning, there was nothing." "Hello world!" "The end."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
......
......@@ -139,8 +139,13 @@
(format t "~:[But no TEST-PACKAGE :-(~;And TEST-PACKAGE~]!~%" (find-package :test-package))
(format t "~:[And no ASDF~;But ASDF :-( ~]!~%" (find-package :asdf))
#+ecl (si:quit 0) #+mkcl (mk-ext:quit :exit-code 0)))
(DBG :run (output-file 'program-op 'hello-no-uiop)
(component-depends-on 'program-op 'hello-no-uiop)
(input-files 'program-op 'hello-no-uiop)
(component-depends-on 'lib-op 'hello-no-uiop)
(input-files 'lib-op 'hello-no-uiop)
(asdf/bundle::linkable-system "hello-no-uiop"))
(operate 'program-op 'hello-no-uiop :force t)
(DBG :run (output-file 'program-op 'hello-no-uiop))
(assert-equal
(run-program `(,(native-namestring (output-file 'program-op 'hello-no-uiop)))
:output :lines :error-output t)
......
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