infix: more test cases.

* tests/012/infix.tl: New tests providing some coverage
of ifx, and its phony infix also. Big test case with
FFT function.

* tests/common.tl (msstest): New macro.

2 files changed, 60 insertions, 0 deletions

diff --git a/tests/012/infix.tl b/tests/012/infix.tl
index 67b0373c..0da0abeb 100644
--- a/tests/012/infix.tl
+++ b/tests/012/infix.tl
@@ -75,3 +75,60 @@
 (mtest
   (quadratic-roots 1 0 -4) (2.0 -2.0)
   (quadratic-roots 1 2 1) (-1.0 -1.0))
+
+(ifx
+  (mtest
+    (1 cons 2) (1 . 2)
+    (1 list* 2 3) (1 2 . 3)
+    (1 cons 2 cons 3) (1 2 . 3)
+    (1 cons 2 * 2 + 3 * 3) (1 . 13)
+    (1 cons 2 * 2 + 3 * 3 cons 29) :error
+    (1 cons (2 * 2 + 3 * 3) cons 29) (1 13 . 29)
+    (1 cons 2 list* (2 + 2) (3 + 3) nil) (1 2 4 6)))
+
+(defun fft (data nn isign)
+  (ifx
+    (let (n mmax m j istep i
+          wtemp wpr wpi wr wi theta
+          tempr tempi (data (copy data)))
+      (n := nn << 1)
+      (j := 1)
+      (for ((i 1)) ((i < n)) ((i += 2))
+        (when (j > i)
+          (swap (data[j]) (data[i]))
+          (swap (data[j + 1]) (data[i + 1])))
+        (m := nn)
+        (while (m >= 2 && j > m)
+          (j -= m)
+          (m >>= 1))
+        (j += m))
+      (mmax := 2)
+      (while (n > mmax)
+        (istep := mmax << 1)
+        (theta := isign * ((2 * %pi%) / mmax))
+        (wtemp := sin 0.5 * theta)
+        (wpr := - 2.0 * wtemp * wtemp)
+        (wpi := sin theta)
+        (wr := 1.0)
+        (wi := 0.0)
+        (for ((m 1)) ((m < mmax)) ((m += 2))
+          (for ((i m)) ((i <= n)) ((i += istep))
+            (j := i + mmax)
+            (tempr := wr * data[j] - wi * data[j + 1])
+            (tempi := wr * data[j + 1] + wi * data[j])
+            (data[j] := data[i] - tempr)
+            (data[j + 1] := data[i + 1] - tempi)
+            (data[i] += tempr)
+            (data[i + 1] += tempi))
+          (wr := (wtemp := wr) * wpr - wi * wpi + wr)
+          (wi := wi * wpr + wtemp * wpi + wi))
+        (mmax := istep))
+      data)))
+
+(msstest
+  (fft #(nil 0.0 0.0 0.0 0.0) 2 1)
+  #(nil 0.0 0.0 0.0 0.0)
+  (fft #(nil 1.0 1.0 1.0 1.0) 2 1)
+  #(nil 2.0 2.0 0.0 0.0)
+  (fft #(nil 0 1 0 2 0 3 0 4) 4 1)
+  #(nil 0.0 10.0 2.0 -2.0 0.0 -2.0 -2.0 -2.0))
diff --git a/tests/common.tl b/tests/common.tl
index 8e73faee..85f636a4 100644
--- a/tests/common.tl
+++ b/tests/common.tl
@@ -69,6 +69,9 @@
 (defmacro mstest (. pairs)
   ^(progn ,*(mapcar (op cons 'stest) (tuples 2 pairs))))
 
+(defmacro msstest (. pairs)
+  ^(progn ,*(mapcar (op cons 'sstest) (tuples 2 pairs))))
+
 (defun os-symbol ()
   (if (ignerr (dlsym (dlopen "libandroid.so") "AAsset_close"))
     :android