infix: add tests.

* tests/012/infix.tl: New file.

* tests/012/compile.tl: Add infix to compiled tests.

2 files changed, 68 insertions, 1 deletions

diff --git a/tests/012/compile.tl b/tests/012/compile.tl
index b79d92f4..492c5f1f 100644
--- a/tests/012/compile.tl
+++ b/tests/012/compile.tl
@@ -4,7 +4,7 @@
 (file-put-string %expected-file% "")
 
 (each ((f '#"aseq ashwin circ cont defset except \
-             fini ifa man-or-boy oop-mi oop-seq oop \
+             fini ifa man-or-boy oop-mi oop-seq oop infix \
              parse syms quasi quine seq stslot const type"))
   (let ((exf `@{%this-dir%}/@f.expected`))
     (when (path-exists-p exf)
diff --git a/tests/012/infix.tl b/tests/012/infix.tl
new file mode 100644
index 00000000..c619db18
--- /dev/null
+++ b/tests/012/infix.tl
@@ -0,0 +1,67 @@
+(load "../common")
+
+(defmacro mtest-pif (:form f . pairs)
+  (unless (evenp (len pairs))
+    (compile-error f "even number of arguments required"))
+  ^(mtest ,*(mappend (aret ^((parse-infix ',@1) ,@2)) (tuples 2 pairs))))
+
+(mtest-pif
+  nil nil
+  (-) :error
+  (=) :error
+  (--) :error
+  (++) :error
+  (a -) :error
+  (a =) :error
+  (a) a
+  (= b) (identity b)
+  (++ a) (inc a)
+  (-- a) (dec a)
+  (= (-)) (identity (-))
+  (++ (-)) (inc (-))
+  (-- (-)) (dec (-)))
+
+(defmacro mtest-pif-syms (:form f (var syms) . pairs)
+  (unless (evenp (len pairs))
+    (compile-error f "even number of arguments required"))
+  ^(each ((,var ',syms))
+     (mvtest ,*(mappend (aret ^((parse-infix ,@1) ,@2)) (tuples 2 pairs)))))
+
+(mtest-pif-syms (fn (abs signum isqrt square zerop plusp minusp evenp oddp
+                     sin cos tan asin acos atan log log2 log10 exp
+                     sqrt width logcount cbrt erf erfc exp10 exp2 expm1
+                     gamma lgamma log1p logb nearbyint rint significand
+                     tgamma tofloat toint trunc floor ceil round lognot))
+  ^(a ,fn) :error
+  ^(,fn) :error
+  ^(,fn b) ^(,fn b)
+  ^(,fn (:)) ^(,fn :)
+  ^(,fn (: :)) ^(,fn : :)
+  ^(,fn a + b) ^(,fn (+ a b))
+  ^(,fn ,fn ,fn a + b) ^(,fn (,fn (,fn (+ a b))))
+  ^(,fn a + b + ,fn b + c) ^(+ (,fn (+ a b)) (,fn (+ b c)))
+  ^(,fn a + b + - ,fn b + c) ^(+ (,fn (+ a b)) (- (,fn (+ b c))))
+  ^(,fn a + b + ,fn - b + c) ^(+ (,fn (+ a b)) (,fn (+ (- b) c))))
+
+(mtest-pif
+  (a + b) (+ a b)
+  (a + b + c) (+ (+ a b) c)
+  (a + b * c) (+ a (* b c))
+  (a * b + c) (+ (* a b) c)
+  (a ** b * c + d) (+ (* (expt a b) c) d)
+  (a ** b * c + d) (+ (* (expt a b) c) d)
+  (x + a ** b * c + d) (+ (+ x (* (expt a b) c)) d)
+  (x + a ** b ++ * c + d) (+ (+ x (* (expt a (pinc b)) c)) d)
+  (x + -- a ** b ++ * c + d) (+ (+ x (* (expt (dec a) (pinc b)) c)) d))
+
+(mtest-pif
+  ([i]) [i]
+  (a[i]) [a i]
+  (a[i][j]) [[a i] j]
+  (a[i][j][k]) [[[a i] j] k])
+
+(mtest-pif
+  (x ** a[i][j][k]) (expt x [[[a i] j] k])
+  (x ** a[i][j][k] ++) (expt x (pinc [[[a i] j] k]))
+  (x ** -- a[i][j][k]) (expt x (dec [[[a i] j] k]))
+  (x ** -- a[i + y][j ++][-- k]) (expt x (dec [[[a i + y] j ++] -- k])))