* Makefile (tests/008/soundex.ok): New test case.

(TXR_ARGS): Specified for new test case.

* tests/008/soundex.expected: New file.

* tests/008/soundex.txr: New file.

1 files changed, 78 insertions, 0 deletions

diff --git a/tests/008/soundex.txr b/tests/008/soundex.txr
new file mode 100644
index 00000000..d01fb76d
--- /dev/null
+++ b/tests/008/soundex.txr
@@ -0,0 +1,78 @@
+@(next :args)
+@###
+@# soundex data
+@###
+@(deffilter remdbl ("AA" "A") ("BB" "B") ("CC" "C") ("DD" "D") ("EE" "E")
+                   ("FF" "F") ("GG" "G") ("HH" "H") ("II" "I") ("JJ" "J")
+                   ("KK" "K") ("LL" "L") ("MM" "M") ("NN" "N") ("OO" "O")
+                   ("PP" "P") ("QQ" "Q") ("RR" "R") ("SS" "S") ("TT" "T")
+                   ("UU" "U") ("VV" "V") ("WW" "W") ("XX" "X") ("YY" "Y")
+                   ("ZZ" "Z"))
+@(deffilter code ("B" "F" "P" "V" "1")
+                 ("C" "G" "J" "K" "Q" "S" "X" "Z" "2")
+                 ("D" "T" "3") ("L" "4") ("M" "N" "5")
+                 ("R" "6") ("A" "E" "I" "O" "U" "Y" "0") ("H" "W" ""))
+@(deffilter squeeze ("11" "111" "1111" "11111" "1")
+                    ("22" "222" "2222" "22222" "2")
+                    ("33" "333" "3333" "33333" "3")
+                    ("44" "444" "4444" "44444" "4")
+                    ("55" "555" "5555" "55555" "5")
+                    ("66" "666" "6666" "66666" "6"))
+@(bind prefix ("VAN" "CON" "DE" "DI" "LA" "LE"))
+@(deffilter remzero ("0" ""))
+@###
+@# soundex function
+@###
+@(define soundex (in out))
+@  (local nodouble letters remainder first rest coded)
+@  (next :string in)
+@  (coll :vars (letters))@{letters /[A-Za-z]+/}@(end)
+@  (cat letters)
+@  (output :into nodouble :filter (:upcase remdbl))
+@letters
+@  (end)
+@  (next :list nodouble)
+@  (maybe)
+@prefix@remainder
+@    (output :into nodouble)
+@nodouble
+@remainder
+@    (end)
+@  (end)
+@  (next :list nodouble)
+@  (collect)
+@{first 1}@rest
+@    (output :filter (code squeeze remzero) :into coded)
+@{rest}000
+@    (end)
+@    (next :list coded)
+@{digits 3}@(skip)
+@  (end)
+@  (output :into out)
+@    (rep):@first@digits@(first)@first@digits@(end)
+@  (end)
+@  (cat out)
+@(end)
+@###
+@# process arguments and list soundex codes
+@###
+@(collect :vars ())
+@input
+@  (output :filter (:fun soundex))
+@input
+@  (end)
+@(end)
+@###
+@# compare first and second argument under soundex
+@###
+@(bind (first_arg second_arg . rest) input)
+@(cases)
+@  (bind first_arg second_arg :filter (:fun soundex))
+@  (output)
+"@first_arg" and "@second_arg" match under soundex
+@  (end)
+@(or)
+@  (output)
+"@first_arg" and "@second_arg" do not match under soundex
+@  (end)
+@(end)