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
9
Merge Requests
9
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
3c1c01eb
Commit
3c1c01eb
authored
Nov 18, 2013
by
Francois-Rene Rideau
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More tweaks and cleanups for GCL.
parent
32c1e741
Changes
9
Hide whitespace changes
Inline
Side-by-side
Showing
9 changed files
with
55 additions
and
56 deletions
+55
-56
test/asdf-pathname-test.script
test/asdf-pathname-test.script
+0
-5
test/run-tests.sh
test/run-tests.sh
+1
-4
test/script-support.lisp
test/script-support.lisp
+0
-1
test/test-system-pathnames.script
test/test-system-pathnames.script
+9
-7
uiop/common-lisp.lisp
uiop/common-lisp.lisp
+11
-2
uiop/filesystem.lisp
uiop/filesystem.lisp
+29
-20
uiop/lisp-build.lisp
uiop/lisp-build.lisp
+3
-3
uiop/os.lisp
uiop/os.lisp
+1
-1
uiop/package.lisp
uiop/package.lisp
+1
-13
No files found.
test/asdf-pathname-test.script
View file @
3c1c01eb
...
...
@@ -5,8 +5,6 @@
;;(setf *unspecific-pathname-type* nil)
#+gcl (trace compile-file-pathname*)
;;; test asdf pathname specifications
;;;
;;; Originally written by James Anderson, refactored by Francois-Rene Rideau
...
...
@@ -332,7 +330,6 @@
(delete-host t)
(support-string-pathnames nil)
(support-absolute-string-pathnames nil))
#+gcl (format t "root: ~S~%" root)
(unwind-protect
(let ((root-directory-namestring (format nil "~{/~a~}/" (rest (pathname-directory root))))
(test-status (setf *test-status* (make-instance 'test-status)))
...
...
@@ -399,7 +396,6 @@
(asdf:initialize-output-translations)
(format t "output translations: ~S~%" (asdf::output-translations))
#+gcl (format t "~&~A~&" (progn (defvar *x* -1) (incf *x*)))
#-xcl ;;---*** pathnames are known to be massively broken on XCL
(progn
;; we're testing with unix, are we not?
...
...
@@ -408,7 +404,6 @@
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t) #p"/foo/bar/baz/")
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t :wilden t) (wilden #p"/foo/bar/baz/"))
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory nil :wilden t) (wilden #p"/foo/bar/"))
#-gcl
(assert-pathname-equal (resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :ensure-directory nil :wilden t) #p"/foo/bar/**/baz/*.*")
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-1))))
...
...
test/run-tests.sh
View file @
3c1c01eb
...
...
@@ -12,7 +12,7 @@ usage () {
echo
" - quit with exit status >0 if an unhandled error occurs"
echo
" you need to supply the .script in the second argument"
echo
" lisps include abcl, allegro, allegromodern, ccl (clozure),"
echo
" clisp, cmucl, ecl, gcl,
gclcvs,
sbcl, scl and xcl."
echo
" clisp, cmucl, ecl, gcl, sbcl, scl and xcl."
echo
"OPTIONS:"
echo
" -d -- debug mode"
echo
" -h -- show this message."
...
...
@@ -422,9 +422,6 @@ test_clean_load () {
fi
}
test_load_systems
()
{
case
$lisp
in
gcl
)
return
0
;;
# This one is hopeless
esac
cd
${
ASDFDIR
}
mkdir
-p
build/results/
echo
"Loading all these systems:
$*
"
...
...
test/script-support.lisp
View file @
3c1c01eb
...
...
@@ -561,7 +561,6 @@ is bound, write a message and exit on an error. If
(
register-directory
*asdf-directory*
)
(
register-directory
*uiop-directory*
)
(
register-directory
*test-directory*
)
(
DBG
:lalatu
(
asymval
:*central-registry*
))
(
quietly
(
acall
:oos
(
asym
:load-op
)
:uiop
))
(
acall
:oos
(
asym
:load-op
)
:test-module-depend
))
...
...
test/test-system-pathnames.script
View file @
3c1c01eb
...
...
@@ -9,22 +9,24 @@
(:static-file "level2/static.file")
(:static-file "test-tmp.cl")))
(DBG "loading test-system-pathnames")
(load-system 'test-system-pathnames)
(DBG "checking that test-system-pathnames loaded properly")
(assert (find-package :test-package)
() "package test-package not found")
(assert (find-symbol
(symbol-name '*file-tmp*) :test-package
)
(assert (find-symbol
* '*file-tmp* :test-package nil
)
() "symbol `*file-tmp*` not found")
(assert (symbol-value (find-symbol
(symbol-name '*file-tmp*)
:test-package))
(assert (symbol-value (find-symbol
* '*file-tmp*
:test-package))
() "symbol `*file-tmp*` has wrong value")
(assert (probe-file (test-fasl "sources/level1/file1"))
(assert (probe-file
*
(test-fasl "sources/level1/file1"))
() "compiled file not found")
(assert (find-symbol
(symbol-name '*file-tmp2*) :test-package) nil
"symbol `*file-tmp2*` not found")
(assert (symbol-value (find-symbol
(symbol-name '*file-tmp2*) :test-package)
)
(assert (find-symbol
* '*file-tmp2* :test-package nil)
()
"symbol `*file-tmp2*` not found")
(assert (symbol-value (find-symbol
* '*file-tmp2* :test-package
)
() "symbol `*file-tmp2*` has wrong value")
(assert (probe-file (test-fasl "sources/level1/level2/file2"))
(assert (probe-file
*
(test-fasl "sources/level1/level2/file2"))
() "compiled file not found")
uiop/common-lisp.lisp
View file @
3c1c01eb
...
...
@@ -80,12 +80,21 @@
(
defun
use-ecl-byte-compiler-p
()
(
and
(
member
:ecl-bytecmp
*features*
)
t
))
(
unless
(
use-ecl-byte-compiler-p
)
(
require
:cmp
)))
#+
gcl
;; Debian's GCL 2.7 has bugs with compiling multiple-value stuff, but can run ASDF 2.011
#+
gcl
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
(
unless
(
member
:ansi-cl
*features*
)
(
error
"ASDF only supports GCL in ANSI mode. Aborting.~%"
))
(
setf
compiler::*compiler-default-type*
(
pathname
""
)
compiler::*lsp-ext*
""
))
compiler::*lsp-ext*
""
)
#.
(
let
((
code
;; Only support very recent GCL 2.7.0 from November 2013 or later.
(
cond
#+
gcl
((
or
(
<
system::*gcl-major-version*
2
)
(
and
(
=
system::*gcl-major-version*
2
)
(
<
system::*gcl-minor-version*
7
)))
'
(
error
"GCL 2.7 or later required to use ASDF"
)))))
(
eval
code
)
code
))
#+
genera
(
eval-when
(
:load-toplevel
:compile-toplevel
:execute
)
...
...
uiop/filesystem.lisp
View file @
3c1c01eb
...
...
@@ -65,8 +65,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
(
defun
truename*
(
p
)
"Nicer variant of TRUENAME that plays well with NIL and avoids logical pathname contexts"
;; avoids both logical-pathname merging and physical resolution issues
(
and
p
(
handler-case
(
with-pathname-defaults
()
(
truename
p
))
(
#-
gcl
file-error
#+
gcl
error
()
nil
))))
(
and
p
(
handler-case
(
with-pathname-defaults
()
(
truename
p
))
(
file-error
()
nil
))))
(
defun
safe-file-write-date
(
pathname
)
"Safe variant of FILE-WRITE-DATE that may return NIL rather than raise an error."
...
...
@@ -97,24 +96,26 @@ or the original (parsed) pathname if it is false (the default)."
(
or
#+
allegro
(
probe-file
p
:follow-symlinks
truename
)
#
-
(
or
allegro
clisp
)
#
+
gcl
(
if
truename
(
probe-file
p
)
(
ignore-errors
(
let
((
pp
(
physicalize-pathname
p
)))
(
and
#+
(
or
cmu
scl
)
(
unix:unix-stat
(
ext:unix-namestring
pp
))
#+
(
and
lispworks
unix
)
(
system:get-file-stat
pp
)
#+
sbcl
(
sb-unix:unix-stat
(
sb-ext:native-namestring
pp
))
#-
(
or
cmu
(
and
lispworks
unix
)
sbcl
scl
)
(
file-write-date
pp
)
p
))))
#+
(
or
clisp
gcl
)
(
truename*
p
)
(
let
((
kind
(
car
(
si::stat
p
))))
(
when
(
eq
kind
:link
)
(
setf
kind
(
ignore-errors
(
car
(
si::stat
(
truename*
p
))))))
(
ecase
kind
((
nil
)
nil
)
((
:file
:link
)
(
cond
((
file-pathname-p
p
)
p
)
((
directory-pathname-p
p
)
(
subpathname
p
(
car
(
last
(
pathname-directory
p
)))))))
(
:directory
(
ensure-directory-pathname
p
)))))
#+
clisp
#.
(
flet
((
probe
(
probe
)
`
(
let
((
foundtrue
,
probe
))
(
cond
(
truename
foundtrue
)
(
foundtrue
p
)))))
#+
clisp
(
let*
((
fs
(
find-symbol*
'
#:file-stat
:posix
nil
))
(
pp
(
find-symbol*
'
#:probe-pathname
:ext
nil
))
(
resolve
(
if
pp
...
...
@@ -125,11 +126,19 @@ or the original (parsed) pathname if it is false (the default)."
`
(
if
truename
,
resolve
(
and
(
ignore-errors
(
,
fs
p
))
p
))
(
probe
resolve
)))
#+
gcl
(
probe
'
(
or
(
probe-file
p
)
(
truename*
(
ensure-directory-pathname
p
))))))
(
#-
gcl
file-error
#+
gcl
error
()
nil
)))))))
(
probe
resolve
))))
#-
(
or
allegro
clisp
gcl
)
(
if
truename
(
probe-file
p
)
(
ignore-errors
(
let
((
pp
(
physicalize-pathname
p
)))
(
and
#+
(
or
cmu
scl
)
(
unix:unix-stat
(
ext:unix-namestring
pp
))
#+
(
and
lispworks
unix
)
(
system:get-file-stat
pp
)
#+
sbcl
(
sb-unix:unix-stat
(
sb-ext:native-namestring
pp
))
#-
(
or
cmu
(
and
lispworks
unix
)
sbcl
scl
)
(
file-write-date
pp
)
p
)))))
(
file-error
()
nil
)))))))
(
defun
directory-exists-p
(
x
)
"Is X the name of a directory that exists on the filesystem?"
...
...
@@ -533,7 +542,7 @@ in an atomic way if the implementation allows."
(
defun
delete-file-if-exists
(
x
)
"Delete a file X if it already exists"
(
when
x
(
handler-case
(
delete-file
x
)
(
#-
gcl
file-error
#+
gcl
error
()
nil
))))
(
when
x
(
handler-case
(
delete-file
x
)
(
file-
error
()
nil
))))
(
defun
delete-empty-directory
(
directory-pathname
)
"Delete an empty directory"
...
...
uiop/lisp-build.lisp
View file @
3c1c01eb
...
...
@@ -572,7 +572,7 @@ possibly in a different process. Otherwise just call THUNK."
(
defun
load-pathname
()
"Portably return the LOAD-PATHNAME of the current source file or fasl"
*load-pathname*
)
;;
see magic for GCL in uiop/common-lisp
*load-pathname*
)
;;
magic no longer needed for GCL.
(
defun
lispize-pathname
(
input-file
)
"From a INPUT-FILE pathname, return a corresponding .lisp source pathname"
...
...
@@ -591,7 +591,7 @@ possibly in a different process. Otherwise just call THUNK."
(
defun
compile-file-pathname*
(
input-file
&rest
keys
&key
output-file
&allow-other-keys
)
"Variant of COMPILE-FILE-PATHNAME that works well with COMPILE-FILE*"
(
let*
((
keys
(
remove-plist-keys
`
(
#+
(
or
(
and
allegro
(
not
(
version>=
8
2
)))
gcl
)
:external-format
(
remove-plist-keys
`
(
#+
(
or
(
and
allegro
(
not
(
version>=
8
2
))))
:external-format
,@
(
unless
output-file
'
(
:output-file
)))
keys
)))
(
if
(
absolute-pathname-p
output-file
)
;; what cfp should be doing, w/ mp* instead of mp
...
...
@@ -629,7 +629,7 @@ it will filter them appropriately."
'compile-file*
output-file
object-file
)
(
rotatef
output-file
object-file
))
(
let*
((
keywords
(
remove-plist-keys
`
(
:output-file
:compile-check
:warnings-file
#+
gcl
:external-format
`
(
:output-file
:compile-check
:warnings-file
#+
clisp
:lib-file
#+
(
or
ecl
mkcl
)
:object-file
)
keys
))
(
output-file
(
or
output-file
...
...
uiop/os.lisp
View file @
3c1c01eb
...
...
@@ -255,7 +255,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(
strcat
(
nth-value
1
(
unix:unix-current-directory
))
"/"
))
#+
cormanlisp
(
pathname
(
pl::get-current-directory
))
;; Q: what type does it return?
#+
ecl
(
ext:getcwd
)
#+
gcl
(
let
((
*default-pathname-defaults*
#p""
))
(
truename
#p""
))
#+
gcl
(
let
((
*default-pathname-defaults*
*nil-pathname*
))
(
truename
*nil-pathname*
))
#+
genera
*default-pathname-defaults*
;; on a Lisp OS, it *is* canonical!
#+
lispworks
(
system:current-directory
)
#+
mkcl
(
mk-ext:getcwd
)
...
...
uiop/package.lisp
View file @
3c1c01eb
...
...
@@ -749,19 +749,7 @@ UNINTERN -- Remove symbols here from PACKAGE."
#+
allegro
;; We need to disable autoloading BEFORE any mention of package ASDF.
(
setf
excl::*autoload-package-name-alist*
(
remove
"asdf"
excl::*autoload-package-name-alist*
:test
'equalp
:key
'car
))
#.
(
progn
;; What more, the compiler doesn't look like it's doing eval-when quite like we'd like,
;; so we do this essential feature thing at read-time instead.
#+
gcl
;; Only support very recent GCL 2.7.0 from November 2013 or later.
(
let
((
code
;; Old ASDF 2.011 might run on GCL 2.7.0. Or not.
(
cond
((
or
(
<
system::*gcl-major-version*
2
)
(
and
(
=
system::*gcl-major-version*
2
)
(
<
system::*gcl-minor-version*
7
)))
'
(
error
"GCL 2.7 or later required to use ASDF"
)))))
(
eval
code
)
code
)))
:test
'equalp
:key
'car
)))
;; Compatibility with whoever calls asdf/package
(
define-package
:asdf/package
(
:use
:cl
:uiop/package
)
(
:reexport
:uiop/package
))
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