Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
056f33a9
Commit
056f33a9
authored
Jan 09, 2013
by
Francois-Rene Rideau
Browse files
2.26.64: checkpointing progress with define-package
parent
4b1cea29
Changes
7
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
056f33a9
...
...
@@ -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.6
3
"
;; to be automatically updated by bin/bump-revision
:version
"2.26.6
4
"
;; to be automatically updated by bin/bump-revision
:depends-on
()
:components
((
:file
"asdf"
)))
...
...
generate-asdf.asd
View file @
056f33a9
...
...
@@ -26,24 +26,26 @@
:components
((
:file
"header"
)
(
:module
"
code
"
:pathname
""
:components
"
utils
"
:pathname
""
:components
((
:file
"package"
)
(
:file
"implementation"
:depends-on
(
"package"
))
(
:file
"utility"
:depends-on
(
"implementation"
))
(
:file
"pathname"
:depends-on
(
"utility"
))
(
:file
"os"
:depends-on
(
"pathname"
))
(
:file
"upgrade"
:depends-on
(
"utility"
))
(
:file
"component"
:depends-on
(
"pathname"
))
(
:file
"os"
:depends-on
(
"pathname"
))))
(
:module
"code"
:pathname
""
:components
(
:file
"upgrade"
)
(
:file
"component"
)
(
:file
"system"
:depends-on
(
"component"
))
(
:file
"find-system"
:depends-on
(
"system"
))
(
:file
"find-component"
:depends-on
(
"find-system"
))
(
:file
"lisp-build"
:depends-on
(
"pathname"
)
)
(
:file
"operation"
:depends-on
(
"utility"
)
)
(
:file
"lisp-build"
)
(
:file
"operation"
)
(
:file
"action"
:depends-on
(
"find-component"
"operation"
))
(
:file
"lisp-action"
:depends-on
(
"action"
"lisp-build"
))
(
:file
"plan"
:depends-on
(
"action"
))
(
:file
"operate"
:depends-on
(
"plan"
))
(
:file
"configuration"
:depends-on
(
"pathname"
)
)
(
:file
"configuration"
)
(
:file
"output-translations"
:depends-on
(
"configuration"
"operate"
))
(
:file
"source-registry"
:depends-on
(
"configuration"
"find-system"
))
(
:file
"backward-internals"
:depends-on
(
"action"
"operate"
))
...
...
header.lisp
View file @
056f33a9
;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
;;; This is ASDF 2.26.6
3
: Another System Definition Facility.
;;; This is ASDF 2.26.6
4
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
package.lisp
View file @
056f33a9
...
...
@@ -13,7 +13,9 @@
(
defpackage
:asdf/package
(
:use
:common-lisp
)
(
:export
#:find-symbol*
#:define-package
))
#:find-symbol*
#:present-symbol-p
#:present-symbols
#:intern*
#:remove-symbol
#:unlink-package
#:ensure-package
#:define-package
))
(
in-package
:asdf/package
)
...
...
@@ -38,152 +40,234 @@ when the symbol is not found."
(
defun
intern*
(
name
package
)
(
intern
(
string
name
)
package
))
(
defun
remove-symbol
(
symbol
package
)
(
let
((
sym
(
find-symbol*
symbol
package
)))
(
let
((
sym
(
find-symbol*
symbol
package
nil
)))
(
when
sym
#-
cormanlisp
(
unexport
sym
package
)
(
unintern
sym
package
)
sym
)))
(
defun
present-symbol-p
(
symbol
package
)
(
member
(
nth-value
1
(
find-symbol*
symbol
package
))
'
(
:internal
:external
)))
(
member
(
nth-value
1
(
find-symbol*
symbol
package
nil
))
'
(
:internal
:external
)))
(
defun
present-symbols
(
package
)
;; #-genera (loop :for s :being :the :present-symbols :in package :collect s) #+genera
(
let
(
l
)
(
do-symbols
(
s
package
)
(
when
(
present-symbol-p
s
package
)
(
push
s
l
)))
(
reverse
l
)))
(
defun
ensure-package-use
(
package
use
)
(
dolist
(
used
(
package-use-list
package
))
(
unless
(
member
(
package-name
used
)
use
:test
'string=
)
(
unuse-package
used
)
(
do-external-symbols
(
sym
used
)
(
when
(
eq
sym
(
find-symbol*
sym
package
))
(
remove-symbol
sym
package
)))))
(
dolist
(
used
(
reverse
use
))
(
do-external-symbols
(
sym
used
)
(
unless
(
eq
sym
(
find-symbol*
sym
package
))
(
remove-symbol
sym
package
)))
(
use-package
used
package
)))
(
defun
ensure-package-unintern
(
package
symbols
)
(
loop
:with
packages
=
(
list-all-packages
)
:for
sym
:in
symbols
:for
removed
=
(
remove-symbol
sym
package
)
:when
removed
:do
(
loop
:for
p
:in
packages
:do
(
when
(
eq
removed
(
find-symbol*
sym
p
))
(
unintern
removed
p
)))))
(
defun
unlink-package
(
package
)
(
let
((
u
(
find-package
package
)))
(
when
u
(
ensure-package-unintern
u
(
present-symbols
u
))
(
loop
:for
p
:in
(
package-used-by-list
u
)
:do
(
unuse-package
u
p
))
(
delete-package
u
))))
(
defun
ensure-package-exists
(
name
nicknames
use
)
(
let
((
previous
(
remove-duplicates
(
mapcar
#'
find-package
(
cons
name
nicknames
))
:from-end
t
)))
;; do away with packages with conflicting (nick)names
(
map
()
#'
unlink-package
(
cdr
previous
))
;; reuse previous package with same name
(
let
((
p
(
car
previous
)))
(
cond
(
p
(
rename-package
p
name
nicknames
)
(
ensure-package-use
p
use
)
p
)
(
t
(
make-package
name
:nicknames
nicknames
:use
use
))))))
(
defun
ensure-package-shadow
(
package
symbols
)
(
shadow
symbols
package
))
(
let
(
l
)
(
do-symbols
(
s
package
)
(
when
(
present-symbol-p
s
package
)
(
push
s
l
)))
(
reverse
l
))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
soft-upgrade-p
(
upgrade
)
(
ecase
upgrade
((
:soft
nil
)
t
)
(
:hard
nil
)))
(
defun
check-packages-exist
(
package-names
)
(
remove-duplicates
(
loop
:for
n
:in
package-names
:for
p
=
(
find-package
n
)
:when
p
:collect
p
:else
:do
(
error
"Package ~A does not exist"
n
))
:from-end
t
))
(
defun
ensure-package-unused
(
package
)
(
loop
:for
p
:in
(
package-used-by-list
package
)
:do
(
unuse-package
package
p
)))
(
defun
ensure-package-deleted
(
package
)
;; &key upgrade
(
let
((
p
(
find-package
package
)))
(
when
p
;;(unless (soft-upgrade-p upgrade) (ensure-package-unintern p (present-symbols u)))
(
ensure-package-unused
p
)
(
delete-package
package
))))
(
defun
ensure-package-fmakunbound
(
package
symbols
)
(
loop
:for
name
:in
symbols
:for
sym
=
(
find-symbol*
name
package
)
:for
sym
=
(
find-symbol*
name
package
nil
)
:when
sym
:do
(
fmakunbound
sym
)))
(
defun
ensure-package-fmakunbound-setf
(
package
symbols
)
(
loop
:for
name
:in
symbols
:for
sym
=
(
find-symbol*
name
package
)
:for
sym
=
(
find-symbol*
name
package
nil
)
:when
sym
:do
#-
gcl
(
fmakunbound
`
(
setf
,
sym
))))
(
defun
ensure-package-export
(
package
export
)
(
let
((
formerly-exported-symbols
nil
)
(
bothly-exported-symbols
nil
)
(
newly-exported-symbols
nil
))
(
do-external-symbols
(
sym
package
)
(
if
(
member
sym
export
:test
'string-equal
)
(
push
sym
bothly-exported-symbols
)
(
push
sym
formerly-exported-symbols
)))
(
loop
:for
sym
:in
export
:do
(
unless
(
member
sym
bothly-exported-symbols
:test
'equal
)
(
push
sym
newly-exported-symbols
)))
(
loop
:for
user
:in
(
package-used-by-list
package
)
:for
shadowing
=
(
package-shadowing-symbols
user
)
:do
(
loop
:for
new
:in
newly-exported-symbols
:for
old
=
(
find-symbol*
new
user
)
:when
(
and
old
(
not
(
member
old
shadowing
)))
:do
(
unintern
old
user
)))
(
loop
:for
x
:in
newly-exported-symbols
:do
(
export
(
intern*
x
package
)))))
(
defun
ensure-package-unintern
(
package
unintern
&key
table
(
users
(
list-all-packages
)))
(
loop
:for
u
:in
unintern
:for
name
=
(
string
u
)
:for
removed
=
(
remove-symbol
name
package
)
:do
(
when
removed
(
loop
:for
p
:in
users
:do
(
when
(
eq
removed
(
find-symbol
name
p
))
(
unintern
removed
p
)))))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
recycle-symbol
(
name
recycle
)
(
loop
:for
r
:in
recycle
:for
s
=
(
find-symbol*
name
r
nil
)
:when
s
:do
(
values
s
r
)))
(
defun
ensure-package
(
name
&key
nicknames
use
intern
unintern
shadow
export
import-from
shadowing-import-from
recycle
mix
fmakunbound
fmakunbound-setf
)
recycle
mix
intern
import-from
shadowing-import-from
(
let*
((
p
(
ensure-package-exists
name
nicknames
use
)))
#-
ecl
(
ensure-package-fmakunbound
p
fmakunbound
)
#+
ecl
fmakunbound
;; do it later on ECL
#-
ecl
(
ensure-package-fmakunbound-setf
p
fmakunbound-setf
)
#+
ecl
fmakunbound-setf
(
ensure-package-unintern
p
unintern
)
(
ensure-package-shadow
p
shadow
)
(
ensure-package-export
p
export
)
p
))
#|
(let ((h (make-hash-table :test 'equal)))
(labels ((ensure-imported (n)
(let* ((s (string n))
(x (gethash s h)))
(unless x (setf (gethash s h) t))
x))
(import-from (package)
(loop :for s :being :each :external-symbol :in package
:for n = (symbol-name s)
:unless (ensure-imported n)
:collect n)))
;; First, mark the symbols explicitly imported by the user
(loop :for (kw . ()) :in clauses
:when (member kw '(:import-from :shadowing-import-from)) :do
(map () #'ensure-imported (cddr clauses)))
`(eval-when (:compile-toplevel :load-toplevel :execute)
(ensure-package
',name :nicknames ',nicknames :use ',use :export ',export
:shadow ',shadow :unintern ',unintern
:fmakunbound ',fmakunbound :fmakunbound-setf ',fmakunbound-setf)))
`(defpackage ,package (:use)
,@(loop :for p :in mixed-packages
:collect `(:import-from ,p ,@(import-from p)))
,@clauses
(:export ,@(loop :for s :being :the :hash-keys :of h :collect s)))))))
|#
(
defun
parse-define-package-clauses
(
clauses
)
(
loop
:for
(
kw
.
args
)
:in
clauses
upgrade
nicknames
documentation
use
shadow
shadowing-import-from
import-from
export
intern
recycle
mix
reexport
unintern
fmakunbound
fmakunbound-setf
)
(
let*
((
nicknames
(
mapcar
#'
string
nicknames
))
(
use
(
check-packages-exist
use
))
(
shadow
(
mapcar
#'
string
shadow
))
(
shadowing-import-from
(
loop
:for
sif
:in
shadowing-import-from
:collect
(
mapcar
#'
string
sif
)))
(
import-from
(
loop
:for
if
:in
import-from
:collect
(
mapcar
#'
string
if
)))
(
export
(
mapcar
#'
string
export
))
(
recycle
(
remove
nil
(
mapcar
#'
find-package
recycle
)))
(
mix
(
check-packages-exist
mix
))
(
shadowed
(
make-hash-table
:test
'equal
))
(
inherited
(
make-hash-table
:test
'equal
))
(
imported
(
make-hash-table
:test
'equal
))
(
exported
(
make-hash-table
:test
'equal
))
(
previous
(
remove-duplicates
(
mapcar
#'
find-package
(
cons
name
nicknames
))
:from-end
t
))
(
discarded
(
cdr
previous
))
(
package
(
or
(
first
previous
)
(
make-package
name
:nicknames
nicknames
))))
(
setf
(
documentation
package
t
)
documentation
)
(
assert
(
soft-upgrade-p
upgrade
))
(
ensure-package-unused
package
)
(
map
()
#'
ensure-package-deleted
discarded
)
(
rename-package
package
name
nicknames
)
(
dolist
(
name
unintern
)
(
remove-symbol
name
package
))
;;; Compute the desired state of the package
(
loop
:for
sym
:in
shadow
:for
name
=
(
string
sym
)
:do
(
setf
(
gethash
name
shadowed
)
t
)
(
multiple-value-bind
(
recycled
previous
)
(
recycle-symbol
name
recycle
)
(
cond
((
or
(
not
previous
)
(
not
(
member
(
symbol-package
recycle
)
recycle
)))
(
ecase
(
nth-value
1
(
find-symbol*
name
package
nil
))
((
nil
:inherited
)
(
shadow
name
package
))
((
:internal
:external
)
(
shadowing-import
(
make-symbol
name
)
package
))))
((
eq
previous
package
)
(
shadow
recycled
package
))
(
t
(
unintern
recycled
previous
)
(
shadowing-import
recycled
package
)))))
(
labels
((
ensure-shadowing-import
(
sym
p
)
(
let*
((
name
(
string
sym
))
(
i
(
find-symbol*
name
p
)))
(
cond
((
gethash
name
shadowed
)
(
unless
(
eq
i
(
gethash
name
imported
))
(
error
"Conflicting shadowings for ~A"
name
)))
(
t
(
setf
(
gethash
name
shadowed
)
t
)
(
setf
(
gethash
name
imported
)
i
)
(
shadowing-import
package
)))))
(
ensure-import
(
sym
p
)
(
let*
((
name
(
string
sym
))
(
i
(
find-symbol*
name
p
)))
(
multiple-value-bind
(
ii
ip
)
(
gethash
name
imported
)
(
cond
(
ip
(
unless
(
eq
i
ii
)
(
error
"Can't import ~S from both ~S and ~S"
name
(
package-name
(
symbol-package
ii
))
(
package-name
p
))))
((
gethash
name
shadowed
)
(
error
"Can't both shadow ~S and import it from ~S"
name
(
package-name
p
)))
(
t
(
multiple-value-bind
(
x
xp
)
(
find-symbol
name
package
)
(
when
(
and
xp
(
not
(
eq
i
x
)))
(
unintern
x
package
))
(
import
i
package
)))))))
(
ensure-mix
(
sym
p
)
(
let*
((
name
(
string
sym
))
(
i
(
find-symbol*
name
p
)))
(
unless
(
or
(
gethash
name
shadowed
)
(
nth-value
1
(
gethash
name
imported
)))
(
multiple-value-bind
(
in
inp
)
(
gethash
name
inherited
)
(
cond
((
eq
i
in
))
(
inp
(
remhash
name
inherited
)
(
ensure-shadowing-import
name
(
symbol-package
in
)))
(
t
(
ensure-inherited
sym
p
)))))))
(
ensure-inherited
(
sym
p
)
(
let*
((
name
(
string
sym
))
(
i
(
find-symbol*
name
p
)))
(
multiple-value-bind
(
in
inp
)
(
gethash
name
inherited
)
(
multiple-value-bind
(
im
imp
)
(
gethash
name
imported
)
(
cond
(
inp
(
unless
(
eq
i
in
)
(
error
"Can't inherit ~S from ~S, it is inherited from ~S"
name
(
package-name
p
)
(
package-name
(
symbol-package
in
)))))
(
imp
(
unless
(
eq
i
im
)
(
error
"Can't inherit ~S from ~S, it is imported from ~S"
name
(
package-name
p
)
(
package-name
(
symbol-package
im
)))))
((
gethash
name
shadowed
)
(
error
"Can't inherit ~S from ~S, it is shadowed"
name
(
package-name
p
)))
(
t
(
multiple-value-bind
(
x
xp
)
(
find-symbol
name
package
)
(
when
xp
(
unintern
x
package
)))))))))
(
ensure-registered-symbol
(
sym
)
(
let
((
name
(
string
sym
)))
(
unless
(
or
(
gethash
name
shadowed
)
(
nth-value
1
(
gethash
name
imported
))
(
nth-value
1
(
gethash
name
inherited
)))
(
multiple-value-bind
(
recycled
previous
)
(
recycle-symbol
name
recycle
)
(
cond
((
or
(
not
previous
)
(
not
(
member
(
symbol-package
recycle
)
recycle
)))
(
unintern
sym
package
))
((
eq
previous
package
))
(
t
(
unintern
recycled
previous
)
(
import
recycled
package
))))))))
(
loop
:for
(
p
.
syms
)
:in
shadowing-import-from
:do
(
dolist
(
sym
syms
)
(
ensure-shadowing-import
sym
p
)))
(
loop
:for
p
:in
mix
:do
(
do-external-symbols
(
sym
p
)
(
ensure-mix
sym
p
)))
(
loop
:for
(
p
.
syms
)
:in
import-from
:do
(
dolist
(
sym
syms
)
(
ensure-import
sym
p
)))
(
loop
:for
p
:in
use
:do
(
do-external-symbols
(
sym
p
)
(
ensure-inherited
sym
p
)))
(
loop
:for
p
:in
use
:do
(
use-package
p
package
))
(
dolist
(
sym
intern
)
(
intern*
sym
package
))
(
do-symbols
(
sym
package
)
(
ensure-registered-symbol
sym
))
(
loop
:for
p
:in
reexport
:do
(
do-external-symbols
(
sym
p
)
(
let
((
name
(
string
sym
)))
(
export
(
find-symbol*
name
package
)
package
)
(
setf
(
gethash
name
exported
)
t
))))
(
dolist
(
sym
export
)
(
export
sym
package
)
(
setf
(
gethash
sym
exported
)
t
))
(
do-external-symbols
(
sym
package
)
(
unless
(
gethash
sym
exported
)
(
unexport
sym
)))
;; do away with packages with conflicting (nick)names
;; note from ASDF 2.26: ECL might not be liking an early fmakunbound (below #-ecl'ed)
(
ensure-package-fmakunbound
package
fmakunbound
)
(
ensure-package-fmakunbound-setf
package
fmakunbound-setf
)
package
))))
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defun
parse-define-package-clauses
(
package
clauses
)
(
loop
:with
use-p
=
nil
:with
recycle-p
=
nil
:with
documentation
=
nil
:with
upgrade
=
nil
:for
(
kw
.
args
)
:in
clauses
:when
(
eq
kw
:nicknames
)
:append
args
:into
nicknames
:else
:when
(
eq
kw
:use
)
:append
args
:into
use
:else
:when
(
eq
kw
:documentation
)
:do
(
cond
(
documentation
(
error
"define-package: can't define documentation twice"
))
((
or
(
atom
args
)
(
cdr
args
))
(
error
"define-package: bad documentation"
))
(
t
(
setf
documentation
(
car
args
))))
:else
:when
(
eq
kw
:use
)
:append
args
:into
use
:and
:do
(
setf
use-p
t
)
:else
:when
(
eq
kw
:shadow
)
:append
args
:into
shadow
:else
:when
(
eq
kw
:shadowing-import-from
)
:collect
args
:into
shadowing-import-from
:else
:when
(
eq
kw
:import-from
)
:collect
args
:into
import-from
:else
:when
(
eq
kw
:export
)
:append
args
:into
export
:else
:when
(
eq
kw
:intern
)
:append
args
:into
intern
:else
:when
(
eq
kw
:import-from
)
:collect
args
:into
import-from
:else
:when
(
eq
kw
:shadowing-import-from
)
:collect
args
:into
shadowing-import-from
:else
:when
(
eq
kw
:recycle
)
:append
args
:into
recycle
:else
:when
(
eq
kw
:recycle
)
:append
args
:into
recycle
:and
:do
(
setf
recycle-p
t
)
:else
:when
(
eq
kw
:mix
)
:append
args
:into
mix
:else
:when
(
eq
kw
:reexport
)
:append
args
:into
reexport
:else
:when
(
eq
kw
:unintern
)
:append
args
:into
unintern
:else
:when
(
eq
kw
:fmakunbound
)
:append
args
:into
fmakunbound
:else
:when
(
eq
kw
:fmakunbound-setf
)
:append
args
:into
fmakunbound-setf
:else
:do
(
error
"unrecognized define-package keyword ~S"
kw
)
:finally
(
return
`
(
:nicknames
,
nicknames
:use
,
use
:shadow
,
shadow
:export
,
export
:intern
,
intern
:import-from
,
import-from
:shadowing-import-from
,
shadowing-import-from
:recycle
,
recycle
:mix
,
mix
:unintern
,
unintern
:fmakunbound
,
fmakunbound
:fmakunbound-setf
,
fmakunbound-setf
))))
)
;eval-when
:when
(
eq
kw
:upgrade
)
:do
(
unless
(
and
(
consp
args
)
(
null
(
cdr
args
))
(
member
(
car
args
)
'
(
:soft
:hard
))
(
null
upgrade
))
(
error
"define-package: bad :upgrade directive"
))
(
setf
upgrade
(
car
args
))
:else
:do
(
error
"unrecognized define-package keyword ~S"
kw
)
:finally
(
return
`
(
:nicknames
,
nicknames
:documentation
,
documentation
:use
,
(
if
use-p
use
'
(
:common-lisp
))
:shadow
,
shadow
:shadowing-import-from
,
shadowing-import-from
:import-from
,
import-from
:export
,
export
:intern
,
intern
:recycle
,
(
if
recycle-p
recycle
(
cons
package
nicknames
))
:mix
,
mix
:reexport
,
reexport
:unintern
,
unintern
,@
(
when
upgrade
`
(
:upgrade
,
upgrade
))
:fmakunbound
,
fmakunbound
:fmakunbound-setf
,
fmakunbound-setf
)))))
(
defmacro
define-package
(
package
&rest
clauses
)
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
(
apply
'ensure-package
',package
',
(
parse-define-package-clauses
clauses
))))
#+
gcl
(
defpackage
,
package
(
:use
))
(
apply
'ensure-package
',
(
parse-define-package-clauses
package
clauses
))))
pathname.lisp
View file @
056f33a9
...
...
@@ -706,8 +706,7 @@ For the latter case, we ought pick random suffix and atomically open it."
(
defun*
physical-pathname-p
(
x
)
(
and
(
pathnamep
x
)
(
not
(
typep
x
'logical-pathname
))))
(
defun*
sane-physical-pathname
(
&key
(
defaults
*default-pathname-defaults*
)
fallback
(
keep
t
)
must-exist
)
(
defun*
sane-physical-pathname
(
defaults
&key
(
keep
t
)
fallback
must-exist
)
(
flet
((
sanitize
(
x
)
(
setf
x
(
and
x
(
ignore-errors
(
translate-logical-pathname
x
))))
(
when
(
pathnamep
x
)
...
...
@@ -722,10 +721,13 @@ For the latter case, we ought pick random suffix and atomically open it."
(
setf
x
(
and
(
probe-file*
x
)
x
)))
(
and
(
physical-pathname-p
x
)
x
))))
(
or
(
sanitize
defaults
)
(
when
fallback
(
sanitize
(
ignore-errors
(
user-homedir-pathname
))))
(
when
fallback
(
or
(
sanitize
(
ignore-errors
(
user-homedir-pathname
)))
(
sanitize
(
nil-pathname
))))
(
error
"Could not find a sanitize ~S ~:[~;or a fallback ~] into a physical pathname"
defaults
fallback
))))
;;;; -----------------------------------------------------------------
;;;; Windows shortcut support. Based on:
;;;;
...
...
test/script-support.lisp
View file @
056f33a9
...
...
@@ -63,9 +63,9 @@
(
let
((
old-asdf
(
merge-pathnames
(
make-pathname
:directory
`
(
#-
gcl
:relative
"tmp"
)
:name
(
format
nil
"asdf-~A"
tag
)
:name
(
format
nil
"asdf-~A"
tag
)
:type
"lisp"
:defaults
*asdf-directory*
)
*asdf-
lisp
*
)))
*asdf-
directory
*
)))
(
handler-bind
(
#+
sbcl
(
sb-kernel:redefinition-warning
#'
muffle-warning
))
(
load
old-asdf
))))
...
...
upgrade.lisp
View file @
056f33a9
...
...
@@ -23,7 +23,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.6
3
"
)
(
asdf-version
"2.26.6
4
"
)
(
existing-asdf
(
find-class
'component
nil
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment