Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
A
asdf
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
16
Issues
16
List
Boards
Labels
Service Desk
Milestones
Merge Requests
8
Merge Requests
8
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
asdf
asdf
Commits
9259a065
Commit
9259a065
authored
Oct 29, 2010
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
2.147: improve things somewhat for gcl. Merge two u-i-f-r-c methods for smaller output.
parent
69019dda
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
18 additions
and
22 deletions
+18
-22
asdf.lisp
asdf.lisp
+14
-17
test/asdf-pathname-test.script
test/asdf-pathname-test.script
+4
-5
No files found.
asdf.lisp
View file @
9259a065
...
...
@@ -49,6 +49,8 @@
(
cl:in-package
:cl-user
)
#+
gcl
(
defpackage
:asdf
(
:use
:cl
))
;; GCL treats defpackage magically and needs this
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
;;; make package if it doesn't exist yet.
;;; DEFPACKAGE may cause errors on discrepancies, so we avoid it.
...
...
@@ -71,7 +73,7 @@
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
defvar
*asdf-version*
nil
)
(
defvar
*upgraded-p*
nil
)
(
let*
((
asdf-version
"2.14
6
"
)
;; bump this version when you modify this file.
(
let*
((
asdf-version
"2.14
7
"
)
;; bump this version when you modify this file.
(
existing-asdf
(
fboundp
'find-system
))
(
existing-version
*asdf-version*
)
(
already-there
(
equal
asdf-version
existing-version
)))
...
...
@@ -323,19 +325,14 @@
(
when
system-p
(
setf
(
getf
(
slot-value
c
'flags
)
:system-p
)
system-p
)))))
(
when
(
find-class
'module
nil
)
(
eval
'
(
progn
(
defmethod
update-instance-for-redefined-class
:after
((
m
module
)
added
deleted
plist
&key
)
(
declare
(
ignorable
deleted
plist
))
(
when
*asdf-verbose*
(
format
*trace-output*
"Updating ~A~%"
m
))
(
when
(
member
'components-by-name
added
)
(
compute-module-components-by-name
m
)))
(
defmethod
update-instance-for-redefined-class
:after
((
s
system
)
added
deleted
plist
&key
)
(
declare
(
ignorable
deleted
plist
))
(
when
*asdf-verbose*
(
format
*trace-output*
"Updating ~A~%"
s
))
(
when
(
member
'source-file
added
)
(
%set-system-source-file
(
probe-asd
(
component-name
s
)
(
component-pathname
s
))
s
)))))))
'
(
defmethod
update-instance-for-redefined-class
:after
((
m
module
)
added
deleted
plist
&key
)
(
declare
(
ignorable
deleted
plist
))
(
when
*asdf-verbose*
(
format
*trace-output*
"Updating ~A~%"
m
))
(
when
(
member
'components-by-name
added
)
(
compute-module-components-by-name
m
))
(
when
(
and
(
typep
m
'system
)
(
member
'source-file
added
))
(
%set-system-source-file
(
probe-asd
(
component-name
m
)
(
component-pathname
m
))
m
))))))
;;;; -------------------------------------------------------------------------
;;;; User-visible parameters
...
...
@@ -535,11 +532,11 @@ Also, if either argument is NIL, then the other argument is returned unmodified.
(
directory
(
pathname-directory
specified
))
(
directory
(
cond
#-
(
or
sbcl
cmu
)
#-
(
or
sbcl
cmu
scl
)
((
stringp
directory
)
`
(
:absolute
,
directory
)
directory
)
#+
gcl
((
and
(
consp
directory
)
(
stringp
(
first
directory
)))
`
(
:
absolut
e
,@
directory
))
((
and
(
consp
directory
)
(
not
(
member
(
first
directory
)
'
(
:absolute
:relative
)
)))
`
(
:
relativ
e
,@
directory
))
((
or
(
null
directory
)
(
and
(
consp
directory
)
(
member
(
first
directory
)
'
(
:absolute
:relative
))))
directory
)
...
...
test/asdf-pathname-test.script
View file @
9259a065
...
...
@@ -64,7 +64,6 @@
("**;*.*.*"
,(make-pathname :directory (src-dir :wild-inferiors)
:name :wild :type :wild))))
(let ((failures nil)
(systems `(,(make-pathname :directory (src-dir "system1") :name nil :type nil)
,(make-pathname :host "ASDFTEST" :directory '(:absolute "system1"))
...
...
@@ -209,13 +208,12 @@
pathname))
(test-module (module)
(incf directory-count)
(unless #-clisp (probe-file (asdf:component-pathname module))
#+clisp (ext:probe-directory (asdf:component-pathname module))
(unless (asdf::probe-file* (asdf:component-pathname module))
(incf directory-failures)
(push (list (type-of module) (asdf:component-name module)
(translate-if-needed (asdf:component-pathname module))
configuration
(list (when (asdf:component-parent module) (asdf:component-pathname
(asdf:component-parent module)))))
(list (when (asdf:component-parent module) (asdf:component-pathname (asdf:component-parent module)))))
failures)))
(test-file (file)
(incf file-count)
...
...
@@ -280,7 +278,8 @@
(asdf:initialize-output-translations)
(format t "output translations: ~S~%" (asdf::output-translations))
#-(or clisp ecl) ; clisp has problem with the first one having :version :newest
#+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
(progn ; 1- we're testing with unix, are we not?
(assert (equal (asdf::resolve-location '(:home)) (truename (user-homedir-pathname))))
(assert (equal (asdf::resolve-location '("/foo" "bar" "baz")) #p"/foo/bar/baz"))
...
...
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