Skip to content
Snippets Groups Projects
Commit d5c5fc3f authored by Daniel Barlow's avatar Daniel Barlow
Browse files

changes to run on clisp (tested with debian 2.28-1)

parent f8c2b51a
No related branches found
No related tags found
No related merge requests found
;;; This is asdf: Another System Definition Facility. $Revision: 1.44 $
;;; This is asdf: Another System Definition Facility. $Revision: 1.45 $
;;;
;;; Feedback, bug reports, and patches are all welcome: please mail to
;;; <cclan-list@lists.sf.net>. But note first that the canonical
......@@ -88,7 +88,7 @@
(in-package #:asdf)
;;; parse the cvs revision into something that might be vaguely useful.
(defvar *asdf-revision* (let* ((v "$Revision: 1.44 $")
(defvar *asdf-revision* (let* ((v "$Revision: 1.45 $")
(colon (position #\: v))
(dot (position #\. v)))
(and v colon dot
......@@ -611,7 +611,7 @@ system."))
(multiple-value-bind (output warnings-p failure-p)
(compile-file source-file
:output-file output-file)
(declare (ignore output))
;(declare (ignore output))
(when warnings-p
(case (operation-on-warnings operation)
(:warn (warn "COMPILE-FILE warned while performing ~A on ~A"
......@@ -708,9 +708,13 @@ system."))
;;; syntax
(defun remove-keyword (key arglist)
(loop for sublist = arglist then rest until (null sublist)
for (elt arg . rest) = sublist
unless (eq key elt) append (list elt arg)))
(labels ((aux (key arglist)
(cond ((null arglist) nil)
((eq key (car arglist)) (cddr arglist))
(t (cons (car arglist) (cons (cadr arglist)
(remove-keyword
key (cddr arglist))))))))
(aux key arglist)))
(defmacro defsystem (name &body options)
(destructuring-bind (&key pathname (class 'system) &allow-other-keys) options
......@@ -903,4 +907,17 @@ output to *trace-output*. Returns the shell's exit code."
:shell-type "/bin/sh"
:output-stream *trace-output*)))
#+clisp
(defun run-shell-command (control-string &rest args)
"Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell, with
output to *trace-output*. Returns the shell's exit code."
(let ((command (apply #'format nil control-string args)))
(format *trace-output* "; $ ~A~%" command)
;; XXX :terminal is not exactly *trace-output*, but it'll do
;; XXX determined the return value of this by experimentation, it
;; doesn't seem to be documented
(ext:run-shell-command command :output :terminal :wait t)))
(pushnew :asdf *features*)
......@@ -43,7 +43,7 @@
will compile and load the system into your running lisp.
[*] This path (~W) is only a suggestion; the important
thing is that asdf know where to find the .asd file. Adsf uses the
thing is that asdf know where to find the .asd file. asdf uses the
contents of the variable ASDF:*CENTRAL-REGISTRY* to find its system
definitions.
......
......@@ -25,10 +25,15 @@ set -e
if type sbcl
then
do_tests "sbcl --noprogrammer" fasl
do_tests "sbcl --userinit /dev/null --noprogrammer" fasl
fi
if [ -x /usr/local/bin/lisp ]
if [ -x /usr/bin/lisp ]
then
do_tests "/usr/local/bin/lisp -batch" axpf
do_tests "/usr/bin/lisp -batch" x86f
fi
if [ -x /usr/bin/clisp ]
then
do_tests "/usr/bin/clisp -norc -ansi -I " fas
fi
......@@ -5,8 +5,8 @@
;(trace asdf::find-component)
;(trace asdf::traverse)
(asdf:oos 'asdf:load-op 'test2b1)
(assert (and (file-write-date (compile-file-pathname "file3"))
(file-write-date (compile-file-pathname "file4"))))
(assert (and (probe-file (compile-file-pathname "file3"))
(probe-file (compile-file-pathname "file4"))))
(handler-case
(asdf:oos 'asdf:load-op 'test2b2)
(asdf:missing-dependency (c)
......
......@@ -2,6 +2,9 @@
#+(or f1 f2)
(error "This test cannot run if :f1 or :f2 are on *features*")
(load "../asdf")
(asdf:run-shell-command "rm ~A ~A"
(namestring (compile-file-pathname "file1"))
(namestring (compile-file-pathname "file2")))
(setf asdf:*central-registry* '(*default-pathname-defaults*))
(in-package :asdf)
(handler-case
......@@ -11,10 +14,10 @@
(:no-error (c) (error "should have failed, oops")))
(pushnew :f1 *features*)
(asdf:oos 'asdf:load-op 'test3)
(assert (file-write-date (compile-file-pathname "file1")))
(assert (not (file-write-date (compile-file-pathname "file2"))))
(assert (probe-file (compile-file-pathname "file1")))
(assert (not (probe-file (compile-file-pathname "file2"))))
(run-shell-command "rm ~A" (namestring (compile-file-pathname "file1")))
(setf *features* (cons :f2 (cdr *features*)))
(asdf:oos 'asdf:load-op 'test3)
(assert (file-write-date (compile-file-pathname "file2")))
(assert (not (file-write-date (compile-file-pathname "file1"))))
(assert (probe-file (compile-file-pathname "file2")))
(assert (not (probe-file (compile-file-pathname "file1"))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment