diff options
| -rw-r--r-- | ccwl/ccwl.scm | 11 | ||||
| -rw-r--r-- | ccwl/utils.scm | 19 | ||||
| -rw-r--r-- | tests/ccwl.scm | 17 | ||||
| -rw-r--r-- | tests/utils.scm | 9 |
4 files changed, 25 insertions, 31 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index bbc5de1..743944d 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -636,8 +636,15 @@ represented by <step> objects." (list))) ;; tee ((tee expressions ...) - (append-mapn (cut collect-steps <> input-keys) - #'(expressions ...))) + (let ((key-lists step-lists (mapn (cut collect-steps <> input-keys) + #'(expressions ...)))) + (values + ;; Global workflow input keys may be duplicated across the + ;; branches of a tee. So, deduplicate them by treating key + ;; lists as sets. TODO: Error out if any keys other than + ;; global workflow inputs are duplicated. + (apply lset-union eq? key-lists) + (apply append step-lists)))) ((identity) (values input-keys (list))) ;; rename keys (base case) diff --git a/ccwl/utils.scm b/ccwl/utils.scm index d9d1ee3..3c18efd 100644 --- a/ccwl/utils.scm +++ b/ccwl/utils.scm @@ -39,7 +39,6 @@ lambda** syntax-lambda** mapn - append-mapn foldn filter-mapi)) @@ -329,24 +328,6 @@ number of lists are returned. For example, (call-with-values (cut proc x) list)) lst)))) -(define (append-mapn proc lst) - "Map PROC over LST just as in mapn, but append the results -together. PROC can return multiple values, in which case, an equal -number of lists are returned. - -(append-mapn (lambda (n) - (values (list n (expt n 2)) - (list n (expt n 3)))) - (iota 5)) -=> (0 0 1 1 2 4 3 9 4 16) -=> (0 0 1 1 2 8 3 27 4 64)" - (call-with-values (cut mapn proc lst) - (lambda lists - (apply values - (map (lambda (lst) - (apply append lst)) - lists))))) - (define (foldn proc lst . inits) "Apply PROC to the elements of LST to build a result, and return that result. PROC can return multiple values, in which case, an equal diff --git a/tests/ccwl.scm b/tests/ccwl.scm index 9e73c50..f0e2911 100644 --- a/tests/ccwl.scm +++ b/tests/ccwl.scm @@ -17,7 +17,9 @@ ;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>. (use-modules (rnrs exceptions) + (srfi srfi-1) (srfi srfi-64) + (srfi srfi-71) (ccwl ccwl) (ccwl conditions)) @@ -30,6 +32,12 @@ (define make-array-type (@@ (ccwl ccwl) make-array-type)) +(define key + (@@ (ccwl ccwl) key)) + +(define collect-steps + (@@ (ccwl ccwl) collect-steps)) + (define-syntax construct-type-syntax-wrapper (lambda (x) (syntax-case x () @@ -133,7 +141,7 @@ #:outputs (printed-message #:type stdout))) (test-equal "rename should work even on the final output of a workflow" - (list 'out1 'printed-message) + (list 'printed-message 'out1) (map output-id (workflow-outputs (workflow ((message1 #:type string) @@ -315,4 +323,11 @@ '(command #:inputs (messages #:type (array string)) #:run "echo" (array messages #:separator foo)))) +(test-assert "tee must deduplicate global workflow input keys" + (let ((keys steps (collect-steps #'(tee (print #:message message) + (identity)) + (list (key 'message))))) + (= (length (delete-duplicates keys eq?)) + (length keys)))) + (test-end "ccwl") diff --git a/tests/utils.scm b/tests/utils.scm index 66220cc..50c3396 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -197,15 +197,6 @@ (iota 5)))) (list squares cubes))) -(test-equal "append-mapn" - '((0 0 1 1 2 4 3 9 4 16) - (0 0 1 1 2 8 3 27 4 64)) - (let ((squares cubes (append-mapn (lambda (n) - (values (list n (expt n 2)) - (list n (expt n 3)))) - (iota 5)))) - (list squares cubes))) - (test-equal "foldn" '(45 285) (let ((sum sum-of-squares |