Skip to content
Snippets Groups Projects
Commit b6d6fb06 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

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.
parent fe4086bb
No related branches found
No related tags found
No related merge requests found
......@@ -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")))
......
;; -*- 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>.
......
......@@ -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
......
......@@ -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))
......
......@@ -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*))))
......@@ -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)))
......
......@@ -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 :-(
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment