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
asdf
asdf
Commits
2c49dbc7
Commit
2c49dbc7
authored
Jan 14, 2013
by
Francois-Rene Rideau
Browse files
2.26.98: more portability fixes for GCL.
parent
27472551
Changes
9
Hide whitespace changes
Inline
Side-by-side
compatibility.lisp
View file @
2c49dbc7
...
...
@@ -13,6 +13,7 @@
#:logical-pathname
#:translate-logical-pathname
#:make-broadcast-stream
#:file-namestring
)
#+
ecl
(
:export
#:use-ecl-byte-compiler-p
)
;;#+gcl (:shadow #:type-of #:with-standard-io-syntax) ; causes errors when loading fasl(!)
#+
genera
(
:import-from
:scl
#:boolean
)
#+
genera
(
:export
#:boolean
#:ensure-directories-exist
)
#+
mcl
(
:export
#:probe-posix
#:current-user-homedir-pathname
)
...
...
@@ -52,9 +53,9 @@
(
when
(
or
(
<
system::*gcl-major-version*
2
)
;; GCL 2.6 lacks output-translations and more.
(
and
(
=
system::*gcl-major-version*
2
)
(
<
system::*gcl-minor-version*
7
)))
(
format
t
"Detected an old GCL 2.6. Only limited functionality available.~%"
)
(
shadow
'type-of
:asdf/compatibility
)
(
export
'with-standard-io-syntax
)
;;(shadow 'with-standard-io-syntax :asdf/compatibility)
;;(format t "Detected an old GCL 2.6. Only limited functionality available.~%")
(
pushnew
'ignorable
pcl::*variable-declarations-without-argument*
)
(
pushnew
:gcl<2.7
*features*
))
(
unless
(
member
:ansi-cl
*features*
)
...
...
footer.lisp
View file @
2c49dbc7
...
...
@@ -7,7 +7,7 @@
:asdf/find-system
:asdf/find-component
:asdf/operation
:asdf/action
:asdf/lisp-action
:asdf/operate
:asdf/bundle
:asdf/concatenate-source
:asdf/output-translations
:asdf/source-registry
:asdf/backward-internals
:asdf/defsystem
:asdf/backward-interface
:asdf/interface
))
:asdf/backward-internals
:asdf/defsystem
:asdf/backward-interface
))
(
in-package
:asdf/footer
)
;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
...
...
os.lisp
View file @
2c49dbc7
...
...
@@ -281,8 +281,7 @@ then returning the non-empty string value of the variable"
(
defun
setup-temporary-directory
()
(
setf
*temporary-directory*
(
default-temporary-directory
))
;; basic lack fixed after gcl 2.7.0-61, but ending / required still on 2.7.0-64.1
#+
gcl
(
setf
system::*tmp-dir*
*temporary-directory*
))
#+
(
and
gcl
(
not
gcl<2.7
))
(
setf
system::*tmp-dir*
*temporary-directory*
))
(
defun*
call-with-temporary-file
(
thunk
&key
...
...
package.lisp
View file @
2c49dbc7
...
...
@@ -571,10 +571,11 @@ or when loading the package is optional."
(
defmacro
define-package
(
package
&rest
clauses
)
`
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
#+
(
or
ecl
gcl
)
(
defpackage
,
package
(
:use
))
#+
clisp
(
macrolet
((
foo
()
(
apply
'ensure-package
',
(
parse-define-package-form
package
clauses
))
(
package-definition-form
',package
:nicknamesp
nil
)))
(
foo
))
#+
clisp
(
macrolet
((
foo
()
(
apply
'ensure-package
',
(
parse-define-package-form
package
clauses
))
(
package-definition-form
',package
:nicknamesp
nil
)))
(
foo
))
(
apply
'ensure-package
',
(
parse-define-package-form
package
clauses
))))
...
...
run-program.lisp
View file @
2c49dbc7
...
...
@@ -173,11 +173,9 @@ by /bin/sh in POSIX"
(
declare
(
ignorable
stream
element-type
))
(
cond
#+
(
or
gcl<2.7
genera
)
((
functionp
x
)
(
funcall
x
stream
))
((
functionp
x
)
(
funcall
x
stream
))
#+
(
or
gcl<2.7
genera
)
((
output-stream-p
x
)
(
copy-stream-to-stream
stream
x
:element-type
element-type
))
((
output-stream-p
x
)
(
copy-stream-to-stream
stream
x
:element-type
element-type
))
(
t
(
error
"Invalid ~S destination ~S"
'slurp-input-stream
x
))))
...
...
stream.lisp
View file @
2c49dbc7
...
...
@@ -4,6 +4,7 @@
(
asdf/package:define-package
:asdf/stream
(
:recycle
:asdf/stream
)
(
:use
:cl
:asdf/package
:asdf/compatibility
:asdf/utility
:asdf/pathname
)
#+
gcl<2.7
(
:shadowing-import-from
:asdf/compatibility
#:with-standard-io-syntax
)
(
:export
#:*default-stream-element-type*
#:*stderr*
#:setup-stderr
#:with-safe-io-syntax
#:call-with-safe-io-syntax
...
...
test/script-support.lisp
View file @
2c49dbc7
...
...
@@ -39,6 +39,13 @@ Some constraints:
(
defvar
*debug-asdf*
nil
)
(
defvar
*quit-when-done*
t
)
(
defun
verbose
(
&optional
(
verbose
t
))
(
loop
:for
v
:in
'
(
*load-verbose*
*compile-verbose*
*load-print*
*compile-print*
)
:do
(
setf
(
symbol-value
v
)
verbose
)))
(
verbose
nil
)
;;; Minimal compatibility layer
(
eval-when
(
:compile-toplevel
:load-toplevel
:execute
)
#+
allegro
...
...
@@ -148,10 +155,11 @@ Some constraints:
(
defun
touch-file
(
file
&key
(
offset
0
)
timestamp
)
(
let
((
timestamp
(
or
timestamp
(
+
offset
(
get-universal-time
)))))
(
multiple-value-bind
(
sec
min
hr
day
month
year
)
(
decode-universal-time
timestamp
)
(
multiple-value-bind
(
sec
min
hr
day
month
year
)
(
decode-universal-time
timestamp
#+
gcl<2.7
-5
)
(
acall
:run-shell-command
"touch -t ~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D ~S"
year
month
day
hr
min
sec
(
namestring
file
)))))
year
month
day
hr
min
sec
(
namestring
file
))
(
assert-equal
(
file-write-date
file
)
timestamp
))))
(
defun
hash-table->alist
(
table
)
(
loop
:for
key
:being
:the
:hash-keys
:of
table
:using
(
:hash-value
value
)
...
...
@@ -229,7 +237,7 @@ is bound, write a message and exit on an error. If
(
funcall
thunk
)))
(
defun
load-asdf-lisp
(
&optional
tag
)
(
quietly
(
load
(
asdf-lisp
tag
))))
(
quietly
(
load
(
asdf-lisp
tag
)
:verbose
*load-verbose*
:print
*load-print*
)))
(
defun
load-asdf-fasl
(
&optional
tag
)
(
quietly
(
load
(
asdf-fasl
tag
))))
...
...
@@ -373,13 +381,15 @@ is bound, write a message and exit on an error. If
(
setf
*package*
(
find-package
:asdf-test
)))
;; Actual scripts rely on this function:
(
defun
common-lisp-user::load-asdf
()
(
load-asdf
))
(
defun
common-lisp-user::load-asdf
()
(
load-asdf
))
;; These are shorthands for interactive debugging of test scripts:
(
!a
common-lisp-user::debug-asdf
debug-asdf
da
debug-asdf
common-lisp-user::da
debug-asdf
la
load-asdf
common-lisp-user::la
load-asdf
)
la
load-asdf
common-lisp-user::la
load-asdf
ll
load-asdf-lisp
v
verbose
)
#| For the record, the following form is sometimes useful to insert in
asdf/plan:compute-action-stamp to find out what's happening.
...
...
test/test-logical-pathname.script
View file @
2c49dbc7
...
...
@@ -17,38 +17,39 @@
:wilden t))))
(with-test ()
(DBG :logical
(logical-pathname-translations "ASDF")
(translate-logical-pathname "ASDF:test;test-force.asd")
(truename "ASDF:test;test-force.asd"))
#-gcl<2.7
(DBG :logical
(logical-pathname-translations "ASDF")
(translate-logical-pathname "ASDF:test;test-force.asd")
(truename "ASDF:test;test-force.asd"))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in central registry")
(setf *central-registry* '(#p"ASDF:test;"))
(initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(DBG "loading" (oos 'load-op :test-logical-pathname :force t)))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in central registry")
(setf *central-registry* '(#p"ASDF:test;"))
(initialize-source-registry '(:source-registry :ignore-inherited-configuration))
(DBG "loading" (oos 'load-op :test-logical-pathname :force t)))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in source-registry, non-recursive")
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
'(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t :verbose t))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in source-registry, non-recursive")
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
'(:source-registry (:directory #p"ASDF:test;") :ignore-inherited-configuration))
(load-system :test-logical-pathname :force t :verbose t))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in source-registry, recursive")
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
;; Bug: Allegro Express 8.2 and 9.0 incorrectly read #p"ASDF:" as relative.
;; other bug: around 2.26.xx, CLISP borks badly if this is ASDF:
;; and it tries to load ASDF from a logical-pathname.
'(:source-registry (:tree #p"ASDF:test;")
:ignore-inherited-configuration))
(load-system :test-logical-pathname :force t))
#-(or xcl gcl<2.7)
(progn
(DBG "Test logical pathnames in source-registry, recursive")
(clear-system :test-logical-pathname)
(setf *central-registry* '())
(initialize-source-registry
;; Bug: Allegro Express 8.2 and 9.0 incorrectly read #p"ASDF:" as relative.
;; other bug: around 2.26.xx, CLISP borks badly if this is ASDF:
;; and it tries to load ASDF from a logical-pathname.
'(:source-registry (:tree #p"ASDF:test;")
:ignore-inherited-configuration))
(load-system :test-logical-pathname :force t))
(DBG "Done"))
(DBG "Done"))
utility.lisp
View file @
2c49dbc7
...
...
@@ -4,6 +4,7 @@
(
asdf/package:define-package
:asdf/utility
(
:recycle
:asdf/utility
:asdf
)
(
:use
:common-lisp
:asdf/package
:asdf/compatibility
)
#+
gcl<2.7
(
:shadowing-import-from
:asdf/compatibility
#:with-standard-io-syntax
)
(
:export
;; magic helper to define debugging functions:
#:asdf-debug
#:load-asdf-debug-utility
#:*asdf-debug-utility*
...
...
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