diff options
| -rw-r--r-- | ccwl/ccwl.scm | 64 | ||||
| -rw-r--r-- | tests/ccwl.scm | 24 |
2 files changed, 74 insertions, 14 deletions
diff --git a/ccwl/ccwl.scm b/ccwl/ccwl.scm index 903f161..be87467 100644 --- a/ccwl/ccwl.scm +++ b/ccwl/ccwl.scm @@ -23,6 +23,9 @@ ;;; Code: (define-module (ccwl ccwl) + #:use-module ((rnrs conditions) #:select (condition + condition-irritants)) + #:use-module ((rnrs exceptions) #:select (guard (raise . raise-exception))) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) @@ -30,6 +33,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-71) #:use-module (ice-9 match) + #:use-module (ccwl conditions) #:use-module (ccwl utils) #:use-module (yaml) #:export (command? @@ -89,16 +93,46 @@ (define (input input-spec) "Return syntax to build an <input> object from INPUT-SPEC." (syntax-case input-spec () - ((id args ...) (identifier? #'id) - (apply (syntax-lambda** (id #:key (type #'File) label (default (make-unspecified-default)) #:key* other) - (let ((position #f) - (prefix #f)) - #`(make-input '#,id '#,type #,label - #,(if (unspecified-default? default) - #'(make-unspecified-default) - default) - #,position #,prefix '#,other))) - #'(id args ...))) + ((id args ...) + (guard (exception + ((unrecognized-keyword-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ((irritant _ ...) + (condition (ccwl-violation irritant) + (formatted-message "Unrecognized keyword argument ~a in input" + (syntax->datum irritant))))))) + ((invalid-keyword-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra arguments, not just the + ;; first one. + ((keyword _ extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra argument ~a for unary keyword argument ~a" + (syntax->datum extra) + (syntax->datum keyword))))))) + ((invalid-positional-arguments-arity-assertion? exception) + (raise-exception + (match (condition-irritants exception) + ;; TODO: Report all extra positional arguments, not + ;; just the first one. + ((id extra _ ...) + (condition (ccwl-violation extra) + (formatted-message "Unexpected extra positional argument ~a in input" + (syntax->datum extra)))) + (() + (condition (ccwl-violation input-spec) + (formatted-message "Input has no identifier"))))))) + (apply (syntax-lambda** (id #:key (type #'File) label (default (make-unspecified-default)) #:key* other) + (let ((position #f) + (prefix #f)) + #`(make-input '#,id '#,type #,label + #,(if (unspecified-default? default) + #'(make-unspecified-default) + default) + #,position #,prefix '#,other))) + #'(id args ...)))) (id (identifier? #'id) (input #'(id))) (_ (error "Invalid input:" (syntax->datum input-spec))))) @@ -167,9 +201,15 @@ object." "Return the identifier symbol of INPUT-SPEC." (syntax->datum (syntax-case input-spec () - ((id _ ...) (identifier? #'id) #'id) + ((id _ ...) + (if (not (identifier? #'id)) + (raise-exception + (condition (ccwl-violation input-spec) + (formatted-message "Input has no identifier"))) + #'id)) (id (identifier? #'id) #'id) - (_ (error "Invalid input:" (syntax->datum input-spec)))))) + (_ (raise-exception (condition (ccwl-violation input-spec) + (formatted-message "Invalid input"))))))) (define (run-arg-position input-id run-args) "Return the position of input identified by symbol INPUT-ID in diff --git a/tests/ccwl.scm b/tests/ccwl.scm index 015dcde..bc9fb01 100644 --- a/tests/ccwl.scm +++ b/tests/ccwl.scm @@ -16,8 +16,13 @@ ;;; You should have received a copy of the GNU General Public License ;;; along with ccwl. If not, see <https://www.gnu.org/licenses/>. -(use-modules (srfi srfi-64) - (ccwl ccwl)) +(use-modules (rnrs exceptions) + (srfi srfi-64) + (ccwl ccwl) + (ccwl conditions)) + +(define input + (@@ (ccwl ccwl) input)) (test-begin "ccwl") @@ -47,4 +52,19 @@ (output-type output))) (cwl-workflow-outputs cwl-workflow))))) +(test-assert "input, when passed more than one positional argument, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (input #'(message string)))) + +(test-assert "input, when passed an unrecognized keyword, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (input #'(message #:foo string)))) + +(test-assert "input, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition" + (guard (exception + (else (ccwl-violation? exception))) + (input #'(message #:type int string)))) + (test-end "ccwl") |