summaryrefslogtreecommitdiffstats
path: root/tests/common.tl
blob: 4011583f59e181752361c77b181fca9091a7a9e5 (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
(defmacro error-to-sym (expr)
 ^(catch ,expr
    (error (cond) :error)
    (warning (cond) :warning)))

(defmacro vtest (:env env expr expected)
  (if-match (quote @(as sym @(or :error :warning))) expected
    (set expected sym))
  (if (mequal expected :error :warning :warnerror)
    (catch
      (let ((expr-expn (expand expr env)))
        ^(ifa (not (equal (error-to-sym ,expr-expn) ,expected))
           (error "test case ~s failed: produced ~s; expected ~s"
                  ',expr it ,expected)))
      (error (exc)
        (if (eq expected :warning)
          (error "test case ~s produced error during expansion, expected ~s"
                 expr expected)))
      (warning (exc)
        (if (eq expected :error)
          (error "test case ~s warned during expansion, expected ~s"
                 expr expected))))
    (let ((expr-expn (expand expr env))
          (expval (gensym)))
      ^(let ((,expval ,expected))
         (ifa (not (equal ,expr-expn ,expval))
           (error "test case ~s failed: produced ~s; expected ~s"
                  ',expr it ,expval))))))

(defmacro test (expr expected)
  ^(vtest ,expr ',expected))

(defmacro stest (expr expected)
  ^(vtest ,^(tostring ,expr) ,expected))

(defmacro mtest (. pairs)
  ^(progn ,*(mapcar (op cons 'test) (tuples 2 pairs))))

(defmacro mstest (. pairs)
  ^(progn ,*(mapcar (op cons 'stest) (tuples 2 pairs))))

(defun os-symbol ()
  (if (ignerr (dlsym (dlopen "libandroid.so") "AAsset_close"))
    :android
    (let ((u (uname)))
      [(orf (iff (f^ #/Linux/) (ret :linux))
            (iff (f^ #/SunOS/) (ret :solaris))
            (iff (f^ #/CYGWIN/) (ret :cygwin))
            (iff (f^ #/CYGNAL/) (ret :cygnal))
            (iff (f^ #/Darwin/) (ret :macos))
            (iff (f^ #/OpenBSD/) (ret :openbsd))
            (ret :unknown))
       u.sysname])))

(defun libc ()
  (caseql (os-symbol)
    ((:cygwin :cygnal) (dlopen "cygwin1.dll"))
    (t (dlopen nil))))

(defmacro with-temp-file ((name-var stream-var prefix) . body)
  ^(let* ((,stream-var (mkstemp ,prefix))
          (,name-var (stream-get-prop ,stream-var :name)))
     (unwind-protect
       (progn ,*body)
       (close-stream ,stream-var)
       (remove-path ,name-var))))