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
Karsten Poeck
asdf
Commits
6230c63d
Commit
6230c63d
authored
Dec 17, 2016
by
Francois-Rene Rideau
Browse files
UIOP: use parameter-error & not-implemented-error
parent
81e4f08d
Changes
8
Hide whitespace changes
Inline
Side-by-side
uiop/filesystem.lisp
View file @
6230c63d
...
...
@@ -209,9 +209,10 @@ but the behavior in presence of symlinks is not portable. Use IOlib to handle su
;; logical pathnames have restrictions on wild patterns.
;; Not that the results are very portable when you use these patterns on physical pathnames.
(
when
(
wild-pathname-p
dir
)
(
error
"Invalid wild pattern in logical directory ~S"
directory
))
(
parameter-error
"~S: Invalid wild pattern in logical directory ~S"
'directory-files
directory
))
(
unless
(
member
(
pathname-directory
pattern
)
'
(()
(
:relative
))
:test
'equal
)
(
error
"Invalid file pattern ~S for logical directory ~S"
pattern
directory
))
(
parameter-
error
"
~S:
Invalid file pattern ~S for logical directory ~S"
'directory-files
pattern
directory
))
(
setf
pattern
(
make-pathname-logical
pattern
(
pathname-host
dir
))))
(
let*
((
pat
(
merge-pathnames*
pattern
dir
))
(
entries
(
ignore-errors
(
directory*
pat
))))
...
...
@@ -524,7 +525,7 @@ check constraints and normalize as per ENSURE-PATHNAME."
check constraints and normalize each one as per ENSURE-PATHNAME.
Any empty entries in the environment variable X will be returned as NILs."
(
unless
(
getf
constraints
:empty-is-nil
t
)
(
error
"Cannot have EMPTY-IS-NIL false for
GETENV-PATHNAMES."
))
(
parameter-
error
"Cannot have EMPTY-IS-NIL false for
~S"
'getenv-pathnames
))
(
apply
'split-native-pathnames-string
(
getenvp
x
)
:on-error
(
or
on-error
`
(
error
"In (~S ~S), invalid pathname ~*~S: ~*~?"
getenv-pathnames
,
x
))
...
...
@@ -641,13 +642,13 @@ If you're suicidal or extremely confident, just use :VALIDATE T."
(
cond
((
not
(
and
(
pathnamep
directory-pathname
)
(
directory-pathname-p
directory-pathname
)
(
physical-pathname-p
directory-pathname
)
(
not
(
wild-pathname-p
directory-pathname
))))
(
error
"~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"
(
parameter-
error
"~S was asked to delete ~S but it is not a physical non-wildcard directory pathname"
'delete-directory-tree
directory-pathname
))
((
not
validatep
)
(
error
"~S was asked to delete ~S but was not provided a validation predicate"
(
parameter-
error
"~S was asked to delete ~S but was not provided a validation predicate"
'delete-directory-tree
directory-pathname
))
((
not
(
call-function
validate
directory-pathname
))
(
error
"~S was asked to delete ~S but it is not valid ~@[according to ~S~]"
(
parameter-
error
"~S was asked to delete ~S but it is not valid ~@[according to ~S~]"
'delete-directory-tree
directory-pathname
validate
))
((
not
(
directory-exists-p
directory-pathname
))
(
ecase
if-does-not-exist
...
...
uiop/image.lisp
View file @
6230c63d
...
...
@@ -78,7 +78,7 @@ This is designed to abstract away the implementation specific quit forms."
(
exit
`
(
,
exit
:code
code
:abort
(
not
finish-output
)))
(
quit
`
(
,
quit
:unix-status
code
:recklessly-p
(
not
finish-output
)))))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmucl
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"~S called with exit code ~S but there's no quitting on this implementation"
'quit
code
))
(
not-implemented-error
'quit
"(called with exit code ~S)"
code
))
(
defun
die
(
code
format
&rest
arguments
)
"Die in error with some error message"
...
...
@@ -352,7 +352,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
(
setf
*image-restored-p*
nil
)
#-
(
or
clisp
clozure
(
and
cmucl
executable
)
lispworks
sbcl
scl
)
(
when
executable
(
error
"Dumping an executable is not supported on this implementation! Aborting.
"
))
(
not-implemented-error
'dump-image
"dumping an executable
"
))
#+
allegro
(
progn
(
sys:resize-areas
:global-gc
t
:pack-heap
t
:sift-old-areas
t
:tenure
t
)
; :new 5000000
...
...
@@ -410,8 +410,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows."
;; the default is :console - only works with SBCL 1.1.15 or later.
(
when
application-type
(
list
:application-type
application-type
)))))
#-
(
or
allegro
clisp
clozure
cmucl
gcl
lispworks
sbcl
scl
)
(
error
"Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%"
'dump-image
filename
(
nth-value
1
(
implementation-type
))))
(
not-implemented-error
'dump-image
))
(
defun
create-image
(
destination
lisp-object-files
&key
kind
output-name
prologue-code
epilogue-code
extra-object-files
...
...
uiop/launch-program.lisp
View file @
6230c63d
...
...
@@ -26,7 +26,8 @@ as either a recognizing function or a sequence of characters."
(
some
(
cond
((
and
good-chars
bad-chars
)
(
error
"only one of good-chars and bad-chars can be provided"
))
(
parameter-error
"~S: only one of good-chars and bad-chars can be provided"
'requires-escaping-p
))
((
typep
good-chars
'function
)
(
complement
good-chars
))
((
typep
bad-chars
'function
)
...
...
@@ -35,7 +36,7 @@ as either a recognizing function or a sequence of characters."
#'
(
lambda
(
c
)
(
not
(
find
c
good-chars
))))
((
and
bad-chars
(
typep
bad-chars
'sequence
))
#'
(
lambda
(
c
)
(
find
c
bad-chars
)))
(
t
(
error
"requires-escaping-p
: no good-char criterion"
)))
(
t
(
parameter-error
"~S
: no good-char criterion"
'requires-escaping-p
)))
token
))
(
defun
escape-token
(
token
&key
stream
quote
good-chars
bad-chars
escaper
)
...
...
uiop/lisp-build.lisp
View file @
6230c63d
...
...
@@ -771,8 +771,7 @@ it will filter them appropriately."
(
defun
combine-fasls
(
inputs
output
)
"Combine a list of FASLs INPUTS into a single FASL OUTPUT"
#-
(
or
abcl
allegro
clisp
clozure
cmucl
lispworks
sbcl
scl
xcl
)
(
error
"~A does not support ~S~%inputs ~S~%output ~S"
(
implementation-type
)
'combine-fasls
inputs
output
)
(
not-implemented-error
'combine-fasls
"~%inputs: ~S~%output: ~S"
inputs
output
)
#+
abcl
(
funcall
'sys::concatenate-fasls
inputs
output
)
; requires ABCL 1.2.0
#+
(
or
allegro
clisp
cmucl
sbcl
scl
xcl
)
(
concatenate-files
inputs
output
)
#+
clozure
(
ccl:fasl-concatenate
output
inputs
:if-exists
:supersede
)
...
...
uiop/os.lisp
View file @
6230c63d
...
...
@@ -29,7 +29,7 @@ keywords explicitly."
((
eq
:not
(
car
x
))
(
assert
(
null
(
cddr
x
)))
(
not
(
featurep
(
cadr
x
))))
((
eq
:or
(
car
x
))
(
some
#'
featurep
(
cdr
x
)))
((
eq
:and
(
car
x
))
(
every
#'
featurep
(
cdr
x
)))
(
t
(
error
"
M
alformed feature specification ~S"
x
))))
(
t
(
parameter-
error
"
~S: m
alformed feature specification ~S"
'featurep
x
))))
;; Starting with UIOP 3.1.5, these are runtime tests.
;; You may bind *features* with a copy of what your target system offers to test its properties.
...
...
@@ -112,7 +112,7 @@ use getenvp to return NIL in such a case."
#+
mkcl
(
#.
(
or
(
find-symbol*
'getenv
:si
nil
)
(
find-symbol*
'getenv
:mk-ext
nil
))
x
)
#+
sbcl
(
sb-ext:posix-getenv
x
)
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmucl
cormanlisp
ecl
gcl
genera
lispworks
mcl
mkcl
sbcl
scl
xcl
)
(
error
"~S is not supported on your
implement
ation"
'getenv
))
(
not-
implement
ed-error
'getenv
))
(
defsetf
getenv
(
x
)
(
val
)
"Set an environment variable."
...
...
@@ -126,7 +126,7 @@ use getenvp to return NIL in such a case."
#+
mkcl
`
(
mkcl:setenv
,
x
,
val
)
#+
sbcl
`
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:setenv
,
x
,
val
1
))
#-
(
or
allegro
clisp
clozure
cmucl
ecl
lispworks
mkcl
sbcl
)
'
(
error
"~S ~S is not supported on your
implement
ation"
'setf
'
getenv
))
'
(
not-
implement
ed-error
'
(
setf
getenv
))
)
(
defun
getenvp
(
x
)
"Predicate that is true if the named variable is present in the libc environment,
...
...
@@ -288,7 +288,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+
mkcl
(
mk-ext:getcwd
)
#+
sbcl
(
sb-ext:parse-native-namestring
(
sb-unix:posix-getcwd/
))
#+
xcl
(
extensions:current-directory
)
(
error
"getcwd not supported on your implementation"
)))
(
not-implemented-error
'getcwd
)))
(
defun
chdir
(
x
)
"Change current directory, as per POSIX chdir(2), to a given pathname object"
...
...
@@ -306,7 +306,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+
mkcl
(
mk-ext:chdir
x
)
#+
sbcl
(
progn
(
require
:sb-posix
)
(
symbol-call
:sb-posix
:chdir
(
sb-ext:native-namestring
x
)))
#-
(
or
abcl
allegro
clasp
clisp
clozure
cmucl
cormanlisp
ecl
gcl
genera
lispworks
mkcl
sbcl
scl
xcl
)
(
error
"chdir not supported on your implementation"
))))
(
not-implemented-error
'chdir
))))
;;;; -----------------------------------------------------------------
...
...
uiop/pathname.lisp
View file @
6230c63d
...
...
@@ -56,7 +56,8 @@ that is a list and not a string."
((
consp
directory
)
(
cons
:relative
directory
))
(
t
(
error
(
compatfmt
"~@<Unrecognized pathname directory component ~S~@:>"
)
directory
))))
(
parameter-error
(
compatfmt
"~@<~S: Unrecognized pathname directory component ~S~@:>"
)
'normalize-pathname-directory-component
directory
))))
(
defun
denormalize-pathname-directory-component
(
directory-component
)
"Convert the DIRECTORY-COMPONENT from a CLHS-standard format to a format usable
...
...
@@ -487,7 +488,8 @@ or if it is a PATHNAME but some of its components are not recognized."
((
or
null
string
)
pathname
)
(
pathname
(
with-output-to-string
(
s
)
(
flet
((
err
()
#+
lispworks
(
describe
pathname
)
(
error
"Not a valid unix-namestring ~S"
pathname
)))
(
flet
((
err
()
(
parameter-error
"~S: invalid unix-namestring ~S"
'unix-namestring
pathname
)))
(
let*
((
dir
(
normalize-pathname-directory-component
(
pathname-directory
pathname
)))
(
name
(
pathname-name
pathname
))
(
name
(
and
(
not
(
eq
name
:unspecific
))
name
))
...
...
@@ -721,7 +723,7 @@ In that last case, if ROOT is non-NIL, PATH is first transformated by DIRECTORIZ
((
eq
destination
t
)
path
)
((
not
(
pathnamep
destination
))
(
error
"Invalid destination"
))
(
parameter-
error
"
~S:
Invalid destination"
'translate-pathname*
))
((
not
(
absolute-pathname-p
destination
))
(
translate-pathname
path
absolute-source
(
merge-pathnames*
destination
root
)))
(
root
...
...
uiop/run-program.lisp
View file @
6230c63d
...
...
@@ -117,7 +117,7 @@ Programmers are encouraged to define their own methods for this generic function
stream
x
:linewise
linewise
:prefix
prefix
:element-type
element-type
:buffer-size
buffer-size
))
(
t
(
error
"Invalid ~S destination ~S"
'slurp-input-stream
x
)))))
(
parameter-
error
"Invalid ~S destination ~S"
'slurp-input-stream
x
)))))
;;;; Vomiting a stream, typically into the input of another program.
(
with-upgradability
()
...
...
@@ -194,7 +194,7 @@ Programmers are encouraged to define their own methods for this generic function
x
stream
:linewise
linewise
:prefix
prefix
:element-type
element-type
:buffer-size
buffer-size
))
(
t
(
error
"Invalid ~S source ~S"
'vomit-output-stream
x
)))))
(
parameter-
error
"Invalid ~S source ~S"
'vomit-output-stream
x
)))))
;;;; Run-program: synchronously run a program in a subprocess, handling input, output and error-output.
...
...
@@ -250,8 +250,8 @@ or whether it's already taken care of by the implementation's underlying run-pro
(
activity-spec
(
if
(
eq
actual-spec
:output
)
(
ecase
direction
((
:input
:output
)
(
error
"~S not allow
ed
as a ~S
~S
spec"
:output
'run-program
direction
))
(
parameter-
error
"~S
does
not allow
~S
as a ~S spec"
'run-program
:output
direction
))
((
:error-output
)
nil
))
actual-spec
)))
...
...
uiop/utility.lisp
View file @
6230c63d
...
...
@@ -611,7 +611,8 @@ or a string describing the format-control of a simple-condition."
(
format-control
:initarg
:format-control
)
(
format-arguments
:initarg
:format-arguments
))
(
:report
(
lambda
(
condition
stream
)
(
format
stream
"Not implemented: ~s~@[ ~?~]"
(
format
stream
"Not (currently) implemented on ~A: ~S~@[ ~?~]"
(
nth-value
1
(
symbol-call
:uiop
:implementation-type
))
(
slot-value
condition
'functionality
)
(
slot-value
condition
'format-control
)
(
slot-value
condition
'format-arguments
)))))
...
...
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