diff options
| author | Arun Isaac | 2024-03-12 15:51:51 +0000 |
|---|---|---|
| committer | Arun Isaac | 2024-03-12 15:51:51 +0000 |
| commit | 7374b1f62132af242c01f6143c4300be19372751 (patch) | |
| tree | 806468ce099b09c3b528d17aae0d24c28c0861b9 | |
| parent | 224070cbfd0571dd6d999f0f20593d29affb998a (diff) | |
| download | ccwl-7374b1f62132af242c01f6143c4300be19372751.tar.gz ccwl-7374b1f62132af242c01f6143c4300be19372751.tar.lz ccwl-7374b1f62132af242c01f6143c4300be19372751.zip | |
ccwl: Count argument positions on flattened run arguments.
* ccwl/ccwl.scm (command): Count argument positions on flattened run
arguments.
* tests/ccwl.scm ("count argument positions correctly when
left-flanked by prefixed string arguments"): New test.
| -rw-r--r-- | ccwl/ccwl.scm | 78 | ||||
| -rw-r--r-- | tests/ccwl.scm | 8 |
2 files changed, 51 insertions, 35 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index 743944d..ba60ad8 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -1,5 +1,5 @@ ;;; ccwl --- Concise Common Workflow Language -;;; Copyright © 2021, 2022, 2023 Arun Isaac <arunisaac@systemreboot.net> +;;; Copyright © 2021–2024 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of ccwl. ;;; @@ -457,40 +457,48 @@ identifiers defined in the commands." (formatted-message "Missing ~a key in command definition" #:run)))) (ensure-yaml-serializable other "#:other") - #`(make-command - (list #,@(map (lambda (input-spec) - (let* ((id (input-spec-id input-spec)) - (position (run-arg-position id run)) - (run-arg (and position - (list-ref run position)))) - #`(set-input-separator - (set-input-prefix - (set-input-position #,(input input-spec) - #,position) - #,(and run-arg - (run-arg-prefix run-arg))) - #,(and run-arg - (run-arg-separator run-arg))))) - inputs)) - (list #,@(map output outputs)) - (list #,@(run-args run (map input-spec-id inputs))) - #,(and stdin #`'#,stdin) - #,(if (and stderr - (not (string? (syntax->datum stderr)))) - (raise-exception - (condition (ccwl-violation stderr) - (formatted-message "Invalid #:stderr parameter ~a. #:stderr parameter must be a string" - (syntax->datum stderr)))) - stderr) - #,(if (and stdout - (not (string? (syntax->datum stdout)))) - (raise-exception - (condition (ccwl-violation stdout) - (formatted-message "Invalid #:stdout parameter ~a. #:stdout parameter must be a string" - (syntax->datum stdout)))) - stdout) - #,requirements - '#,other)) + (let ((flattened-args (run-args run (map input-spec-id inputs)))) + #`(make-command + (list #,@(map (lambda (input-spec) + (let* ((id (input-spec-id input-spec)) + (position (run-arg-position id run)) + (run-arg (and position + (list-ref run position)))) + #`(set-input-separator + (set-input-prefix + (set-input-position + #,(input input-spec) + ;; `run-args' returns inputs as quoted symbols. + ;; So, we add quote. + #,(list-index (match-lambda + (`(quote ,input) + (eq? input id)) + (_ #f)) + (syntax->datum flattened-args))) + #,(and run-arg + (run-arg-prefix run-arg))) + #,(and run-arg + (run-arg-separator run-arg))))) + inputs)) + (list #,@(map output outputs)) + (list #,@flattened-args) + #,(and stdin #`'#,stdin) + #,(if (and stderr + (not (string? (syntax->datum stderr)))) + (raise-exception + (condition (ccwl-violation stderr) + (formatted-message "Invalid #:stderr parameter ~a. #:stderr parameter must be a string" + (syntax->datum stderr)))) + stderr) + #,(if (and stdout + (not (string? (syntax->datum stdout)))) + (raise-exception + (condition (ccwl-violation stdout) + (formatted-message "Invalid #:stdout parameter ~a. #:stdout parameter must be a string" + (syntax->datum stdout)))) + stdout) + #,requirements + '#,other))) #'(args ...))))))) (define-syntax cwl-workflow diff --git a/tests/ccwl.scm b/tests/ccwl.scm index be986da..2d755ad 100644 --- a/tests/ccwl.scm +++ b/tests/ccwl.scm @@ -330,4 +330,12 @@ (= (length (delete-duplicates keys eq?)) (length keys)))) +(test-equal "count argument positions correctly when left-flanked by prefixed string arguments" + 3 + ;; Input `in' should be counted as position 3, not 2. + (match (command-inputs + (command #:inputs in + #:run "foo" ("--bar" "bar") in)) + ((in) (input-position in)))) + (test-end "ccwl") |