blob: bd0037f116f4841399c7e386f6598c899523c4d4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
|
(load "../common")
(defvar *trace*)
(defmacro deftrace (fun)
^(defun ,fun (. args)
(push ^(,%fun% ,*args) *trace*)))
(handle
(eval '(progn
(deftrace load)
(deftrace compile-update-file)
(deftrace clean-file)))
(warning (x . rest)
(throw 'continue)))
(defmacro tr (form)
^(let ((*trace* nil))
,form
(reverse *trace*)))
(mtest
(tr (load-args-recurse '("abc"))) ((load "abc"))
(tr (load-args-recurse "abc")) ((load "abc"))
(tr (load-args-recurse "abc" "def")) ((load "abc") (load "def"))
(tr (load-args-recurse '("abc") "def")) ((load ("abc")) (load "def")))
(let ((*load-args* '(1 2)))
(mtest
(tr (load-args-recurse '("abc"))) ((load "abc" 1 2))
(tr (load-args-recurse "abc")) ((load "abc" 1 2))
(tr (load-args-recurse "abc" "def")) ((load "abc" 1 2) (load "def" 1 2))
(tr (load-args-recurse '("abc") "def")) ((load ("abc") 1 2) (load "def" 1 2))))
(mtest
(tr (load-args-process '("abc"))) ((load "abc"))
(tr (load-args-process "abc")) ((load "abc"))
(tr (load-args-process "abc" "def")) ((load "abc") (load "def"))
(tr (load-args-process '("abc") "def")) ((load ("abc")) (load "def")))
(let ((*load-args* '(1 2)))
(mtest
(tr (load-args-process '("abc"))) ((load "abc" 1 2))
(tr (load-args-process "abc")) ((load "abc" 1 2))
(tr (load-args-process "abc" "def")) ((load "abc" 1 2) (load "def" 1 2))
(tr (load-args-process '("abc") "def")) ((load ("abc") 1 2) (load "def" 1 2))))
(let ((*load-args* '(:compile)))
(mtest
(tr (load-args-process '("abc"))) ((compile-update-file "load-args.tl")
(compile-update-file "abc"))
(tr (load-args-process "abc")) ((compile-update-file "load-args.tl")
(compile-update-file "abc"))
(tr (load-args-process "abc" "def")) ((compile-update-file "load-args.tl")
(compile-update-file "abc")
(compile-update-file "def"))
(tr (load-args-process '("abc") "def")) ((compile-update-file "load-args.tl")
(compile-update-file ("abc"))
(compile-update-file "def"))))
(let ((*load-args* '(:clean)))
(mtest
(tr (load-args-process '("abc"))) ((clean-file "load-args.tl")
(clean-file "abc"))
(tr (load-args-process "abc")) ((clean-file "load-args.tl")
(clean-file "abc"))
(tr (load-args-process "abc" "def")) ((clean-file "load-args.tl")
(clean-file "abc")
(clean-file "def"))
(tr (load-args-process '("abc") "def")) ((clean-file "load-args.tl")
(clean-file ("abc"))
(clean-file "def"))))
|
