Changeset 14554
- Timestamp:
- Jan 4, 2011, 9:43:39 AM (14 years ago)
- File:
-
- 1 edited
-
trunk/source/tools/asdf.lisp (modified) (32 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/tools/asdf.lisp
r14470 r14554 75 75 (defvar *upgraded-p* nil) 76 76 (let* (;; For bug reporting sanity, please always bump this version when you modify this file. 77 ;; Please also modify asdf.asd to reflect this change. The script bin/bump-version 78 ;; can help you do these changes in synch (look at the source for documentation). 77 79 ;; "2.345" would be an official release 78 80 ;; "2.345.6" would be a development version in the official upstream 79 ;; "2.345.0.7" would be your local modification of an official release80 ;; "2.345.6.7" would be your local modification of a development version81 (asdf-version "2.01 1")81 ;; "2.345.0.7" would be your seventh local modification of official release 2.345 82 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 83 (asdf-version "2.012") 82 84 (existing-asdf (fboundp 'find-system)) 83 85 (existing-version *asdf-version*) … … 497 499 ;; See CLHS make-pathname and 19.2.2.2.3. 498 500 ;; We only use it on implementations that support it. 499 (or #+(or ccl eclgcl lispworks sbcl) :unspecific)))501 (or #+(or ccl gcl lispworks sbcl) :unspecific))) 500 502 (destructuring-bind (name &optional (type unspecific)) 501 503 (split-string filename :max 2 :separator ".") … … 714 716 (make-pathname :type "lisp" :defaults input-file)) 715 717 718 (defparameter *wild-file* 719 (make-pathname :name :wild :type :wild :version :wild :directory nil)) 720 (defparameter *wild-directory* 721 (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil)) 722 (defparameter *wild-inferiors* 723 (make-pathname :directory '(:relative :wild-inferiors) :name nil :type nil :version nil)) 716 724 (defparameter *wild-path* 717 (make-pathname :directory '(:relative :wild-inferiors) 718 :name :wild :type :wild :version :wild)) 725 (merge-pathnames *wild-file* *wild-inferiors*)) 719 726 720 727 (defun* wilden (path) … … 866 873 (when (member 'components-by-name added) 867 874 (compute-module-components-by-name m)) 868 (when (and (typep m 'system) (member 'source-file added)) 869 (%set-system-source-file (probe-asd (component-name m) (component-pathname m)) m)))))) 875 (when (typep m 'system) 876 (when (member 'source-file added) 877 (%set-system-source-file 878 (probe-asd (component-name m) (component-pathname m)) m) 879 (when (equal (component-name m) "asdf") 880 (setf (component-version m) *asdf-version*)))))))) 870 881 871 882 ;;;; ------------------------------------------------------------------------- … … 939 950 (define-condition compile-failed (compile-error) ()) 940 951 (define-condition compile-warned (compile-error) ()) 952 953 (define-condition invalid-configuration () 954 ((form :reader condition-form :initarg :form) 955 (location :reader condition-location :initarg :location) 956 (format :reader condition-format :initarg :format) 957 (arguments :reader condition-arguments :initarg :arguments :initform nil)) 958 (:report (lambda (c s) 959 (format s "~@<~? (will be skipped)~@:>" 960 (condition-format c) 961 (list* (condition-form c) (condition-location c) 962 (condition-arguments c)))))) 963 (define-condition invalid-source-registry (invalid-configuration warning) 964 ((format :initform "~@<invalid source registry ~S~@[ in ~S~]~@{ ~@?~}~>"))) 965 (define-condition invalid-output-translation (invalid-configuration warning) 966 ((format :initform "~@<invalid asdf output-translation ~S~@[ in ~S~]~@{ ~@?~}~>"))) 941 967 942 968 (defclass component () … … 1152 1178 ;; There is no "unload" operation in Common Lisp, and a general such operation 1153 1179 ;; cannot be portably written, considering how much CL relies on side-effects 1154 ;; of global data structures. 1155 ;; Note that this does a setf gethash instead of a remhash 1156 ;; this way there remains a hint in the *defined-systems* table 1157 ;; that the system was loaded at some point. 1158 (setf (gethash (coerce-name name) *defined-systems*) nil)) 1180 ;; to global data structures. 1181 (remhash (coerce-name name) *defined-systems*)) 1159 1182 1160 1183 (defun* map-systems (fn) … … 1290 1313 (find-system (coerce-name name) error-p)) 1291 1314 1315 (defun load-sysdef (name pathname) 1316 ;; Tries to load system definition with canonical NAME from PATHNAME. 1317 (let ((package (make-temporary-package))) 1318 (unwind-protect 1319 (handler-bind 1320 ((error (lambda (condition) 1321 (error 'load-system-definition-error 1322 :name name :pathname pathname 1323 :condition condition)))) 1324 (let ((*package* package)) 1325 (asdf-message 1326 "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%" 1327 pathname package) 1328 (load pathname))) 1329 (delete-package package)))) 1330 1292 1331 (defmethod find-system ((name string) &optional (error-p t)) 1293 1332 (catch 'find-system 1294 (let* ((in-memory (system-registered-p name)) 1333 (let* ((in-memory (system-registered-p name)) ; load from disk if absent or newer on disk 1295 1334 (on-disk (system-definition-pathname name))) 1296 1335 (when (and on-disk 1297 1336 (or (not in-memory) 1298 (< (car in-memory) (safe-file-write-date on-disk)))) 1299 (let ((package (make-temporary-package))) 1300 (unwind-protect 1301 (handler-bind 1302 ((error (lambda (condition) 1303 (error 'load-system-definition-error 1304 :name name :pathname on-disk 1305 :condition condition)))) 1306 (let ((*package* package)) 1307 (asdf-message 1308 "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%" 1309 on-disk *package*) 1310 (load on-disk))) 1311 (delete-package package)))) 1312 (let ((in-memory (system-registered-p name))) 1337 ;; don't reload if it's already been loaded, 1338 ;; or its filestamp is in the future which means some clock is skewed 1339 ;; and trying to load might cause an infinite loop. 1340 (< (car in-memory) (safe-file-write-date on-disk) (get-universal-time)))) 1341 (load-sysdef name on-disk)) 1342 (let ((in-memory (system-registered-p name))) ; try again after loading from disk 1313 1343 (cond 1314 1344 (in-memory … … 1341 1371 1342 1372 (defun* sysdef-find-asdf (name) 1343 (find-system-fallback name "asdf")) ;; :version *asdf-version* wouldn't be updated when ASDF is updated. 1373 ;; Bug: :version *asdf-version* won't be updated when ASDF is updated. 1374 (find-system-fallback name "asdf" :version *asdf-version*)) 1344 1375 1345 1376 … … 1651 1682 (retry () 1652 1683 :report (lambda (s) 1653 (format s "~@<Retry loading component ~S.~@:>" 1654 (component-find-path required-c))) 1684 (format s "~@<Retry loading component ~S.~@:>" required-c)) 1655 1685 :test 1656 1686 (lambda (c) … … 2409 2439 2410 2440 #+clisp ;XXX not exactly *verbose-out*, I know 2411 ( ext:run-shell-command command :output :terminal :wait t)2441 (or (ext:run-shell-command command :output :terminal :wait t) 0) 2412 2442 2413 2443 #+clozure … … 2587 2617 (os (maybe-warn (first-feature *os-features*) 2588 2618 "No os feature found in ~a." *os-features*)) 2589 (arch (maybe-warn (first-feature *architecture-features*) 2619 (arch #+clisp "" #-clisp 2620 (maybe-warn (first-feature *architecture-features*) 2590 2621 "No architecture feature found in ~a." 2591 2622 *architecture-features*)) … … 2595 2626 #\_ (lambda (x) (find x " /:\\(){}[]$#`'\"")) 2596 2627 (format nil "~(~@{~a~^-~}~)" lisp version os arch))))) 2597 2598 2628 2599 2629 … … 2650 2680 (and (length=n-p x 1) (member (car x) kw))))) 2651 2681 2682 (defun* report-invalid-form (reporter &rest args) 2683 (etypecase reporter 2684 (null 2685 (apply 'error 'invalid-configuration args)) 2686 (function 2687 (apply reporter args)) 2688 ((or symbol string) 2689 (apply 'error reporter args)) 2690 (cons 2691 (apply 'apply (append reporter args))))) 2692 2693 (defvar *ignored-configuration-form* nil) 2694 2652 2695 (defun* validate-configuration-form (form tag directive-validator 2653 & optional (description tag))2696 &key location invalid-form-reporter) 2654 2697 (unless (and (consp form) (eq (car form) tag)) 2655 (error "Error: Form doesn't specify ~A ~S~%" description form)) 2656 (loop :with inherit = 0 2657 :for directive :in (cdr form) :do 2658 (if (configuration-inheritance-directive-p directive) 2659 (incf inherit) 2660 (funcall directive-validator directive)) 2698 (setf *ignored-configuration-form* t) 2699 (report-invalid-form invalid-form-reporter :form form :location location) 2700 (return-from validate-configuration-form nil)) 2701 (loop :with inherit = 0 :with ignore-invalid-p = nil :with x = (list tag) 2702 :for directive :in (cdr form) 2703 :when (cond 2704 ((configuration-inheritance-directive-p directive) 2705 (incf inherit) t) 2706 ((eq directive :ignore-invalid-entries) 2707 (setf ignore-invalid-p t) t) 2708 ((funcall directive-validator directive) 2709 t) 2710 (ignore-invalid-p 2711 nil) 2712 (t 2713 (setf *ignored-configuration-form* t) 2714 (report-invalid-form invalid-form-reporter :form directive :location location) 2715 nil)) 2716 :do (push directive x) 2661 2717 :finally 2662 2718 (unless (= inherit 1) 2663 (error "One and only one of ~S or ~S is required" 2664 :inherit-configuration :ignore-inherited-configuration))) 2665 form) 2666 2667 (defun* validate-configuration-file (file validator description) 2719 (report-invalid-form invalid-form-reporter 2720 :arguments (list "One and only one of ~S or ~S is required" 2721 :inherit-configuration :ignore-inherited-configuration))) 2722 (return (nreverse x)))) 2723 2724 (defun* validate-configuration-file (file validator &key description) 2668 2725 (let ((forms (read-file-forms file))) 2669 2726 (unless (length=n-p forms 1) 2670 2727 (error "One and only one form allowed for ~A. Got: ~S~%" description forms)) 2671 (funcall validator (car forms) )))2728 (funcall validator (car forms) :location file))) 2672 2729 2673 2730 (defun* hidden-file-p (pathname) 2674 2731 (equal (first-char (pathname-name pathname)) #\.)) 2675 2732 2676 (defun* validate-configuration-directory (directory tag validator) 2733 (defun* directory* (pathname-spec &rest keys &key &allow-other-keys) 2734 (apply 'directory pathname-spec 2735 (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil) 2736 #+ccl '(:follow-links nil) 2737 #+clisp '(:circle t :if-does-not-exist :ignore) 2738 #+(or cmu scl) '(:follow-links nil :truenamep nil) 2739 #+sbcl (when (find-symbol "RESOLVE-SYMLINKS" "SB-IMPL") '(:resolve-symlinks nil)))))) 2740 2741 (defun* validate-configuration-directory (directory tag validator &key invalid-form-reporter) 2742 "Map the VALIDATOR across the .conf files in DIRECTORY, the TAG will 2743 be applied to the results to yield a configuration form. Current 2744 values of TAG include :source-registry and :output-translations." 2677 2745 (let ((files (sort (ignore-errors 2678 2746 (remove-if 2679 2747 'hidden-file-p 2680 (directory (make-pathname :name :wild :type "conf" :defaults directory) 2681 #+sbcl :resolve-symlinks #+sbcl nil))) 2748 (directory* (make-pathname :name :wild :type "conf" :defaults directory)))) 2682 2749 #'string< :key #'namestring))) 2683 2750 `(,tag 2684 2751 ,@(loop :for file :in files :append 2685 (mapcar validator (read-file-forms file))) 2752 (loop :with ignore-invalid-p = nil 2753 :for form :in (read-file-forms file) 2754 :when (eq form :ignore-invalid-entries) 2755 :do (setf ignore-invalid-p t) 2756 :else 2757 :when (funcall validator form) 2758 :collect form 2759 :else 2760 :when ignore-invalid-p 2761 :do (setf *ignored-configuration-form* t) 2762 :else 2763 :do (report-invalid-form invalid-form-reporter :form form :location file))) 2686 2764 :inherit-configuration))) 2687 2765 … … 2723 2801 ((eql t) -1) 2724 2802 (pathname 2725 (length (pathname-directory (car x))))))))) 2803 (let ((directory (pathname-directory (car x)))) 2804 (if (listp directory) (length directory) 0)))))))) 2726 2805 new-value) 2727 2806 … … 2757 2836 ((eql :default-directory) 2758 2837 (relativize-pathname-directory (default-directory))) 2838 ((eql :*/) *wild-directory*) 2839 ((eql :**/) *wild-inferiors*) 2840 ((eql :*.*.*) *wild-file*) 2759 2841 ((eql :implementation) (implementation-identifier)) 2760 2842 ((eql :implementation-type) (string-downcase (implementation-type))) … … 2766 2848 (error "pathname ~S is not relative to ~S" s super)) 2767 2849 (merge-pathnames* s super))) 2850 2851 (defvar *here-directory* nil 2852 "This special variable is bound to the currect directory during calls to 2853 PROCESS-SOURCE-REGISTRY in order that we be able to interpret the :here 2854 directive.") 2768 2855 2769 2856 (defun* resolve-absolute-location-component (x &key directory wilden) … … 2789 2876 (if wilden (wilden p) p)))) 2790 2877 ((eql :home) (user-homedir)) 2878 ((eql :here) 2879 (resolve-location (or *here-directory* 2880 ;; give semantics in the case of use interactively 2881 :default-directory) 2882 :directory t :wilden nil)) 2791 2883 ((eql :user-cache) (resolve-location *user-cache* :directory t :wilden nil)) 2792 2884 ((eql :system-cache) (resolve-location *system-cache* :directory t :wilden nil)) … … 2813 2905 2814 2906 (defun* location-designator-p (x) 2815 (flet ((componentp (c) (typep c '(or string pathname keyword)))) 2816 (or (typep x 'boolean) (componentp x) (and (consp x) (every #'componentp x))))) 2907 (flet ((absolute-component-p (c) 2908 (typep c '(or string pathname 2909 (member :root :home :here :user-cache :system-cache :default-directory)))) 2910 (relative-component-p (c) 2911 (typep c '(or string pathname 2912 (member :default-directory :*/ :**/ :*.*.* 2913 :implementation :implementation-type 2914 #-(and (or win32 windows mswindows mingw32) (not cygwin)) :uid))))) 2915 (or (typep x 'boolean) 2916 (absolute-component-p x) 2917 (and (consp x) (absolute-component-p (first x)) (every #'relative-component-p (rest x)))))) 2817 2918 2818 2919 (defun* location-function-p (x) … … 2827 2928 2828 2929 (defun* validate-output-translations-directive (directive) 2829 (unless 2830 (or (member directive '(:inherit-configuration 2831 :ignore-inherited-configuration 2832 :enable-user-cache :disable-cache nil)) 2833 (and (consp directive) 2834 (or (and (length=n-p directive 2) 2835 (or (and (eq (first directive) :include) 2836 (typep (second directive) '(or string pathname null))) 2837 (and (location-designator-p (first directive)) 2838 (or (location-designator-p (second directive)) 2839 (location-function-p (second directive)))))) 2840 (and (length=n-p directive 1) 2841 (location-designator-p (first directive)))))) 2842 (error "Invalid directive ~S~%" directive)) 2843 directive) 2844 2845 (defun* validate-output-translations-form (form) 2930 (or (member directive '(:enable-user-cache :disable-cache nil)) 2931 (and (consp directive) 2932 (or (and (length=n-p directive 2) 2933 (or (and (eq (first directive) :include) 2934 (typep (second directive) '(or string pathname null))) 2935 (and (location-designator-p (first directive)) 2936 (or (location-designator-p (second directive)) 2937 (location-function-p (second directive)))))) 2938 (and (length=n-p directive 1) 2939 (location-designator-p (first directive))))))) 2940 2941 (defun* validate-output-translations-form (form &key location) 2846 2942 (validate-configuration-form 2847 2943 form 2848 2944 :output-translations 2849 2945 'validate-output-translations-directive 2850 "output translations"))2946 :location location :invalid-form-reporter 'invalid-output-translation)) 2851 2947 2852 2948 (defun* validate-output-translations-file (file) 2853 2949 (validate-configuration-file 2854 file 'validate-output-translations-form "output translations"))2950 file 'validate-output-translations-form :description "output translations")) 2855 2951 2856 2952 (defun* validate-output-translations-directory (directory) 2857 2953 (validate-configuration-directory 2858 directory :output-translations 'validate-output-translations-directive)) 2859 2860 (defun* parse-output-translations-string (string) 2954 directory :output-translations 'validate-output-translations-directive 2955 :invalid-form-reporter 'invalid-output-translation)) 2956 2957 (defun* parse-output-translations-string (string &key location) 2861 2958 (cond 2862 2959 ((or (null string) (equal string "")) … … 2865 2962 (error "environment string isn't: ~S" string)) 2866 2963 ((eql (char string 0) #\") 2867 (parse-output-translations-string (read-from-string string) ))2964 (parse-output-translations-string (read-from-string string) :location location)) 2868 2965 ((eql (char string 0) #\() 2869 (validate-output-translations-form (read-from-string string) ))2966 (validate-output-translations-form (read-from-string string) :location location)) 2870 2967 (t 2871 2968 (loop … … 2975 3072 ((:inherit-configuration) 2976 3073 (inherit-output-translations inherit :collect collect)) 2977 ((:ignore-inherited-configuration nil)3074 ((:ignore-inherited-configuration :ignore-invalid-entries nil) 2978 3075 nil)) 2979 3076 (let ((src (first directive)) … … 2998 3095 (let* ((trudst (make-pathname 2999 3096 :defaults (if dst (resolve-location dst :directory t :wilden t) trusrc))) 3000 (wilddst (make-pathname 3001 :name :wild :type :wild :version :wild 3002 :defaults trudst))) 3097 (wilddst (merge-pathnames* *wild-file* trudst))) 3003 3098 (funcall collect (list wilddst t)) 3004 3099 (funcall collect (list trusrc trudst))))))))))) … … 3161 3256 (error "asdf:enable-asdf-binary-locations-compatibility doesn't support :map-all-source-files nil on ECL and CLISP")) 3162 3257 (let* ((fasl-type (pathname-type (compile-file-pathname "foo.lisp"))) 3163 (wild-inferiors (make-pathname :directory '(:relative :wild-inferiors))) 3164 (mapped-files (make-pathname 3165 :name :wild :version :wild 3166 :type (if map-all-source-files :wild fasl-type))) 3258 (mapped-files (if map-all-source-files *wild-file* 3259 (make-pathname :name :wild :version :wild :type fasl-type))) 3167 3260 (destination-directory 3168 3261 (if centralize-lisp-binaries … … 3170 3263 ,@(when include-per-user-information 3171 3264 (cdr (pathname-directory (user-homedir)))) 3172 :implementation , wild-inferiors)3173 `(:root , wild-inferiors:implementation))))3265 :implementation ,*wild-inferiors*) 3266 `(:root ,*wild-inferiors* :implementation)))) 3174 3267 (initialize-output-translations 3175 3268 `(:output-translations 3176 3269 ,@source-to-target-mappings 3177 ((:root , wild-inferiors,mapped-files)3270 ((:root ,*wild-inferiors* ,mapped-files) 3178 3271 (,@destination-directory ,mapped-files)) 3179 3272 (t t) … … 3295 3388 3296 3389 (defun directory-has-asd-files-p (directory) 3297 (and (ignore-errors 3298 (directory (merge-pathnames* *wild-asd* directory) 3299 #+sbcl #+sbcl :resolve-symlinks nil 3300 #+ccl #+ccl :follow-links nil 3301 #+clisp #+clisp :circle t)) 3302 t)) 3390 (ignore-errors 3391 (directory* (merge-pathnames* *wild-asd* directory)) 3392 t)) 3303 3393 3304 3394 (defun subdirectories (directory) … … 3307 3397 (wild (merge-pathnames* 3308 3398 #-(or abcl allegro lispworks scl) 3309 (make-pathname :directory '(:relative :wild) :name nil :type nil :version nil)3399 *wild-directory* 3310 3400 #+(or abcl allegro lispworks scl) "*.*" 3311 3401 directory)) … … 3313 3403 #-cormanlisp 3314 3404 (ignore-errors 3315 (directory wild . 3316 #.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil) 3317 #+ccl '(:follow-links nil :directories t :files nil) 3318 #+clisp '(:circle t :if-does-not-exist :ignore) 3319 #+(or cmu scl) '(:follow-links nil :truenamep nil) 3320 #+digitool '(:directories t) 3321 #+sbcl '(:resolve-symlinks nil)))) 3405 (directory* wild . #.(or #+ccl '(:directories t :files nil) 3406 #+digitool '(:directories t)))) 3322 3407 #+cormanlisp (cl::directory-subdirs directory)) 3323 3408 #+(or abcl allegro lispworks scl) … … 3347 3432 3348 3433 (defun* validate-source-registry-directive (directive) 3349 (unless 3350 (or (member directive '(:default-registry (:default-registry)) :test 'equal) 3351 (destructuring-bind (kw &rest rest) directive 3352 (case kw 3353 ((:include :directory :tree) 3354 (and (length=n-p rest 1) 3355 (location-designator-p (first rest)))) 3356 ((:exclude :also-exclude) 3357 (every #'stringp rest)) 3358 (null rest)))) 3359 (error "Invalid directive ~S~%" directive)) 3360 directive) 3361 3362 (defun* validate-source-registry-form (form) 3434 (or (member directive '(:default-registry)) 3435 (and (consp directive) 3436 (let ((rest (rest directive))) 3437 (case (first directive) 3438 ((:include :directory :tree) 3439 (and (length=n-p rest 1) 3440 (location-designator-p (first rest)))) 3441 ((:exclude :also-exclude) 3442 (every #'stringp rest)) 3443 ((:default-registry) 3444 (null rest))))))) 3445 3446 (defun* validate-source-registry-form (form &key location) 3363 3447 (validate-configuration-form 3364 form :source-registry 'validate-source-registry-directive "a source registry")) 3448 form :source-registry 'validate-source-registry-directive 3449 :location location :invalid-form-reporter 'invalid-source-registry)) 3365 3450 3366 3451 (defun* validate-source-registry-file (file) 3367 3452 (validate-configuration-file 3368 file 'validate-source-registry-form "a source registry"))3453 file 'validate-source-registry-form :description "a source registry")) 3369 3454 3370 3455 (defun* validate-source-registry-directory (directory) 3371 3456 (validate-configuration-directory 3372 directory :source-registry 'validate-source-registry-directive)) 3373 3374 (defun* parse-source-registry-string (string) 3457 directory :source-registry 'validate-source-registry-directive 3458 :invalid-form-reporter 'invalid-source-registry)) 3459 3460 (defun* parse-source-registry-string (string &key location) 3375 3461 (cond 3376 3462 ((or (null string) (equal string "")) … … 3379 3465 (error "environment string isn't: ~S" string)) 3380 3466 ((find (char string 0) "\"(") 3381 (validate-source-registry-form (read-from-string string) ))3467 (validate-source-registry-form (read-from-string string) :location location)) 3382 3468 (t 3383 3469 (loop … … 3476 3562 (cond 3477 3563 ((directory-pathname-p pathname) 3478 (process-source-registry (validate-source-registry-directory pathname) 3479 :inherit inherit :register register)) 3564 (let ((*here-directory* (truenamize pathname))) 3565 (process-source-registry (validate-source-registry-directory pathname) 3566 :inherit inherit :register register))) 3480 3567 ((probe-file pathname) 3481 (process-source-registry (validate-source-registry-file pathname) 3482 :inherit inherit :register register)) 3568 (let ((*here-directory* (pathname-directory-pathname pathname))) 3569 (process-source-registry (validate-source-registry-file pathname) 3570 :inherit inherit :register register))) 3483 3571 (t 3484 3572 (inherit-source-registry inherit :register register)))) … … 3528 3616 (remove-duplicates 3529 3617 (while-collecting (collect) 3530 (inherit-source-registry 3531 `(wrapping-source-registry 3532 ,parameter 3533 ,@*default-source-registries*) 3534 :register (lambda (directory &key recurse exclude) 3535 (collect (list directory :recurse recurse :exclude exclude))))) 3536 :test 'equal :from-end t)) 3618 (let ((*default-pathname-defaults* (default-directory))) 3619 (inherit-source-registry 3620 `(wrapping-source-registry 3621 ,parameter 3622 ,@*default-source-registries*) 3623 :register (lambda (directory &key recurse exclude) 3624 (collect (list directory :recurse recurse :exclude exclude))))) 3625 :test 'equal :from-end t))) 3537 3626 3538 3627 ;; Will read the configuration and initialize all internal variables, … … 3618 3707 (when system-p (appendf (compile-op-flags op) (list :system-p system-p)))))) 3619 3708 3709 ;;; If a previous version of ASDF failed to read some configuration, try again. 3710 (when *ignored-configuration-form* 3711 (clear-configuration) 3712 (setf *ignored-configuration-form* nil)) 3713 3620 3714 ;;;; ----------------------------------------------------------------- 3621 3715 ;;;; Done!
Note:
See TracChangeset
for help on using the changeset viewer.
