From 3aa35aa347a2aad3e9beb4ebc2a948bd9842e184 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Fri, 11 Jan 2013 11:33:46 -0500 Subject: [PATCH] 2.26.76: export bork, shuffle some bits, fix some tests and asds --- Makefile | 16 ++- asdf-driver.asd | 2 +- asdf.asd | 2 +- compatibility.lisp | 6 +- generate-asdf.asd | 3 +- header.lisp | 2 +- lisp-build.lisp | 242 ++++++++++++++++++++++++++++++++------------- test/test3.script | 4 +- upgrade.lisp | 2 +- 9 files changed, 203 insertions(+), 76 deletions(-) diff --git a/Makefile b/Makefile index 29bc7202..34d2417c 100644 --- a/Makefile +++ b/Makefile @@ -51,9 +51,21 @@ archive-copy: archive build/asdf.lisp ${MAKE} push git checkout master +driver_lisp := header.lisp package.lisp compatibility.lisp utility.lisp upgrade.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp lisp-build.lisp +asdf_lisp := component.lisp system.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp configuration.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp + build/asdf.lisp: $(wildcard *.lisp) mkdir -p build - cat header.lisp package.lisp compatibility.lisp utility.lisp upgrade.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp component.lisp system.lisp find-system.lisp find-component.lisp lisp-build.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp configuration.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp > $@ + cat $(driver_lisp) $(asdf_lisp) > $@ + +wc: + wc $(driver_lisp) $(asdf_lisp) | sort -n + +wc-driver: + wc $(driver_lisp) + +wc-asdf: + wc $(asdf_lisp) push: git status @@ -211,7 +223,7 @@ release: TODO test-all test-on-other-machines-too debian-changelog debian-packag test-all test-all-lisps test-all-noupgrade \ debian-package release \ replace-sbcl-asdf replace-ccl-asdf \ - fix-local-git-tags fix-remote-git-tags + fix-local-git-tags fix-remote-git-tags wc wc-driver wc-asdf # RELEASE checklist: # make test-all diff --git a/asdf-driver.asd b/asdf-driver.asd index 1cc19f64..6b240de4 100644 --- a/asdf-driver.asd +++ b/asdf-driver.asd @@ -15,4 +15,4 @@ that you can't portably construct a complete program without using them." (:file "os" :depends-on ("pathname" "stream")) (:file "image" :depends-on ("os")) (:file "run-program" :depends-on ("os")) - (:file "lisp-build" :depends-on ("pathname")))) + (:file "lisp-build" :depends-on ("image")))) diff --git a/asdf.asd b/asdf.asd index e0ec4212..9cfbb43c 100644 --- a/asdf.asd +++ b/asdf.asd @@ -15,7 +15,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.75" ;; to be automatically updated by bin/bump-revision + :version "2.26.76" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:module "build" :components ((:file "asdf"))))) diff --git a/compatibility.lisp b/compatibility.lisp index fc906df8..f86053ba 100644 --- a/compatibility.lisp +++ b/compatibility.lisp @@ -55,7 +55,11 @@ (< system::*gcl-minor-version* 7))) (shadow 'type-of :asdf/compatibility) (pushnew 'ignorable pcl::*variable-declarations-without-argument*) - (pushnew :gcl<2.7 *features*))) + (pushnew :gcl<2.7 *features*)) + (unless (member :ansi-cl *features*) + (error "ASDF only supports GCL in ANSI mode. Aborting.~%")) + (setf compiler::*compiler-default-type* (pathname "") + compiler::*lsp-ext* "")) #+mkcl (eval-when (:load-toplevel :compile-toplevel :execute) diff --git a/generate-asdf.asd b/generate-asdf.asd index 8500b594..d0522b04 100644 --- a/generate-asdf.asd +++ b/generate-asdf.asd @@ -8,8 +8,9 @@ :class :concatenated-source-system ;; :include-dependencies t :translate-output-p nil - :concatenated-source-file "tmp/generated-asdf.lisp" + :concatenated-source-file "build/asdf.lisp" :serial t + :depends-on (:asdf-driver) :components ((:file "upgrade") (:file "component") diff --git a/header.lisp b/header.lisp index b645a181..3b35dd39 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*- -;;; This is ASDF 2.26.75: Another System Definition Facility. +;;; This is ASDF 2.26.76: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/lisp-build.lisp b/lisp-build.lisp index c742bcf5..fd9652d0 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -3,7 +3,7 @@ (asdf/package:define-package :asdf/lisp-build (:recycle :asdf/lisp-build :asdf) - (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os) + (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/pathname :asdf/stream :asdf/os :asdf/image) (:export #:*compile-file-warnings-behaviour* #:*compile-file-failure-behaviour* #:*compile-file-function* #:compile-file* #:compile-file-pathname* #:*output-translation-hook* @@ -32,6 +32,181 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when (defvar *output-translation-hook* 'identity) + +;;; Optimization settings + +(defvar *optimization-settings* nil) +(defvar *previous-optimization-settings* nil) +(defun get-optimization-settings () + "Get current compiler optimization settings, ready to PROCLAIM again" + (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) + #-(or clisp clozure cmu ecl sbcl scl) + (warn "xcvb-driver::get-optimization-settings does not support your implementation. Please help me fix that.") + #.`(loop :for x :in settings + ,@(or #+clozure '(:for v :in '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety* ccl::*nx-debug* ccl::*nx-cspeed*)) + #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) + #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity))) + :for y = (or #+clisp (gethash x system::*optimize*) + #+(or clozure ecl) (symbol-value v) + #+(or cmu scl) (funcall f c::*default-cookie*) + #+sbcl (cdr (assoc x sb-c::*policy*))) + :when y :collect (list x y)))) +(defun proclaim-optimization-settings () + "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*" + (proclaim `(optimize ,@*optimization-settings*)) + (let ((settings (get-optimization-settings))) + (unless (equal *previous-optimization-settings* settings) + (setf *previous-optimization-settings* settings)))) + + +;;; Condition control + +(defvar *uninteresting-conditions* + (append + #+sbcl + '(sb-c::simple-compiler-note + "&OPTIONAL and &KEY found in the same lambda list: ~S" + sb-int:package-at-variance + sb-kernel:uninteresting-redefinition + ;; the below four are controversial to include here; + ;; however there are issues with the asdf upgrade if they are not present + sb-kernel:redefinition-with-defun + sb-kernel:redefinition-with-defgeneric + sb-kernel:redefinition-with-defmethod + sb-kernel::redefinition-with-defmacro ; not exported by old SBCLs + sb-kernel:undefined-alien-style-warning + sb-ext:implicit-generic-function-warning + sb-kernel:lexical-environment-too-complex + "Couldn't grovel for ~A (unknown to the C compiler).") + ;;#+clozure '(ccl:compiler-warning) + '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.") ;; from closer2mop + ) + "Conditions that may be skipped. type symbols, predicates or strings") + +(defvar *uninteresting-load-conditions* + (append + '("Overwriting already existing readtable ~S." ;; from named-readtables + #(#:finalizers-off-warning :asdf-finalizers)) ;; from asdf-finalizers + #+clisp '(clos::simple-gf-replacing-method-warning)) + "Additional conditions that may be skipped while loading. type symbols, predicates or strings") + +(defvar *fatal-conditions* + '(serious-condition) + "Conditions to be considered fatal during compilation.") + +(defvar *deferred-warnings* () + "Warnings the handling of which is deferred until the end of the compilation unit") + +;;;; ----- Filtering conditions while building ----- + +(defun match-condition-p (x condition) + "Compare received CONDITION to some pattern X: +a symbol naming a condition class, +a simple vector of length 2, arguments to find-symbol* with result as above, +or a string describing the format-control of a simple-condition." + (etypecase x + (symbol (typep condition x)) + ((simple-vector 2) (typep condition (find-symbol* (svref x 0) (svref x 1) nil))) + (function (funcall x condition)) + (string (and (typep condition 'simple-condition) + #+(or clozure cmu scl) ; Note: on SBCL, always bound, and testing triggers warning + (slot-boundp condition + #+clozure 'ccl::format-control + #+(or cmu scl) 'conditions::format-control) + (ignore-errors (equal (simple-condition-format-control condition) x)))))) + +(defun match-any-condition-p (condition conditions) + "match CONDITION against any of the patterns of CONDITIONS supplied" + (loop :for x :in conditions :thereis (match-condition-p x condition))) + +(defun uninteresting-condition-p (condition) + "match CONDITION against any of the patterns of *UNINTERESTING-CONDITIONS*" + (match-any-condition-p condition *uninteresting-conditions*)) + +(defun fatal-condition-p (condition) + "match CONDITION against any of the patterns of *FATAL-CONDITIONS*" + (match-any-condition-p condition *fatal-conditions*)) + +(defun call-with-controlled-compiler-conditions (thunk) + (handler-bind + ((t + #'(lambda (condition) + ;; TODO: do something magic for undefined-function, + ;; save all of aside, and reconcile in the end of the virtual compilation-unit. + (cond + ((uninteresting-condition-p condition) + (muffle-warning condition)) + ((fatal-condition-p condition) + (bork condition)))))) + (funcall thunk))) + +(defmacro with-controlled-compiler-conditions ((&optional) &body body) + "Run BODY while suppressing conditions patterned after *UNINTERESTING-CONDITIONS*" + `(call-with-controlled-compiler-conditions #'(lambda () ,@body))) + +(defun call-with-controlled-loader-conditions (thunk) + (let ((*uninteresting-conditions* + (append + *uninteresting-load-conditions* + *uninteresting-conditions*))) + (call-with-controlled-compiler-conditions thunk))) + +(defmacro with-controlled-loader-conditions ((&optional) &body body) + "Run BODY while suppressing conditions patterned after *UNINTERESTING-CONDITIONS* plus a few others that don't matter at load-time." + `(call-with-controlled-loader-conditions #'(lambda () ,@body))) + +(defun save-forward-references (forward-references) + "Save forward reference conditions so they may be issued at a latter time, +possibly in a different process." + #+sbcl + (loop :for w :in sb-c::*undefined-warnings* + :for kind = (sb-c::undefined-warning-kind w) ; :function :variable :type + :for name = (sb-c::undefined-warning-name w) + :for symbol = (cond + ((consp name) + (unless (eq kind :function) + (error "unrecognized warning ~S not a function?" w)) + (ecase (car name) + ((setf) + (assert (and (consp (cdr name)) (null (cddr name))) ()) + (setf kind :setf-function) + (second name)) + ((sb-pcl::slot-accessor) + (assert (eq :global (second name))) + (assert (eq 'boundp (fourth name))) + (assert (null (nthcdr 4 name))) + (setf kind :sb-pcl-global-boundp-slot-accessor) + (third name)))) + (t + (assert (member kind '(:function :variable :type)) ()) + name)) + :for symbol-name = (symbol-name symbol) + :for package-name = (package-name (symbol-package symbol)) + :collect `(:undefined ,symbol-name ,package-name ,kind) :into undefined-warnings + :finally (setf *deferred-warnings* undefined-warnings + sb-c::*undefined-warnings* nil)) + (when forward-references + (with-open-file (s forward-references :direction :output :if-exists :supersede) + (write *deferred-warnings* :stream s :pretty t :readably t) + (terpri s)))) + +(defun call-with-asdf-compilation-unit (thunk &key forward-references) + (with-compilation-unit (:override t) + (let ((*deferred-warnings* ()) + #+sbcl (sb-c::*undefined-warnings* nil)) + (multiple-value-prog1 + (with-controlled-compiler-conditions () + (funcall thunk)) + (save-forward-references forward-references))))) + +(defmacro with-asdf-compilation-unit ((&key forward-references) &body body) + "Like WITH-COMPILATION-UNIT, but saving forward-reference issues +for processing later (possibly in a different process)." + `(call-with-xcvb-compilation-unit #'(lambda () ,@body) :forward-references ,forward-references)) + + +;;; from ASDF + (defun* lispize-pathname (input-file) (make-pathname :type "lisp" :defaults input-file)) @@ -141,68 +316,3 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when (loop :for f :in fasls :do (ignore-errors (delete-file f))) (ignore-errors (lispworks:delete-system :fasls-to-concatenate))))) - -;;; Optimization settings - -(defvar *optimization-settings* nil) -(defvar *previous-optimization-settings* nil) -(defun get-optimization-settings () - "Get current compiler optimization settings, ready to PROCLAIM again" - (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) - #-(or clisp clozure cmu ecl sbcl scl) - (warn "xcvb-driver::get-optimization-settings does not support your implementation. Please help me fix that.") - #.`(loop :for x :in settings - ,@(or #+clozure '(:for v :in '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety* ccl::*nx-debug* ccl::*nx-cspeed*)) - #+ecl '(:for v :in '(c::*speed* c::*space* c::*safety* c::*debug*)) - #+(or cmu scl) '(:for f :in '(c::cookie-speed c::cookie-space c::cookie-safety c::cookie-debug c::cookie-cspeed c::cookie-brevity))) - :for y = (or #+clisp (gethash x system::*optimize*) - #+(or clozure ecl) (symbol-value v) - #+(or cmu scl) (funcall f c::*default-cookie*) - #+sbcl (cdr (assoc x sb-c::*policy*))) - :when y :collect (list x y)))) -(defun proclaim-optimization-settings () - "Proclaim the optimization settings in *OPTIMIZATION-SETTINGS*" - (proclaim `(optimize ,@*optimization-settings*)) - (let ((settings (get-optimization-settings))) - (unless (equal *previous-optimization-settings* settings) - (setf *previous-optimization-settings* settings)))) - - -;;; Condition control - -(defvar *uninteresting-conditions* - (append - #+sbcl - '(sb-c::simple-compiler-note - "&OPTIONAL and &KEY found in the same lambda list: ~S" - sb-int:package-at-variance - sb-kernel:uninteresting-redefinition - ;; the below four are controversial to include here; - ;; however there are issues with the asdf upgrade if they are not present - sb-kernel:redefinition-with-defun - sb-kernel:redefinition-with-defgeneric - sb-kernel:redefinition-with-defmethod - sb-kernel::redefinition-with-defmacro ; not exported by old SBCLs - sb-kernel:undefined-alien-style-warning - sb-ext:implicit-generic-function-warning - sb-kernel:lexical-environment-too-complex - "Couldn't grovel for ~A (unknown to the C compiler).") - ;;#+clozure '(ccl:compiler-warning) - '("No generic function ~S present when encountering macroexpansion of defmethod. Assuming it will be an instance of standard-generic-function.") ;; from closer2mop - ) - "Conditions that may be skipped. type symbols, predicates or strings") - -(defvar *uninteresting-load-conditions* - (append - '("Overwriting already existing readtable ~S." ;; from named-readtables - #(#:finalizers-off-warning :asdf-finalizers)) ;; from asdf-finalizers - #+clisp '(clos::simple-gf-replacing-method-warning)) - "Additional conditions that may be skipped while loading. type symbols, predicates or strings") - -(defvar *fatal-conditions* - '(serious-condition) - "Conditions to be considered fatal during compilation.") - -(defvar *deferred-warnings* () - "Warnings the handling of which is deferred until the end of the compilation unit") - diff --git a/test/test3.script b/test/test3.script index 44c28a71..ceb240dc 100644 --- a/test/test3.script +++ b/test/test3.script @@ -4,8 +4,8 @@ (quit-on-error (let* ((fasl1 (asdf:compile-file-pathname* (truename "file1.lisp"))) (fasl2 (asdf:compile-file-pathname* (truename "file2.lisp"))) - (ns1 (native-namestring fasl1)) - (ns2 (native-namestring fasl2))) + (ns1 (asdf::native-namestring fasl1)) + (ns2 (asdf::native-namestring fasl2))) (asdf:run-shell-command "rm -f ~A ~A" ns1 ns2) (setf asdf:*central-registry* '(*default-pathname-defaults*)) (DBG "should load file1 but not file2") diff --git a/upgrade.lisp b/upgrade.lisp index 1e5b43e4..3b1d3add 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -31,7 +31,7 @@ ;; "2.345.6" would be a development version in the official upstream ;; "2.345.0.7" would be your seventh local modification of official release 2.345 ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6 - (asdf-version "2.26.75") + (asdf-version "2.26.76") (existing-asdf (find-class (find-symbol* :component :asdf nil) nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) -- GitLab