Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
400465c0
Commit
400465c0
authored
Feb 20, 2013
by
Francois-Rene Rideau
Browse files
2.29.7: Fix some corner cases from testing with cl-test-grid.
parent
feafa5c5
Changes
8
Hide whitespace changes
Inline
Side-by-side
asdf.asd
View file @
400465c0
...
...
@@ -74,7 +74,7 @@
:licence
"MIT"
:description
"Another System Definition Facility"
:long-description
"ASDF builds Common Lisp software organized into defined systems."
:version
"2.29.
6
"
;; to be automatically updated by make bump-version
:version
"2.29.
7
"
;; to be automatically updated by make bump-version
:depends-on
()
#+
asdf3
:encoding
#+
asdf3
:utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
...
...
filesystem.lisp
View file @
400465c0
...
...
@@ -463,7 +463,8 @@ TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
(
with-upgradability
()
(
defun
ensure-all-directories-exist
(
pathnames
)
(
dolist
(
pathname
pathnames
)
(
ensure-directories-exist
(
translate-logical-pathname
pathname
))))
(
when
pathname
(
ensure-directories-exist
(
translate-logical-pathname
pathname
)))))
(
defun
rename-file-overwriting-target
(
source
target
)
#+
clisp
;; But for a bug in CLISP 2.48, we should use :if-exists :overwrite and be atomic
...
...
find-system.lisp
View file @
400465c0
...
...
@@ -100,6 +100,7 @@ of which is a system object.")
(
setf
*defined-systems*
(
make-hash-table
:test
'equal
))
(
when
asdf
(
setf
(
component-version
asdf
)
*asdf-version*
)
(
setf
(
builtin-system-p
asdf
)
t
)
(
register-system
asdf
)))
(
values
))
...
...
header.lisp
View file @
400465c0
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.29.
6
: Another System Definition Facility.
;;; This is ASDF 2.29.
7
: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
...
...
os.lisp
View file @
400465c0
...
...
@@ -250,74 +250,73 @@ then returning the non-empty string value of the variable"
;;;; Jesse Hager: The Windows Shortcut File Format.
;;;; http://www.wotsit.org/list.asp?fc=13
#-
(
or
clisp
genera
)
; CLISP doesn't need it, and READ-SEQUENCE annoys old Genera.
(
with-upgradability
()
#-
(
or
clisp
genera
)
; CLISP doesn't need it, and READ-SEQUENCE annoys old Genera.
(
progn
(
defparameter
*link-initial-dword*
76
)
(
defparameter
*link-guid*
#(
1
20
2
0
0
0
0
0
192
0
0
0
0
0
0
70
))
(
defun
read-null-terminated-string
(
s
)
(
with-output-to-string
(
out
)
(
loop
:for
code
=
(
read-byte
s
)
:until
(
zerop
code
)
:do
(
write-char
(
code-char
code
)
out
))))
(
defun
read-little-endian
(
s
&optional
(
bytes
4
))
(
loop
:for
i
:from
0
:below
bytes
:sum
(
ash
(
read-byte
s
)
(
*
8
i
))))
(
defun
parse-file-location-info
(
s
)
(
let
((
start
(
file-position
s
))
(
total-length
(
read-little-endian
s
))
(
end-of-header
(
read-little-endian
s
))
(
fli-flags
(
read-little-endian
s
))
(
local-volume-offset
(
read-little-endian
s
))
(
local-offset
(
read-little-endian
s
))
(
network-volume-offset
(
read-little-endian
s
))
(
remaining-offset
(
read-little-endian
s
)))
(
declare
(
ignore
total-length
end-of-header
local-volume-offset
))
(
unless
(
zerop
fli-flags
)
(
cond
((
logbitp
0
fli-flags
)
(
file-position
s
(
+
start
local-offset
)))
((
logbitp
1
fli-flags
)
(
file-position
s
(
+
start
network-volume-offset
#x14
))))
(
strcat
(
read-null-terminated-string
s
)
(
progn
(
file-position
s
(
+
start
remaining-offset
))
(
read-null-terminated-string
s
))))))
(
defun
parse-windows-shortcut
(
pathname
)
(
with-open-file
(
s
pathname
:element-type
'
(
unsigned-byte
8
))
(
handler-case
(
when
(
and
(
=
(
read-little-endian
s
)
*link-initial-dword*
)
(
let
((
header
(
make-array
(
length
*link-guid*
))))
(
read-sequence
header
s
)
(
equalp
header
*link-guid*
)))
(
let
((
flags
(
read-little-endian
s
)))
(
file-position
s
76
)
;skip rest of header
(
when
(
logbitp
0
flags
)
;; skip shell item id list
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
cond
((
logbitp
1
flags
)
(
parse-file-location-info
s
))
(
t
(
when
(
logbitp
2
flags
)
;; skip description string
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
when
(
logbitp
3
flags
)
;; finally, our pathname
(
let*
((
length
(
read-little-endian
s
2
))
(
buffer
(
make-array
length
)))
(
read-sequence
buffer
s
)
(
map
'string
#'
code-char
buffer
)))))))
(
end-of-file
(
c
)
(
declare
(
ignore
c
))
nil
))))))
(
defparameter
*link-initial-dword*
76
)
(
defparameter
*link-guid*
#(
1
20
2
0
0
0
0
0
192
0
0
0
0
0
0
70
))
(
defun
read-null-terminated-string
(
s
)
(
with-output-to-string
(
out
)
(
loop
:for
code
=
(
read-byte
s
)
:until
(
zerop
code
)
:do
(
write-char
(
code-char
code
)
out
))))
(
defun
read-little-endian
(
s
&optional
(
bytes
4
))
(
loop
:for
i
:from
0
:below
bytes
:sum
(
ash
(
read-byte
s
)
(
*
8
i
))))
(
defun
parse-file-location-info
(
s
)
(
let
((
start
(
file-position
s
))
(
total-length
(
read-little-endian
s
))
(
end-of-header
(
read-little-endian
s
))
(
fli-flags
(
read-little-endian
s
))
(
local-volume-offset
(
read-little-endian
s
))
(
local-offset
(
read-little-endian
s
))
(
network-volume-offset
(
read-little-endian
s
))
(
remaining-offset
(
read-little-endian
s
)))
(
declare
(
ignore
total-length
end-of-header
local-volume-offset
))
(
unless
(
zerop
fli-flags
)
(
cond
((
logbitp
0
fli-flags
)
(
file-position
s
(
+
start
local-offset
)))
((
logbitp
1
fli-flags
)
(
file-position
s
(
+
start
network-volume-offset
#x14
))))
(
strcat
(
read-null-terminated-string
s
)
(
progn
(
file-position
s
(
+
start
remaining-offset
))
(
read-null-terminated-string
s
))))))
(
defun
parse-windows-shortcut
(
pathname
)
(
with-open-file
(
s
pathname
:element-type
'
(
unsigned-byte
8
))
(
handler-case
(
when
(
and
(
=
(
read-little-endian
s
)
*link-initial-dword*
)
(
let
((
header
(
make-array
(
length
*link-guid*
))))
(
read-sequence
header
s
)
(
equalp
header
*link-guid*
)))
(
let
((
flags
(
read-little-endian
s
)))
(
file-position
s
76
)
;skip rest of header
(
when
(
logbitp
0
flags
)
;; skip shell item id list
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
cond
((
logbitp
1
flags
)
(
parse-file-location-info
s
))
(
t
(
when
(
logbitp
2
flags
)
;; skip description string
(
let
((
length
(
read-little-endian
s
2
)))
(
file-position
s
(
+
length
(
file-position
s
)))))
(
when
(
logbitp
3
flags
)
;; finally, our pathname
(
let*
((
length
(
read-little-endian
s
2
))
(
buffer
(
make-array
length
)))
(
read-sequence
buffer
s
)
(
map
'string
#'
code-char
buffer
)))))))
(
end-of-file
(
c
)
(
declare
(
ignore
c
))
nil
)))))
test/test-utilities.script
View file @
400465c0
...
...
@@ -141,6 +141,10 @@
ASDF/BUNDLE:STATIC-LIBRARY
ASDF/IMAGE:CREATE-IMAGE
ASDF/LISP-BUILD:REIFY-UNDEFINED-WARNING
ASDF/OS:PARSE-FILE-LOCATION-INFO
ASDF/OS:PARSE-WINDOWS-SHORTCUT
ASDF/OS:READ-LITTLE-ENDIAN
ASDF/OS:READ-NULL-TERMINATED-STRING
;; backward compatibility upgrade only
ASDF/BACKWARD-INTERNALS:MAKE-SUB-OPERATION
ASDF/FIND-SYSTEM:CONTRIB-SYSDEF-SEARCH
...
...
upgrade.lisp
View file @
400465c0
...
...
@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(
asdf-version
"2.29.
6
"
)
(
asdf-version
"2.29.
7
"
)
(
existing-version
(
asdf-version
)))
(
setf
*asdf-version*
asdf-version
)
(
when
(
and
existing-version
(
not
(
equal
asdf-version
existing-version
)))
...
...
version.lisp-expr
View file @
400465c0
"2.29.
6
"
"2.29.
7
"
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a 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