From b6d6fb0693c17ea9b2d508b44659d6933c3331be Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Wed, 9 Jan 2013 23:42:36 -0500 Subject: [PATCH] 2.26.68: self-upgrade now works somewhat on SBCL and CCL. Fixed corner bugs in the package surgery. Stopped using fmakunbound as part of the package definition; it should happen as part of with-upgrade, or, for now, systematically with defgeneric* and defun*. Added special magic for ASDF fixup, that will have to be enhanced. --- asdf.asd | 2 +- header.lisp | 2 +- interface.lisp | 2 +- lisp-action.lisp | 2 +- package.lisp | 42 ++++++++++++++++++++++++++++++------------ upgrade.lisp | 2 +- utility.lisp | 2 +- 7 files changed, 36 insertions(+), 18 deletions(-) diff --git a/asdf.asd b/asdf.asd index 9d8cce90..827f1814 100644 --- a/asdf.asd +++ b/asdf.asd @@ -14,7 +14,7 @@ :licence "MIT" :description "Another System Definition Facility" :long-description "ASDF builds Common Lisp software organized into defined systems." - :version "2.26.67" ;; to be automatically updated by bin/bump-revision + :version "2.26.68" ;; to be automatically updated by bin/bump-revision :depends-on () :components ((:file "asdf"))) diff --git a/header.lisp b/header.lisp index 7bc0ec0d..2a95609d 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.67: Another System Definition Facility. +;;; This is ASDF 2.26.68: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to <asdf-devel@common-lisp.net>. diff --git a/interface.lisp b/interface.lisp index 7b0e7456..6e248149 100644 --- a/interface.lisp +++ b/interface.lisp @@ -5,7 +5,7 @@ (:nicknames :asdf) (:recycle :asdf/interface :asdf) (:unintern - #:*asdf-revision* #:around #:asdf-method-combination + #:*asdf-revision* #:around #:asdf-method-combination #:intern* #:do-traverse #:do-dep #:do-one-dep #:visit-action #:component-visited-p #:split #:make-collector #:loaded-systems ; makes for annoying SLIME completion diff --git a/lisp-action.lisp b/lisp-action.lisp index 57363589..73e97428 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -9,7 +9,7 @@ (:export #:compile-error #:compile-failed #:compile-warned #:try-recompiling #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp - #:basic-load-op #:basic-compile-op + #:basic-load-op #:basic-compile-op #:compile-op-flags #:compile-op-proclamations #:load-op #:prepare-op #:compile-op #:test-op #:load-source-op #:prepare-source-op #:call-with-around-compile-hook #:perform-lisp-compilation #:perform-lisp-load-fasl #:perform-lisp-load-source)) diff --git a/package.lisp b/package.lisp index b2b1b71c..38089b2c 100644 --- a/package.lisp +++ b/package.lisp @@ -179,10 +179,10 @@ when the symbol is not found." ((gethash name shadowed) (error "Can't both shadow ~S and import it from ~S" name (package-name p))) (t - (when (and xp (not (eq i x))) - (unintern* x package)) (setf (gethash name imported) t) - (import i package)))))) + (unless (and xp (eq i x)) + (when xp (unintern* x p)) + (import i package))))))) (ensure-mix (sym p) (let* ((name (string sym)) (sp (string p))) @@ -197,22 +197,24 @@ when the symbol is not found." (ensure-inherited sym sp))))))) (ensure-inherited (sym p) (let* ((name (string sym)) - (sp (string p)) - (s (find-symbol* name sp)) - (ip (gethash name inherited))) + (symbol (find-symbol* name p)) + (sp (symbol-package symbol)) + (spn (package-name sp)) + (ipn (gethash name inherited))) (multiple-value-bind (x xp) (find-symbol name package) (cond - (ip - (unless (eq ip sp) + (ipn + (unless (eq spn ipn) (error "Can't inherit ~S from ~S, it is inherited from ~S" - name sp ip))) + name spn ipn))) ((gethash name imported) - (unless (eq s x) + (unless (eq symbol x) (error "Can't inherit ~S from ~S, it is imported from ~S" name sp (package-name (symbol-package x))))) ((gethash name shadowed) - (error "Can't inherit ~S from ~S, it is shadowed" name sp)) + (error "Can't inherit ~S from ~S, it is shadowed" name spn)) (t + (setf (gethash name inherited) spn) (when xp (unintern* x package))))))) (recycle-symbol (name) @@ -353,6 +355,7 @@ when the symbol is not found." (error "define-package: bad :upgrade directive")) (setf upgrade (car args)) :else :do (error "unrecognized define-package keyword ~S" kw) + (progn fmakunbound fmakunbound-setf) :finally (return `(,package :nicknames ,nicknames :documentation ,documentation :use ,(if use-p use '(:common-lisp)) @@ -361,9 +364,24 @@ when the symbol is not found." :recycle ,(if recycle-p recycle (cons package nicknames)) :mix ,mix :reexport ,reexport :unintern ,unintern ,@(when upgrade `(:upgrade ,upgrade)) - :fmakunbound ,fmakunbound :fmakunbound-setf ,fmakunbound-setf))))) + #|:fmakunbound ,fmakunbound :fmakunbound-setf ,fmakunbound-setf|#))))) (defmacro define-package (package &rest clauses) `(eval-when (:compile-toplevel :load-toplevel :execute) #+gcl (defpackage ,package (:use)) (apply 'ensure-package ',(parse-define-package-form package clauses)))) + +;;;; MAGIC FIXUP FOR ASDF. +;; For bootstrapping reason, define-package can't do its magic on the asdf/package package itself, +;; so instead do something ugly and special purpose. However, other packages could have imported +;; from ASDF and be in trouble. There ought to be a better solution to merging packages without tears. + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *extirpated-symbols* ()) + (when (find-package :asdf) + (let (l) + (do-external-symbols (sym :asdf/package) + (multiple-value-bind (symbol lstatus) (find-symbol* sym :asdf nil) + (when (and lstatus (not (eq sym symbol))) + (push symbol l)))) + (push (cons :asdf (mapcar #'symbol-name-package (sort l 'string<))) *extirpated-symbols*)))) diff --git a/upgrade.lisp b/upgrade.lisp index b0414a87..de3e005a 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -24,7 +24,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.67") + (asdf-version "2.26.68") (existing-asdf (find-class 'component nil)) (existing-version *asdf-version*) (already-there (equal asdf-version existing-version))) diff --git a/utility.lisp b/utility.lisp index 677f2876..2468cbef 100644 --- a/utility.lisp +++ b/utility.lisp @@ -26,7 +26,7 @@ ((defdef (def* def) `(defmacro ,def* (name formals &rest rest) `(progn - #+(or ecl gcl) + ;; #+(or ecl gcl) ,(when (and #+gcl<2.7 (symbolp name)) `(fmakunbound ',name)) #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-( -- GitLab