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
15
Issues
15
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
19b4935e
Commit
19b4935e
authored
Sep 16, 2016
by
Francois-Rene Rideau
1
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Define and use not-implemented-error and parameter-error
parent
d8aa1757
Changes
5
Hide whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
49 additions
and
9 deletions
+49
-9
find-component.lisp
find-component.lisp
+2
-2
operate.lisp
operate.lisp
+3
-2
uiop/filesystem.lisp
uiop/filesystem.lisp
+1
-1
uiop/image.lisp
uiop/image.lisp
+2
-2
uiop/utility.lisp
uiop/utility.lisp
+41
-2
No files found.
find-component.lisp
View file @
19b4935e
...
...
@@ -125,8 +125,8 @@
(
resolve-dependency-combination
component
(
car
dep-spec
)
(
cdr
dep-spec
)))))
(
defmethod
resolve-dependency-combination
(
component
combinator
arguments
)
(
error
(
compatfmt
"~@<B
ad dependency ~S for ~S~@:>"
)
(
cons
combinator
arguments
)
component
))
(
parameter-error
(
compatfmt
"~@<In ~S, b
ad dependency ~S for ~S~@:>"
)
'resolve-dependency-combination
(
cons
combinator
arguments
)
component
))
(
defmethod
resolve-dependency-combination
(
component
(
combinator
(
eql
:feature
))
arguments
)
(
when
(
featurep
(
first
arguments
))
...
...
operate.lisp
View file @
19b4935e
...
...
@@ -203,8 +203,9 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(
defmethod
resolve-dependency-combination
(
component
(
combinator
(
eql
:require
))
arguments
)
(
unless
(
and
(
length=n-p
arguments
1
)
(
typep
(
car
arguments
)
'
(
or
string
(
and
symbol
(
not
null
)))))
(
error
(
compatfmt
"~@<Bad dependency ~S for ~S. ~S takes one argument, a string or non-null symbol~@:>"
)
(
cons
combinator
arguments
)
component
combinator
))
(
parameter-error
(
compatfmt
"~@<In ~S, bad dependency ~S for ~S. ~S takes one argument, a string or non-null symbol~@:>"
)
'resolve-dependency-combination
(
cons
combinator
arguments
)
component
combinator
))
;; :require must be prepared for some implementations providing modules using ASDF,
;; as SBCL used to do, and others may might do. Thus, the system provided in the end
;; would be a downcased name as per module-provide-asdf above. For the same reason,
...
...
uiop/filesystem.lisp
View file @
19b4935e
...
...
@@ -622,7 +622,7 @@ in an atomic way if the implementation allows."
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:rmdir
directory-pathname
)))
#+
xcl
(
symbol-call
:uiop
:run-program
`
(
"rmdir"
,
(
native-namestring
directory-pathname
)))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmucl
cormanlisp
digitool
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"~S not implemented on ~S"
'delete-empty-directory
(
implementation-type
)
))
; genera
(
not-implemented-error
'delete-empty-directory
"(on your platform)"
))
; genera
(
defun
delete-directory-tree
(
directory-pathname
&key
(
validate
nil
validatep
)
(
if-does-not-exist
:error
))
"Delete a directory including all its recursive contents, aka rm -rf.
...
...
uiop/image.lisp
View file @
19b4935e
...
...
@@ -232,7 +232,7 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die"
#+
sbcl
sb-ext:*posix-argv*
#+
xcl
system:*argv*
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmucl
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"raw-command-line-arguments not implemented yet"
))
(
not-implemented-error
'raw-command-line-arguments
))
(
defun
command-line-arguments
(
&optional
(
arguments
(
raw-command-line-arguments
)))
"Extract user arguments from command-line invocation of current process.
...
...
@@ -422,7 +422,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
;; Is it meaningful to run these in the current environment?
;; only if we also track the object files that constitute the "current" image,
;; and otherwise simulate dump-image, including quitting at the end.
#-
(
or
clasp
ecl
mkcl
)
(
error
"~S not implemented for your implementation (yet)"
'create-image
)
#-
(
or
clasp
ecl
mkcl
)
(
not-implemented-error
'create-image
)
#+
(
or
clasp
ecl
mkcl
)
(
let
((
epilogue-code
(
if
no-uiop
...
...
uiop/utility.lisp
View file @
19b4935e
...
...
@@ -30,10 +30,11 @@
#:list-to-hash-set
#:ensure-gethash
;; hash-table
#:ensure-function
#:access-at
#:access-at-count
;; functions
#:call-function
#:call-functions
#:register-hook-function
#:lexicographic<
#:lexicographic<=
;; version
#:parse-version
#:unparse-version
#:version<
#:version<=
#:version-compatible-p
#:match-condition-p
#:match-any-condition-p
;; conditions
#:call-with-muffled-conditions
#:with-muffled-conditions
#:lexicographic<
#:lexicographic<=
#:parse-version
#:unparse-version
#:version<
#:version<=
#:version-compatible-p
))
;; version
#:not-implemented-error
#:parameter-error
))
(
in-package
:uiop/utility
)
;;;; Defining functions in a way compatible with hot-upgrade:
...
...
@@ -619,3 +620,41 @@ or a string describing the format-control of a simple-condition."
"Shorthand syntax for CALL-WITH-MUFFLED-CONDITIONS"
`
(
call-with-muffled-conditions
#'
(
lambda
()
,@
body
)
,
conditions
)))
;;; Conditions
(
with-upgradability
()
(
define-condition
not-implemented-error
(
error
)
((
functionality
:initarg
:functionality
)
(
format-control
:initarg
:format-control
)
(
format-arguments
:initarg
:format-arguments
))
(
:report
(
lambda
(
condition
stream
)
(
format
stream
"Not implemented: ~s~@[ ~?~]"
(
slot-value
condition
'functionality
)
(
slot-value
condition
'format-control
)
(
slot-value
condition
'format-arguments
)))))
(
defun
not-implemented-error
(
functionality
&optional
format-control
&rest
format-arguments
)
(
error
'not-implemented-error
:functionality
functionality
:format-control
format-control
:format-arguments
format-arguments
))
(
define-condition
parameter-error
(
error
)
((
functionality
:initarg
:functionality
)
(
format-control
:initarg
:format-control
)
(
format-arguments
:initarg
:format-arguments
))
(
:report
(
lambda
(
condition
stream
)
(
apply
'format
stream
(
slot-value
condition
'format-control
)
(
slot-value
condition
'functionality
)
(
slot-value
condition
'format-arguments
)))))
;; Note that functionality MUST be passed as the second argument to parameter-error, just after
;; the format-control. If you want it to not appear in first position in actual message, use
;; ~* and ~:* to adjust parameter order.
(
defun
parameter-error
(
format-control
functionality
&rest
format-arguments
)
(
error
'parameter-error
:functionality
functionality
:format-control
format-control
:format-arguments
format-arguments
)))
François-René Rideau
@frideau
mentioned in merge request
!3 (merged)
·
Sep 16, 2016
mentioned in merge request
!3 (merged)
mentioned in merge request !3
Toggle commit list
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