Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
A
asdf
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Container Registry
Model registry
Operate
Environments
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Didier Verna
asdf
Commits
580e8d1e
Commit
580e8d1e
authored
11 years ago
by
Francois-Rene Rideau
Browse files
Options
Downloads
Patches
Plain Diff
More fixes to issues found with LispWorks.
parent
30b84e80
No related branches found
No related tags found
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
bin/install-asdf-as-module
+1
-2
1 addition, 2 deletions
bin/install-asdf-as-module
uiop/image.lisp
+1
-0
1 addition, 0 deletions
uiop/image.lisp
uiop/pathname.lisp
+23
-25
23 additions, 25 deletions
uiop/pathname.lisp
with
25 additions
and
27 deletions
bin/install-asdf-as-module
+
1
−
2
View file @
580e8d1e
...
...
@@ -57,8 +57,7 @@ It notably doesn't work on:
(defun install-asdf-as-module ()
(let ((fasl (asdf-module-fasl)))
(ensure-directories-exist (translate-logical-pathname fasl))
(handler-bind ((warning #'muffle-warning))
(compile-file* (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl))))
(compile-file (subpathname *asdf-dir* "build/asdf.lisp") :output-file fasl)))
(trace compile-file*)
(install-asdf-as-module)
This diff is collapsed.
Click to expand it.
uiop/image.lisp
+
1
−
0
View file @
580e8d1e
...
...
@@ -242,6 +242,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
"Extract user arguments from command-line invocation of current process.
Assume the calling conventions of a generated script that uses --
if we are not called from a directly executable image."
(
declare
(
ignorable
arguments
))
#+
abcl
arguments
;; LispWorks command-line processing isn't transparent to the user, and
;; we need to rely on cl-launch or some other script to set it for us.
...
...
This diff is collapsed.
Click to expand it.
uiop/pathname.lisp
+
23
−
25
View file @
580e8d1e
...
...
@@ -544,6 +544,25 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
;; scheme-specific parts: port username password, not others:
.
#.
(
or
#+
scl
'
(
:parameters
nil
:query
nil
:fragment
nil
))))
(
defun
ensure-absolute-pathname
(
path
&optional
defaults
(
on-error
'error
))
"Given a pathname designator PATH, return an absolute pathname as specified by PATH
considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior,
with a format control-string and other arguments as arguments"
(
cond
((
absolute-pathname-p
path
))
((
stringp
path
)
(
ensure-absolute-pathname
(
pathname
path
)
defaults
on-error
))
((
not
(
pathnamep
path
))
(
call-function
on-error
"not a valid pathname designator ~S"
path
))
((
let
((
default-pathname
(
if
(
pathnamep
defaults
)
defaults
(
call-function
defaults
))))
(
or
(
if
(
absolute-pathname-p
default-pathname
)
(
absolute-pathname-p
(
merge-pathnames*
path
default-pathname
))
(
call-function
on-error
"Default pathname ~S is not an absolute pathname"
default-pathname
))
(
call-function
on-error
"Failed to merge ~S with ~S into an absolute pathname"
path
default-pathname
))))
(
t
(
call-function
on-error
"Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S"
path
defaults
))))
(
defun
subpathp
(
maybe-subpath
base-pathname
)
"if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
...
...
@@ -558,11 +577,9 @@ when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPA
(
defun
enough-pathname
(
maybe-subpath
base-pathname
)
"if MAYBE-SUBPATH is a pathname that is under BASE-PATHNAME, return a pathname object that
when used with MERGE-PATHNAMES* with defaults BASE-PATHNAME, returns MAYBE-SUBPATH."
(
check-type
maybe-subpath
(
or
null
pathname
))
(
check-type
base-pathname
(
or
null
pathname
))
(
when
(
pathnamep
base-pathname
)
(
assert
(
absolute-pathname-p
base-pathname
)))
(
or
(
and
base-pathname
(
subpathp
maybe-subpath
base-pathname
))
maybe-subpath
))
(
let
((
sub
(
when
maybe-subpath
(
pathname
maybe-subpath
)))
(
base
(
when
base-pathname
(
ensure-absolute-pathname
(
pathname
base-pathname
)))))
(
or
(
and
base
(
subpathp
sub
base
))
sub
)))
(
defun
call-with-enough-pathname
(
maybe-subpath
defaults-pathname
thunk
)
"In a context where *DEFAULT-PATHNAME-DEFAULTS* is bound to DEFAULTS-PATHNAME (if not null,
...
...
@@ -576,26 +593,7 @@ given DEFAULTS-PATHNAME as a base pathname."
(
defaults
*default-pathname-defaults*
))
&body
body
)
"Shorthand syntax for CALL-WITH-ENOUGH-PATHNAME"
`
(
call-with-enough-pathname
,
pathname
,
defaults
#'
(
lambda
(
,
pathname-var
)
,@
body
)))
(
defun
ensure-absolute-pathname
(
path
&optional
defaults
(
on-error
'error
))
"Given a pathname designator PATH, return an absolute pathname as specified by PATH
considering the DEFAULTS, or, if not possible, use CALL-FUNCTION on the specified ON-ERROR behavior,
with a format control-string and other arguments as arguments"
(
cond
((
absolute-pathname-p
path
))
((
stringp
path
)
(
ensure-absolute-pathname
(
pathname
path
)
defaults
on-error
))
((
not
(
pathnamep
path
))
(
call-function
on-error
"not a valid pathname designator ~S"
path
))
((
let
((
default-pathname
(
if
(
pathnamep
defaults
)
defaults
(
call-function
defaults
))))
(
or
(
if
(
absolute-pathname-p
default-pathname
)
(
absolute-pathname-p
(
merge-pathnames*
path
default-pathname
))
(
call-function
on-error
"Default pathname ~S is not an absolute pathname"
default-pathname
))
(
call-function
on-error
"Failed to merge ~S with ~S into an absolute pathname"
path
default-pathname
))))
(
t
(
call-function
on-error
"Cannot ensure ~S is evaluated as an absolute pathname with defaults ~S"
path
defaults
)))))
`
(
call-with-enough-pathname
,
pathname
,
defaults
#'
(
lambda
(
,
pathname-var
)
,@
body
))))
;;; Wildcard pathnames
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
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!
Save comment
Cancel
Please
register
or
sign in
to comment