Changeset 15858


Ignore:
Timestamp:
Jul 8, 2013, 5:51:45 PM (7 years ago)
Author:
rme
Message:

Update to ASDF 3.0.2.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/tools/asdf.lisp

    r15830 r15858  
    11;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
    2 ;;; This is ASDF 3.0.1: Another System Definition Facility.
     2;;; This is ASDF 3.0.2: Another System Definition Facility.
    33;;;
    44;;; Feedback, bug reports, and patches are all welcome:
     
    7171           (existing-version-number (and existing-version (read-from-string existing-major-minor)))
    7272           (away (format nil "~A-~A" :asdf existing-version)))
    73       (when (and existing-version (< existing-version-number
    74                                      (or #+abcl 2.25 #+cmu 2.018 #-(or abcl cmu) 2.27)))
     73      (when (and existing-version
     74                 (< existing-version-number #+abcl 2.25 #+cmu 2.018 #-(or abcl cmu) 2.27))
    7575        (rename-package :asdf away)
    7676        (when *load-verbose*
     
    15151515  (defun os-windows-p ()
    15161516    (or #+abcl (featurep :windows)
    1517         #+(and (not (or unix cygwin darwin)) (or win32 windows mswindows mingw32)) t))
     1517        #+(and (not (or abcl unix cygwin darwin)) (or win32 windows mswindows mingw32)) t))
    15181518
    15191519  (defun os-genera-p ()
    15201520    (or #+genera t))
    15211521
     1522  (defun os-oldmac-p ()
     1523    (or #+mcl t))
     1524
    15221525  (defun detect-os ()
    1523     (flet ((yes (yes) (pushnew yes *features*))
    1524            (no (no) (setf *features* (remove no *features*))))
    1525       (cond
    1526         ((os-unix-p) (yes :os-unix) (no :os-windows) (no :genera))
    1527         ((os-windows-p) (yes :os-windows) (no :os-unix) (no :genera))
    1528         ((os-genera-p) (no :os-unix) (no :os-windows) (yes :genera))
    1529         (t (error "Congratulations for trying XCVB on an operating system~%~
    1530 that is neither Unix, nor Windows, nor even Genera.~%Now you port it.")))))
     1526    (loop* :with o
     1527           :for (feature . detect) :in '((:os-unix . os-unix-p) (:os-windows . os-windows-p)
     1528                                         (:genera . os-genera-p) (:os-oldmac . os-oldmac-p))
     1529           :when (and (not o) (funcall detect)) :do (setf o feature) (pushnew o *features*)
     1530           :else :do (setf *features* (remove feature *features*))
     1531           :finally
     1532           (return (or o (error "Congratulations for trying ASDF on an operating system~%~
     1533that is neither Unix, nor Windows, nor Genera, nor even old MacOS.~%Now you port it.")))))
    15311534
    15321535  (detect-os))
     
    19121915   tries hard to make a pathname that will actually behave as documented,
    19131916   despite the peculiarities of each implementation"
     1917    ;; TODO: reimplement defaulting for MCL, whereby an explicit NIL should override the defaults.
    19141918    (declare (ignorable host device directory name type version defaults))
    19151919    (apply 'make-pathname
     
    19871991    ;; strings and lists of strings or :unspecific
    19881992    ;; But CMUCL decides to die on NIL.
     1993    ;; MCL has issues with make-pathname, nil and defaulting
     1994    (declare (ignorable defaults))
    19891995    #.`(make-pathname* :directory nil :name nil :type nil :version nil :device nil
    19901996                       :host (or #+cmu lisp::*unix-host*)
     
    19921998                                 :username nil :password nil :parameters nil :query nil :fragment nil)
    19931999                       ;; the default shouldn't matter, but we really want something physical
    1994                        :defaults defaults))
     2000                       #-mcl ,@'(:defaults defaults)))
    19952001
    19962002  (defvar *nil-pathname* (nil-pathname (translate-logical-pathname (user-homedir-pathname))))
     
    22602266                  :directory (unless file-only (cons relative path))
    22612267                  :name name :type type
    2262                   :defaults (or defaults *nil-pathname*))
     2268                  :defaults (or #-mcl defaults *nil-pathname*))
    22632269                 (remove-plist-keys '(:type :dot-dot :defaults) keys))))))
    22642270
     
    31443150
    31453151  (defun encoding-external-format (encoding)
    3146     (funcall *encoding-external-format-hook* encoding)))
     3152    (funcall *encoding-external-format-hook* (or encoding *default-encoding*))))
    31473153
    31483154
     
    36143620    #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code)
    36153621    #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
    3616     #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
     3622    #+mcl (progn code (ccl:quit)) ;; or should we use FFI to call libc's exit(3) ?
    36173623    #+mkcl (mk-ext:quit :exit-code code)
    36183624    #+sbcl #.(let ((exit (find-symbol* :exit :sb-ext nil))
     
    36283634    (with-safe-io-syntax ()
    36293635      (ignore-errors
    3630        (fresh-line *stderr*)
    3631        (apply #'format *stderr* format arguments)
    3632        (format! *stderr* "~&")))
     3636       (format! *stderr* "~&~?~&" format arguments)))
    36333637    (quit code))
    36343638
     
    36523656    #+(or clozure mcl)
    36533657    (let ((*debug-io* stream))
    3654       (ccl:print-call-history :count count :start-frame-number 1)
     3658      #+clozure (ccl:print-call-history :count count :start-frame-number 1)
     3659      #+mcl (ccl:print-call-history :detailed-p nil)
    36553660      (finish-output stream))
    36563661    #+(or cmu scl)
     
    37433748    #+ecl (loop :for i :from 0 :below (si:argc) :collect (si:argv i))
    37443749    #+gcl si:*command-args*
    3745     #+genera nil
     3750    #+(or genera mcl) nil
    37463751    #+lispworks sys:*line-arguments-list*
    37473752    #+sbcl sb-ext:*posix-argv*
    37483753    #+xcl system:*argv*
    3749     #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks sbcl scl xcl)
     3754    #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl sbcl scl xcl)
    37503755    (error "raw-command-line-arguments not implemented yet"))
    37513756
     
    41404145if it was :INTERACTIVE, the output and the input are inherited from the current process.
    41414146
    4142 Otherwise, the output will be processed by SLURP-INPUT-STREAM,
    4143 using OUTPUT as the first argument, and return whatever it returns,
    4144 e.g. using :OUTPUT :STRING will have it return the entire output stream as a string.
    4145 Use ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT processor."
     4147Otherwise, OUTPUT should be a value that is a suitable first argument to
     4148SLURP-INPUT-STREAM.  In this case, RUN-PROGRAM will create a temporary stream
     4149for the program output.  The program output, in that stream, will be processed
     4150by SLURP-INPUT-STREAM, according to the using OUTPUT as the first argument.
     4151RUN-PROGRAM will return whatever SLURP-INPUT-STREAM returns.  E.g., using
     4152:OUTPUT :STRING will have it return the entire output stream as a string.  Use
     4153ELEMENT-TYPE and EXTERNAL-FORMAT for the stream passed to the OUTPUT processor."
     4154
     4155    ;; TODO: The current version does not honor :OUTPUT NIL on Allegro.  Setting
     4156    ;; the :INPUT and :OUTPUT arguments to RUN-SHELL-COMMAND on ACL actually do
     4157    ;; what :OUTPUT :INTERACTIVE is advertised to do here.  To get the behavior
     4158    ;; specified for :OUTPUT NIL, one would have to grab up the process output
     4159    ;; into a stream and then throw it on the floor.  The consequences of
     4160    ;; getting this wrong seemed so much worse than having excess output that it
     4161    ;; is not currently implemented.
     4162
    41464163    ;; TODO: specially recognize :output pathname ?
    41474164    (declare (ignorable ignore-error-status element-type external-format))
     
    41854202                          #+os-unix (coerce (cons (first command) command) 'vector)
    41864203                          #+os-windows command
    4187                           :input interactive :output (or (and pipe :stream) interactive) :wait wait
     4204                          :input nil
     4205                          :output (and pipe :stream) :wait wait
    41884206                          #+os-windows :show-window #+os-windows (and (or (null output) pipe) :hide))
    41894207                         #+clisp
     
    42774295               #+allegro
    42784296               (excl:run-shell-command
    4279                 command :input interactive :output interactive :wait t
    4280                         #+os-windows :show-window #+os-windows (unless (or interactive (eq output t)) :hide))
     4297                command
     4298                :input nil
     4299                :output nil
     4300                :error-output :output ; write STDERR to output, too
     4301                :wait t
     4302                #+os-windows :show-window #+os-windows (unless (or interactive (eq output t)) :hide))
    42814303               #+(or clisp clozure cmu (and lispworks os-unix) sbcl scl)
    42824304               (process-result (run-program command :pipe nil :interactive interactive) nil)
     
    46274649    #+allegro
    46284650    (list :functions-defined excl::.functions-defined.
    4629           :functions-called excl::.functions-called.)
     4651          :functions-called excl::.functions-called.)
    46304652    #+clozure
    46314653    (mapcar 'reify-deferred-warning
     
    46694691    #+allegro
    46704692    (destructuring-bind (&key functions-defined functions-called)
    4671                         reified-deferred-warnings
     4693        reified-deferred-warnings
    46724694      (setf excl::.functions-defined.
    46734695            (append functions-defined excl::.functions-defined.)
     
    48844906  (defun* (compile-file*) (input-file &rest keys
    48854907                                      &key compile-check output-file warnings-file
    4886                                       #+clisp lib-file #+(or ecl mkcl) object-file
     4908                                      #+clisp lib-file #+(or ecl mkcl) object-file #+sbcl emit-cfasl
    48874909                                      &allow-other-keys)
    48884910    "This function provides a portable wrapper around COMPILE-FILE.
     
    49254947                 (compile-file-pathname output-file :fasl-p nil)))
    49264948           (tmp-file (tmpize-pathname output-file))
     4949           #+sbcl
     4950           (cfasl-file (etypecase emit-cfasl
     4951                         (null nil)
     4952                         ((eql t) (make-pathname :type "cfasl" :defaults output-file))
     4953                         (string (parse-namestring emit-cfasl))
     4954                         (pathname emit-cfasl)))
     4955           #+sbcl
     4956           (tmp-cfasl (when cfasl-file (make-pathname :type "cfasl" :defaults tmp-file)))
    49274957           #+clisp
    49284958           (tmp-lib (make-pathname :type "lib" :defaults tmp-file)))
     
    49304960          (with-saved-deferred-warnings (warnings-file)
    49314961            (with-muffled-compiler-conditions ()
    4932               (or #-(or ecl mkcl) (apply 'compile-file input-file :output-file tmp-file keywords)
     4962              (or #-(or ecl mkcl)
     4963                  (apply 'compile-file input-file :output-file tmp-file
     4964                         #+sbcl (if emit-cfasl (list* :emit-cfasl tmp-cfasl keywords) keywords)
     4965                         #-sbcl keywords)
    49334966                  #+ecl (apply 'compile-file input-file :output-file
    49344967                               (if object-file
     
    49554988           (when output-truename
    49564989             #+clisp (when lib-file (rename-file-overwriting-target tmp-lib lib-file))
     4990             #+sbcl (when cfasl-file (rename-file-overwriting-target tmp-cfasl cfasl-file))
    49574991             (rename-file-overwriting-target output-truename output-file)
    49584992             (setf output-truename (truename output-file)))
     
    49604994          (t ;; error or failed check
    49614995           (delete-file-if-exists output-truename)
     4996           #+clisp (delete-file-if-exists tmp-lib)
     4997           #+sbcl (delete-file-if-exists tmp-cfasl)
    49624998           (setf output-truename nil)))
    49634999        (values output-truename warnings-p failure-p))))
     
    54225458         ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
    54235459         ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
    5424          (asdf-version "3.0.1")
     5460         (asdf-version "3.0.2")
    54255461         (existing-version (asdf-version)))
    54265462    (setf *asdf-version* asdf-version)
     
    54405476             #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action
    54415477             #:component-depends-on #:operation-done-p #:component-depends-on
    5442              #:traverse ;; plan
     5478             #:traverse ;; backward-interface
    54435479             #:operate  ;; operate
    54445480             #:parse-component-form ;; defsystem
     
    66196655(with-upgradability ()
    66206656  (defmacro define-convenience-action-methods
    6621       (function (operation component &optional keyp)
    6622        &key if-no-operation if-no-component operation-initargs)
     6657      (function formals &key if-no-operation if-no-component operation-initargs)
    66236658    (let* ((rest (gensym "REST"))
    66246659           (found (gensym "FOUND"))
     6660           (keyp (equal (last formals) '(&key)))
     6661           (formals-no-key (if keyp (butlast formals) formals))
     6662           (len (length formals-no-key))
     6663           (operation 'operation)
     6664           (component 'component)
     6665           (opix (position operation formals))
     6666           (coix (position component formals))
     6667           (prefix (subseq formals 0 opix))
     6668           (suffix (subseq formals (1+ coix) len))
    66256669           (more-args (when keyp `(&rest ,rest &key &allow-other-keys))))
     6670      (assert (and (integerp opix) (integerp coix) (= coix (1+ opix))))
    66266671      (flet ((next-method (o c)
    66276672               (if keyp
    6628                    `(apply ',function ,o ,c ,rest)
    6629                    `(,function ,o ,c))))
     6673                   `(apply ',function ,@prefix ,o ,c ,@suffix ,rest)
     6674                   `(,function ,@prefix ,o ,c ,@suffix))))
    66306675        `(progn
    6631            (defmethod ,function ((,operation symbol) ,component ,@more-args)
     6676           (defmethod ,function (,@prefix (,operation symbol) component ,@suffix ,@more-args)
    66326677             (if ,operation
    66336678                 ,(next-method
     
    66376682                   `(or (find-component () ,component) ,if-no-component))
    66386683                 ,if-no-operation))
    6639            (defmethod ,function ((,operation operation) ,component ,@more-args)
     6684           (defmethod ,function (,@prefix (,operation operation) ,component ,@suffix ,@more-args)
    66406685             (if (typep ,component 'component)
    66416686                 (error "No defined method for ~S on ~/asdf-action:format-action/"
    66426687                        ',function (cons ,operation ,component))
    6643                  (let ((,found (find-component () ,component)))
    6644                    (if ,found
    6645                        ,(next-method operation found)
    6646                        ,if-no-component)))))))))
     6688                 (if-let (,found (find-component () ,component))
     6689                    ,(next-method operation found)
     6690                    ,if-no-component))))))))
    66476691
    66486692
     
    69236967  (defclass basic-compile-op (operation)
    69246968    ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil)
    6925      (flags :initarg :flags :accessor compile-op-flags
    6926             :initform nil))))
     6969     (flags :initarg :flags :accessor compile-op-flags :initform nil))))
    69276970
    69286971;;; Our default operations: loading into the current lisp image
     
    69316974    ((sideway-operation :initform 'load-op)))
    69326975  (defclass load-op (basic-load-op downward-operation sideway-operation selfward-operation)
    6933     ;; NB: even though compile-op depends-on on prepare-op it is not needed-in-image-p,
     6976    ;; NB: even though compile-op depends on prepare-op it is not needed-in-image-p,
    69346977    ;; so we need to directly depend on prepare-op for its side-effects in the current image.
    69356978    ((selfward-operation :initform '(prepare-op compile-op))))
     
    71627205   #:circular-dependency #:circular-dependency-actions
    71637206   #:call-while-visiting-action #:while-visiting-action
    7164    #:traverse #:plan-actions #:perform-plan #:plan-operates-on-p
     7207   #:make-plan #:plan-actions #:perform-plan #:plan-operates-on-p
    71657208   #:planned-p #:index #:forced #:forced-not #:total-action-count
    71667209   #:planned-action-count #:planned-output-action-count #:visited-actions
     
    73487391           ;; Three kinds of actions:
    73497392           (out-op (and out-files t)) ; those that create files on the filesystem
    7350                                         ;(image-op (and in-files (null out-files))) ; those that load stuff into the image
    7351                                         ;(null-op (and (null out-files) (null in-files))) ; dependency placeholders that do nothing
     7393           ;;(image-op (and in-files (null out-files))) ; those that load stuff into the image
     7394           ;;(null-op (and (null out-files) (null in-files))) ; placeholders that do nothing
    73527395           ;; When was the thing last actually done? (Now, or ask.)
    73537396           (op-time (or just-done (component-operation-time o c)))
     
    74687511                                 :done-p (and done-p (not add-to-plan-p))
    74697512                                 :planned-p add-to-plan-p
    7470                                  :index (if status (action-index status) (incf (plan-total-action-count plan)))))
     7513                                 :index (if status
     7514                                            (action-index status)
     7515                                            (incf (plan-total-action-count plan)))))
    74717516                          (when add-to-plan-p
    74727517                            (incf (plan-planned-action-count plan))
     
    74847529
    74857530  (defgeneric plan-actions (plan))
     7531  (defmethod plan-actions ((plan list))
     7532    plan)
    74867533  (defmethod plan-actions ((plan sequential-plan))
    74877534    (reverse (plan-actions-r plan)))
     
    75007547;;;; high-level interface: traverse, perform-plan, plan-operates-on-p
    75017548(with-upgradability ()
    7502   (defgeneric* (traverse) (operation component &key &allow-other-keys)
     7549  (defgeneric make-plan (plan-class operation component &key &allow-other-keys)
    75037550    (:documentation
    7504      "Generate and return a plan for performing OPERATION on COMPONENT.
    7505 
    7506 The plan returned is a list of dotted-pairs. Each pair is the CONS
    7507 of ASDF operation object and a COMPONENT object. The pairs will be
    7508 processed in order by OPERATE."))
    7509   (define-convenience-action-methods traverse (operation component &key))
     7551     "Generate and return a plan for performing OPERATION on COMPONENT."))
     7552  (define-convenience-action-methods make-plan (plan-class operation component &key))
    75107553
    75117554  (defgeneric perform-plan (plan &key))
     
    75147557  (defvar *default-plan-class* 'sequential-plan)
    75157558
    7516   (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
     7559  (defmethod make-plan (plan-class (o operation) (c component) &rest keys &key &allow-other-keys)
    75177560    (let ((plan (apply 'make-instance
    75187561                       (or plan-class *default-plan-class*)
    7519                        :system (component-system c) (remove-plist-key :plan-class keys))))
     7562                       :system (component-system c) keys)))
    75207563      (traverse-action plan o c t)
    7521       (plan-actions plan)))
    7522 
    7523   (defmethod perform-plan :around (plan &key)
    7524     (declare (ignorable plan))
     7564      plan))
     7565
     7566  (defmethod perform-plan :around ((plan t) &key)
    75257567    (let ((*package* *package*)
    75267568          (*readtable* *readtable*))
     
    75287570        (call-next-method))))   ;; Going forward, see deferred-warning support in lisp-build.
    75297571
     7572  (defmethod perform-plan ((plan t) &rest keys &key &allow-other-keys)
     7573    (apply 'perform-plan (plan-actions plan) keys))
     7574
    75307575  (defmethod perform-plan ((steps list) &key force &allow-other-keys)
    75317576    (loop* :for (o . c) :in steps
     
    75337578           :do (perform-with-restarts o c)))
    75347579
     7580  (defmethod plan-operates-on-p ((plan plan-traversal) (component-path list))
     7581    (plan-operates-on-p (plan-actions plan) component-path))
     7582
    75357583  (defmethod plan-operates-on-p ((plan list) (component-path list))
    75367584    (find component-path (mapcar 'cdr plan)
     
    75387586
    75397587
    7540 ;;;; Incidental traversals 
     7588;;;; Incidental traversals
    75417589(with-upgradability ()
    75427590  (defclass filtered-sequential-plan (sequential-plan)
     
    75627610  (defmethod traverse-actions (actions &rest keys &key plan-class &allow-other-keys)
    75637611    (let ((plan (apply 'make-instance (or plan-class 'filtered-sequential-plan) keys)))
    7564       (loop* :for (o . c) :in actions :do
    7565              (traverse-action plan o c t))
    7566       (plan-actions plan)))
    7567 
    7568   (define-convenience-action-methods traverse-sub-actions (o c &key))
     7612      (loop* :for (o . c) :in actions :do (traverse-action plan o c t))
     7613      plan))
     7614
     7615  (define-convenience-action-methods traverse-sub-actions (operation component &key))
    75697616  (defmethod traverse-sub-actions ((operation operation) (component component) &rest keys &key &allow-other-keys)
    75707617    (apply 'traverse-actions (direct-dependencies operation component)
     
    75747621    (with-slots (keep-operation keep-component) plan
    75757622      (loop* :for (o . c) :in (call-next-method)
    7576              :when (and (typep o keep-operation)
    7577                         (typep c keep-component))
     7623             :when (and (typep o keep-operation) (typep c keep-component))
    75787624             :collect (cons o c))))
    75797625
    75807626  (defmethod required-components (system &rest keys &key (goal-operation 'load-op) &allow-other-keys)
    75817627    (remove-duplicates
    7582      (mapcar 'cdr (apply 'traverse-sub-actions goal-operation system
    7583                          (remove-plist-key :goal-operation keys)))
     7628     (mapcar 'cdr (plan-actions
     7629                   (apply 'traverse-sub-actions goal-operation system
     7630                          (remove-plist-key :goal-operation keys))))
    75847631     :from-end t)))
    75857632
     
    76727719
    76737720  (defmethod operate ((operation operation) (component component)
    7674                       &rest keys &key &allow-other-keys)
    7675     (let ((plan (apply 'traverse operation component keys)))
     7721                      &rest keys &key plan-class &allow-other-keys)
     7722    (let ((plan (apply 'make-plan plan-class operation component keys)))
    76767723      (apply 'perform-plan plan keys)
    76777724      (values operation plan)))
     
    77987845
    77997846;;;; -------------------------------------------------------------------------
    7800 ;;; Internal hacks for backward-compatibility 
     7847;;; Internal hacks for backward-compatibility
    78017848
    78027849(asdf/package:define-package :asdf/backward-internals
     
    81828229  ;; but instead inherit from a basic-FOO-op as with basic-fasl-op above.
    81838230
    8184   (defclass lib-op (bundle-compile-op)
     8231  (defclass no-ld-flags-op (operation) ())
     8232
     8233  (defclass lib-op (bundle-compile-op no-ld-flags-op)
    81858234    ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
    81868235    (:documentation #+(or ecl mkcl) "compile the system and produce linkable (.a) library for it."
    81878236     #-(or ecl mkcl) "just compile the system"))
    81888237
    8189   (defclass dll-op (bundle-op basic-compile-op)
     8238  (defclass dll-op (bundle-compile-op selfward-operation no-ld-flags-op)
    81908239    ((bundle-type :initform :dll))
    8191     (:documentation "Link together all the dynamic library used by this system into a single one."))
     8240    (:documentation "compile the system and produce dynamic (.so/.dll) library for it."))
    81928241
    81938242  (defclass binary-op (basic-compile-op selfward-operation)
     
    82128261    (:documentation "Create a single fasl for the system and its dependencies."))
    82138262
    8214   (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op)
     8263  (defclass monolithic-lib-op (monolithic-bundle-compile-op basic-compile-op  no-ld-flags-op)
    82158264    ((bundle-type :initform #+(or ecl mkcl) :lib #-(or ecl mkcl) :no-output-file))
    82168265    (:documentation #+(or ecl mkcl) "Create a single linkable library for the system and its dependencies."
    82178266     #-(or ecl mkcl) "Compile a system and its dependencies."))
    82188267
    8219   (defclass monolithic-dll-op (monolithic-bundle-op basic-compile-op sideway-operation selfward-operation)
    8220     ((bundle-type :initform :dll)
    8221      (selfward-operation :initform 'dll-op)
    8222      (sideway-operation :initform 'dll-op)))
     8268  (defclass monolithic-dll-op (monolithic-bundle-compile-op sideway-operation selfward-operation no-ld-flags-op)
     8269    ((bundle-type :initform :dll))
     8270    (:documentation "Create a single dynamic (.so/.dll) library for the system and its dependencies."))
    82238271
    82248272  (defclass program-op #+(or mkcl ecl) (monolithic-bundle-compile-op)
     
    82348282      ((eql :fasl) #-(or ecl mkcl) (compile-file-type) #+(or ecl mkcl) "fasb")
    82358283      #+ecl
    8236       ((member :binary :dll :lib :static-library :program :object :program)
     8284      ((member :binary :dll :lib :shared-library :static-library :program :object :program)
    82378285       (compile-file-type :type bundle-type))
    82388286      ((eql :binary) "image")
     
    83068354                             (operation-original-initargs instance))))
    83078355
    8308   (defmethod bundle-op-build-args :around ((o lib-op))
     8356  (defmethod bundle-op-build-args :around ((o no-ld-flags-op))
    83098357    (declare (ignorable o))
    83108358    (let ((args (call-next-method)))
     
    90339081  (:use :uiop/common-lisp :uiop :asdf/upgrade
    90349082   :asdf/component :asdf/system :asdf/find-system :asdf/operation :asdf/action
    9035    :asdf/lisp-action :asdf/operate :asdf/output-translations)
     9083   :asdf/lisp-action :asdf/plan :asdf/operate :asdf/output-translations)
    90369084  (:export
    90379085   #:*asdf-verbose*
    90389086   #:operation-error #:compile-error #:compile-failed #:compile-warned
    9039    #:error-component #:error-operation
     9087   #:error-component #:error-operation #:traverse
    90409088   #:component-load-dependencies
    90419089   #:enable-asdf-binary-locations-compatibility
     
    90909138or even ASDF:SYSTEM-SOURCE-DIRECTORY or ASDF:SYSTEM-RELATIVE-PATHNAME
    90919139if that's whay you mean." ;;)
    9092     (system-source-file x)))
     9140    (system-source-file x))
     9141
     9142  (defgeneric* (traverse) (operation component &key &allow-other-keys)
     9143    (:documentation
     9144     "Generate and return a plan for performing OPERATION on COMPONENT.
     9145
     9146The plan returned is a list of dotted-pairs. Each pair is the CONS
     9147of ASDF operation object and a COMPONENT object. The pairs will be
     9148processed in order by OPERATE."))
     9149  (define-convenience-action-methods traverse (operation component &key))
     9150
     9151  (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
     9152    (plan-actions (apply 'make-plan plan-class o c keys))))
    90939153
    90949154
     
    91619221    (let ((command (apply 'format nil control-string args)))
    91629222      (asdf-message "; $ ~A~%" command)
    9163       (run-program command :force-shell t :ignore-error-status t :output *verbose-out*))))
     9223      (handler-case
     9224          (progn
     9225            (run-program command :force-shell t :ignore-error-status nil :output *verbose-out*)
     9226            0)
     9227        (subprocess-error (c)
     9228          (let ((code (subprocess-error-code c)))
     9229            (typecase code
     9230              (integer code)
     9231              (t 255))))))))
    91649232
    91659233(with-upgradability ()
     
    94719539
    94729540  (defun initialize-source-registry (&optional (parameter *source-registry-parameter*))
    9473     ;; Record the parameter used to configure the registry 
     9541    ;; Record the parameter used to configure the registry
    94749542    (setf *source-registry-parameter* parameter)
    94759543    ;; Clear the previous registry database:
     
    95179585  (:export
    95189586   #:defsystem #:find-system #:locate-system #:coerce-name
    9519    #:oos #:operate #:traverse #:perform-plan #:sequential-plan
     9587   #:oos #:operate #:make-plan #:perform-plan #:sequential-plan
    95209588   #:system-definition-pathname #:with-system-definitions
    95219589   #:search-for-system-definition #:find-component #:component-find-path
     
    95739641   #:operation-on-warnings #:operation-on-failure ; backward-compatibility
    95749642   #:component-property ; backward-compatibility
     9643   #:traverse ; backward-compatibility
    95759644
    95769645   #:system-description
     
    97079776                          (values-list l))))))))
    97089777
     9778#+cmu
     9779(with-upgradability ()
     9780  (defun herald-asdf (stream)
     9781    (format stream "    ASDF ~A" (asdf-version)))
     9782  (setf (getf ext:*herald-items* :asdf) `(herald-asdf)))
     9783
    97099784
    97109785;;;; Done!
Note: See TracChangeset for help on using the changeset viewer.