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
54e74ce7
Commit
54e74ce7
authored
Oct 14, 2013
by
Francois-Rene Rideau
Browse files
Test cleanup: remove an obsolete test that was not run. Tweak some tests.
parent
2767ca09
Changes
3
Hide whitespace changes
Inline
Side-by-side
test/dweinreb-tests.lisp
deleted
100644 → 0
View file @
2767ca09
;;; -*- Lisp -*-
;;; By Dan Weinreb, Oct 1, 2006. Public domain, entirely free, etc.
#|
Daniel Weinreb
dlw@alum.mit.edu
http://danweinreb.org/blog/
http://ilc2009.scheming.org/
|#
(
defparameter
*all-tests*
nil
)
(
defclass
test
()
((
system-name
:initarg
:system-name
:reader
test-system-name
)
(
operation-name
:initarg
:operation-name
:reader
test-operation-name
)
(
already-compiled
:initarg
:already-compiled
:reader
test-already-compiled
)
(
expected
:initarg
:expected
:reader
test-expected
)))
(
defmacro
define-test
(
test-name
system-name
&key
operation-name
already-compiled
expected
)
`
(
progn
(
push
',test-name
*all-tests*
)
(
setf
(
get
',test-name
'test
)
(
make-instance
'test
:system-name
',system-name
:operation-name
',operation-name
:already-compiled
',already-compiled
:expected
',expected
))))
(
defclass
test-file
(
asdf:component
)
())
(
defvar
*test*
nil
)
(
defvar
*steps*
nil
)
(
defmethod
asdf:operation-done-p
((
o
asdf:compile-op
)
(
c
test-file
))
(
declare
(
ignorable
o
))
(
member
(
asdf:component-name
c
)
(
test-already-compiled
*test*
)
:test
#'
string=
))
(
defmethod
asdf:operation-done-p
((
o
asdf:operation
)
(
c
test-file
))
(
declare
(
ignorable
o
c
))
nil
)
(
defmethod
asdf:perform
((
o
asdf:compile-op
)
(
c
test-file
))
(
declare
(
ignorable
o
))
(
push
(
cons
:compiled
(
asdf:component-name
c
))
*steps*
))
(
defmethod
asdf:perform
((
o
asdf:load-op
)
(
c
test-file
))
(
declare
(
ignorable
o
))
(
push
(
cons
:loaded
(
asdf:component-name
c
))
*steps*
))
(
defun
run-unit-test
(
test-name
)
(
let
((
*test*
(
get
test-name
'test
))
(
*steps*
nil
)
(
succeeded
t
))
(
flet
((
fail
(
format-string
&rest
format-args
)
(
setq
succeeded
nil
)
(
format
t
"Error in test ~S: "
test-name
)
(
apply
#'
format
t
format-string
format-args
)
(
terpri
)))
(
let
((
system-name
(
test-system-name
*test*
))
(
operation-name
(
test-operation-name
*test*
)))
(
check-type
system-name
symbol
)
(
check-type
operation-name
symbol
)
(
asdf:operate
operation-name
system-name
))
(
setq
*steps*
(
nreverse
*steps*
))
(
loop
for
steps
on
*steps*
do
(
when
(
member
(
first
steps
)
(
rest
steps
)
:test
#'
equal
)
(
fail
"The step ~S happened more than once: ~S"
(
first
steps
)
*steps*
)))
;(format t "~2%STEPS: ~S~3%" *steps*)
(
dolist
(
expectation
(
test-expected
*test*
))
(
destructuring-bind
(
op
file
&rest
at
)
expectation
;(format t "~2%Expectation: ~S~3%" expectation)
(
check-type
file
string
)
(
ecase
op
((
:compiled
:loaded
)
(
let
((
pos
(
position
(
cons
op
file
)
*steps*
:test
#'
equal
)))
(
if
(
null
pos
)
(
fail
"~S was not ~A"
file
op
)
(
loop
for
(
relationship
file2
)
on
at
by
#'
cddr
do
(
check-type
file2
string
)
(
let*
((
op2
(
ecase
relationship
(
:after-loading
:loaded
)
(
:after-compiling
:compiled
)))
(
pos2
(
position
(
cons
op2
file2
)
*steps*
:test
#'
equal
)))
(
cond
((
null
pos2
)
(
fail
"~S was not ~A at all, after ~A was ~A"
file2
op2
file
op
))
((
<
pos
pos2
)
(
fail
"Wrong order between ~A of ~S and ~A of ~S"
op
file
op2
file2
))))))))
(
:did-not-compile
(
when
(
member
(
cons
:compiled
file
)
*steps*
)
(
fail
"~A compiled but should not have"
file
)))
(
:did-not-load
(
when
(
member
(
cons
:loaded
file
)
*steps*
)
(
fail
"~A loaded but should not have"
file
)))))))
succeeded
))
(
defun
run-all-unit-tests
()
(
let
((
n-tests
0
)
(
n-succeeded
0
))
(
dolist
(
test-name
*all-tests*
)
(
incf
n-tests
)
(
when
(
run-unit-test
test-name
)
(
incf
n-succeeded
)))
(
format
t
"Summary: ~D of ~D tests succeeded."
n-succeeded
n-tests
)))
(
asdf:defsystem
system-1
:components
((
:test-file
"a"
)
(
:test-file
"b"
)
(
:test-file
"c"
:depends-on
(
"b"
))
(
:test-file
"d"
)))
(
define-test
test-1
system-1
:operation-name
asdf:load-op
:already-compiled
(
"b"
)
:expected
((
:compiled
"a"
)
(
:loaded
"a"
:after-compiling
"a"
)
(
:did-not-compile
"b"
)
(
:loaded
"b"
)
(
:compiled
"c"
:after-loading
"b"
)
(
:loaded
"c"
:after-loading
"b"
:after-compiling
"c"
)
(
:compiled
"d"
)
(
:loaded
"d"
:after-compiling
"d"
)))
(
asdf:defsystem
system-2
:components
((
:test-file
"a"
:depends-on
(
"g"
"k"
))
(
:test-file
"b"
)
(
:test-file
"c"
:depends-on
(
"b"
))
(
:test-file
"d"
:depends-on
(
"e"
))
(
:test-file
"e"
)
(
:test-file
"f"
:depends-on
(
"c"
))
(
:test-file
"g"
:depends-on
(
"h"
))
(
:test-file
"h"
)
(
:test-file
"i"
:depends-on
(
"f"
"b"
))
(
:test-file
"j"
:depends-on
(
"f"
"c"
))
(
:test-file
"k"
)
(
:test-file
"l"
:depends-on
(
"d"
))))
(
define-test
test-2
system-2
:operation-name
asdf:load-op
:already-compiled
()
:expected
((
:compiled
"a"
:after-compiling
"g"
:after-compiling
"k"
:after-compiling
"h"
:after-loading
"g"
:after-loading
"k"
:after-loading
"h"
)
(
:loaded
"a"
:after-compiling
"a"
)
(
:compiled
"b"
)
(
:loaded
"b"
:after-compiling
"b"
)
(
:compiled
"c"
:after-compiling
"b"
:after-loading
"b"
)
(
:loaded
"c"
:after-compiling
"b"
:after-loading
"b"
:after-compiling
"c"
)
(
:compiled
"d"
:after-compiling
"e"
)
(
:compiled
"e"
)
(
:compiled
"f"
:after-compiling
"c"
:after-compiling
"b"
)
(
:compiled
"g"
:after-compiling
"h"
)
(
:compiled
"h"
)
(
:compiled
"i"
:after-compiling
"f"
:after-compiling
"b"
)
(
:compiled
"j"
:after-compiling
"f"
:after-compiling
"b"
:after-compiling
"c"
)
(
:compiled
"i"
:after-compiling
"f"
:after-compiling
"b"
:after-compiling
"c"
)
(
:compiled
"j"
:after-compiling
"f"
:after-compiling
"b"
:after-compiling
"c"
)
(
:compiled
"k"
)
(
:compiled
"l"
:after-compiling
"d"
:after-compiling
"e"
)))
(
asdf:defsystem
system-3
:components
((
:test-file
"a"
)
(
:test-file
"b"
:depends-on
(
"a"
))))
(
define-test
test-3
system-3
:operation-name
asdf:compile-op
:already-compiled
(
"b"
)
:expected
((
:compiled
"a"
)
(
:loaded
"a"
:after-compiling
"a"
)
(
:compiled
"b"
:after-compiling
"a"
:after-loading
"a"
)
(
:did-not-load
"b"
)))
(
define-test
test-3-a
system-3
:operation-name
asdf:compile-op
:already-compiled
(
"a"
"b"
)
:expected
((
:did-not-compile
"a"
)
(
:did-not-load
"a"
)
(
:did-not-compile
"b"
)
(
:did-not-load
"b"
)))
(
define-test
test-3-b
system-3
:operation-name
asdf:compile-op
:already-compiled
()
:expected
((
:compiled
"a"
)
(
:loaded
"a"
:after-compiling
"a"
)
(
:compiled
"b"
:after-compiling
"a"
:after-loading
"a"
)
(
:did-not-load
"b"
)))
(
asdf:defsystem
system-4
:components
((
:test-file
"a"
)
(
:test-file
"b"
:depends-on
(
"a"
))))
(
define-test
test-4
system-4
:operation-name
asdf:compile-op
:already-compiled
(
"a"
"b"
)
:expected
((
:did-not-compile
"a"
)
(
:did-not-load
"a"
)
(
:did-not-compile
"b"
)
(
:did-not-load
"b"
)))
(
asdf:defsystem
system-5
:components
((
:test-file
"a"
)
(
:test-file
"b"
:depends-on
(
"a"
)
:in-order-to
((
asdf:compile-op
(
asdf:load-op
"a"
))))))
(
define-test
test-5
system-5
:operation-name
asdf:compile-op
:already-compiled
(
"a"
"b"
)
:expected
((
:did-not-compile
"a"
)
(
:loaded
"a"
)
(
:did-not-compile
"b"
)
(
:did-not-load
"b"
)))
(
asdf:defsystem
system-6
:components
((
:test-file
"a"
)
(
:test-file
"b"
:in-order-to
((
asdf:compile-op
(
asdf:compile-op
"a"
))
(
asdf:load-op
(
asdf:load-op
"a"
))
(
asdf:compile-op
(
asdf:load-op
"a"
))))))
(
define-test
test-6
system-6
:operation-name
asdf:compile-op
:already-compiled
(
"a"
"b"
)
:expected
((
:did-not-compile
"a"
)
(
:did-not-load
"a"
)
(
:did-not-compile
"b"
)
(
:did-not-load
"b"
)))
;; Should be just like test-3-b, but a does not get loaded. Why not?
(
define-test
test-6-a
system-6
:operation-name
asdf:compile-op
:already-compiled
()
:expected
((
:compiled
"a"
)
(
:loaded
"a"
:after-compiling
"a"
)
(
:compiled
"b"
:after-compiling
"a"
:after-loading
"a"
)
(
:did-not-load
"b"
)))
(
asdf:defsystem
system-7
:components
((
:test-file
"a"
)
(
:test-file
"b"
:in-order-to
((
asdf:compile-op
(
asdf:compile-op
"a"
))
(
asdf:load-op
(
asdf:load-op
"a"
))
(
asdf:compile-op
(
asdf:load-op
"a"
))))))
(
define-test
test-7
system-7
:operation-name
asdf:compile-op
:already-compiled
(
"a"
"b"
)
:expected
((
:did-not-compile
"a"
)
(
:loaded
"a"
)
(
:did-not-compile
"b"
)
(
:did-not-load
"b"
)))
test/test-run-program.script
View file @
54e74ce7
...
...
@@ -4,10 +4,12 @@
(DBG "Testing echo ok 1 via run-program as a list")
(assert-equal "ok 1" (run-program '("echo" "ok" "1") :output '(:string :stripped t)))
(
DBG "Testing echo ok 1 via run-program as a string"
)
(assert-equal "ok 1" (run-program "echo ok 1" :output
'(
:
str
ing :stripped t)
))
(
defun space-bugged (x
)
#.(or #+(and sbcl windows)
'(str
cat x " ") 'x
))
;; (unless (os-unix-p) (leave-test "The rest of this test is only supposed to work on Unix"))
(DBG "Testing echo ok 1 via run-program as a string")
(assert-equal (space-bugged "ok 1")
(run-program "echo ok 1" :output '(:string :stripped t)))
;;; test asdf run-shell-command function
(setf *verbose-out* nil)
...
...
@@ -43,12 +45,14 @@
(run-program "echo foo ; echo bar >&2 ; echo baz ; echo quux >& 2"
:output :lines :error-output :output))))
#+(and sbcl os-windows)
(leave-test "SBCL run-program is a big fail on windows")
;; On Windows, normalize away CRLF into jut the unixy LF.
(defun remove-cr (x) (remove (code-char 13) x))
(DBG "Testing awkward legacy output capture via run-shell-command")
(let ((ok1 (format nil "; $ echo ok 1~%ok 1
~%
")))
(let ((ok1 (format nil "; $ echo ok 1~%
~A~%" (space-bugged "
ok 1"
)
)))
(assert-equal
(remove-cr
(with-output-to-string (s)
...
...
@@ -69,8 +73,8 @@
;; NB1: run-shell-command is deprecated. Use run-program instead.
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
;; If you want 2>&1 redirection, you know where to find it.
(assert-equal
'
("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line))
(assert-equal (
list (space-bugged
"ok 1")
)
(run-program "echo ok 1" :output :lines))
(assert-equal
(space-bugged
"ok 1"
)
(run-program '("echo" "ok 1") :output :line))
(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms))
(assert-equal (format nil "ok 1~%") (remove-cr (run-program '("echo" "ok 1") :output :string)))
...
...
test/test-utilities.script
View file @
54e74ce7
...
...
@@ -205,7 +205,8 @@
#-non-base-chars-exist-p
(progn
(assert (base-string-p (make-string 10 :element-type 'character))))
(assert (base-string-p (make-string 10 :element-type 'character)))
(assert (typep (code-char (1- char-code-limit)) 'base-char)))
(defun basify (s) (coerce s 'base-string))
(defun unbasify (s) (coerce s '(array character (*)))) ; on ECL, literals are base strings (!)
...
...
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