diff --git a/tests/run.scm b/tests/run.scm index 00d6c8a..330a174 100644 --- a/tests/run.scm +++ b/tests/run.scm @@ -9,6 +9,7 @@ (include "basic.scm") (include "semen.scm") +(include "utils.scm") ;;; Should be the last in the test suite (test-exit) diff --git a/tests/utils.scm b/tests/utils.scm new file mode 100644 index 0000000..6f9013f --- /dev/null +++ b/tests/utils.scm @@ -0,0 +1,22 @@ +(test-group "utils" + + (test + '((1) (2) (3)) + (list-split '(1 * 2 * 3) '*)) + + (test + '((1 2 3)) + (list-split '(1 2 3) '*)) + + (test + '(() (1) (2) (3) ()) + (list-split '(* 1 * 2 * 3 *) '*)) + + (test + '((const) (const struct something)) + (list-split '(const * const struct something) '*)) + + (test + '(1 * 2 * 3) + (list-join '(1 2 3) '*)) +) diff --git a/utils.scm b/utils.scm index dd0506e..942da8a 100644 --- a/utils.scm +++ b/utils.scm @@ -4,7 +4,8 @@ (import (chicken pathname) - (chicken process-context)) + (chicken process-context) + srfi-1) (define (get-env-var name) (get-environment-variable name)) @@ -17,3 +18,21 @@ (make-absolute-pathname (current-directory) (pathname-directory file)))))) + +(define (list-split src-list split-elt) + ;; split '(1 2 / 3 4 / 5 6) by '/ -> '((1 2) (3 4) (5 6)) + (fold (lambda (elt acc) + (if (eq? elt split-elt) + (append acc (list (list))) + (append (drop-right acc 1) + (list (append (last acc) (list elt)))))) + (list (list)) + src-list)) + +(define (list-join lists join-by) + (drop-right + (fold (lambda (elt acc) + (append acc (list elt) (list join-by))) + (list) + lists) + 1))