From 2f78bb9402e214bcab92e315c3dc8def424d343f Mon Sep 17 00:00:00 2001
From: Arun Isaac
Date: Tue, 21 Nov 2023 13:42:12 +0000
Subject: tests: Abstract out testing for conditions.

* tests/ccwl.scm (test-condition): New syntax.
(ccwl-violation-with-message?): New function.
Rewrite almost all tests using test-condition.
---
 tests/ccwl.scm | 367 +++++++++++++++++++++++++--------------------------------
 1 file changed, 161 insertions(+), 206 deletions(-)

diff --git a/tests/ccwl.scm b/tests/ccwl.scm
index 6890017..d325e57 100644
--- a/tests/ccwl.scm
+++ b/tests/ccwl.scm
@@ -37,6 +37,19 @@
        ((@@ (ccwl ccwl) construct-type-syntax)
         #'type-spec)))))
 
+(define-syntax-rule (test-condition test-name condition-predicate test-expression)
+  (test-assert test-name
+    (guard (condition
+            (else (condition-predicate condition)))
+      (begin test-expression
+             #f))))
+
+(define (ccwl-violation-with-message? message)
+  (lambda (condition)
+    (and (ccwl-violation? condition)
+         (string=? (formatted-message-format condition)
+                   message))))
+
 (test-begin "ccwl")
 
 (test-assert "stdin input should not have inputBinding"
@@ -65,70 +78,52 @@
                        (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)))
-    (begin (input #'(message string))
-           #f)))
-
-(test-assert "input, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (input #'(message #:foo string))
-           #f)))
-
-(test-assert "input, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (input #'(message #:type int string))
-           #f)))
-
-(test-assert "output, when passed more than one positional argument, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (output #'(message string))
-           #f)))
-
-(test-assert "output, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (output #'(message #:foo string))
-           #f)))
-
-(test-assert "output, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (output #'(message #:type int string))
-           #f)))
-
-(test-assert "command, when passed positional arguments, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (macroexpand
-            '(command foo
-                      #:inputs (message #:type string)
-                      #:run "echo" message
-                      #:outputs (stdout #:type stdout)))
-           #f)))
-
-(test-assert "command, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (macroexpand
-            '(command #:foo (message #:type string)
-                      #:run "echo" message
-                      #:outputs (stdout #:type stdout)))
-           #f)))
-
-(test-assert "command, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (macroexpand
-            '(command #:inputs (message #:type string)
-                      #:run "echo" message
-                      #:outputs (stdout #:type stdout)
-                      #:stdin "foo" "bar"))
-           #f)))
+(test-condition "input, when passed more than one positional argument, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (input #'(message string)))
+
+(test-condition "input, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (input #'(message #:foo string)))
+
+(test-condition "input, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (input #'(message #:type int string)))
+
+(test-condition "output, when passed more than one positional argument, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (output #'(message string)))
+
+(test-condition "output, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (output #'(message #:foo string)))
+
+(test-condition "output, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (output #'(message #:type int string)))
+
+(test-condition "command, when passed positional arguments, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (macroexpand
+   '(command foo
+             #:inputs (message #:type string)
+             #:run "echo" message
+             #:outputs (stdout #:type stdout))))
+
+(test-condition "command, when passed an unrecognized keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (macroexpand
+   '(command #:foo (message #:type string)
+             #:run "echo" message
+             #:outputs (stdout #:type stdout))))
+
+(test-condition "command, when passed multiple arguments to a unary keyword, must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (macroexpand
+   '(command #:inputs (message #:type string)
+             #:run "echo" message
+             #:outputs (stdout #:type stdout)
+             #:stdin "foo" "bar")))
 
 ;; TODO: Define this in the lexical scope of the test that requires
 ;; it.
@@ -164,14 +159,12 @@
      (print)
      #:message message)))
 
-(test-assert "step with expression that evaluates to a command but without a step identifier must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (macroexpand
-            '(workflow ((message #:type string))
-               ((and #t print)
-                #:message message)))
-           #f)))
+(test-condition "step with expression that evaluates to a command but without a step identifier must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (macroexpand
+   '(workflow ((message #:type string))
+      ((and #t print)
+       #:message message))))
 
 (test-assert "allow literal strings as arguments"
   (workflow ()
@@ -188,144 +181,106 @@
   (workflow ()
     (print-int #:number 42)))
 
-(test-assert "step supplied with an unknown key must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (ccwl-violation? exception)))
-    (begin (macroexpand
-            '(workflow ((message #:type string))
-               (print #:message mess)))
-           #f)))
-
-(test-assert "unrecognized workflow syntaxes must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Unrecognized workflow syntax [expected (workflow (input ...) tree)]"))))
-    (begin (macroexpand
-            '(workflow foo ((message #:type string))
-                       (print #:message message)))
-           #f)))
-
-(test-assert "multiple expressions in workflow body must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "More than one expression ~a in workflow body. Perhaps you need to combine them with a pipe or a tee?"))))
-    (begin (macroexpand
-            '(workflow ((message1 #:type string)
-                        (message2 #:type string))
-               (print (print1) #:message message1)
-               (print (print2) #:message message2)))
-           #f)))
-
-(test-assert "commands with non-string #:stderr parameters must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Invalid #:stderr parameter ~a. #:stderr parameter must be a string"))))
-    (begin (macroexpand
-            '(command #:inputs (message #:type string)
-                      #:run "echo" message
-                      #:outputs (printed #:type stderr)
-                      #:stderr captured-stderr))
-           #f)))
-
-(test-assert "commands with non-string #:stdout parameters must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Invalid #:stdout parameter ~a. #:stdout parameter must be a string"))))
-    (begin (macroexpand
-            '(command #:inputs (message #:type string)
-                      #:run "echo" message
-                      #:outputs (printed #:type stdout)
-                      #:stdout captured-stdout))
-           #f)))
-
-(test-assert "command definitions with undefined inputs in their #:run arguments must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Undefined input ~a"))))
-    (begin (macroexpand
-            '(command #:inputs (number #:type int)
-                      #:run "echo" n))
-           #f)))
-
-(test-assert "command definitions with undefined prefix inputs in their #:run arguments must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Undefined input ~a"))))
-    (begin (macroexpand
-            '(command #:inputs (number #:type int)
-                      #:run "echo" ("-x" n)))
-           #f)))
-
-(test-assert "command definitions with invalid #:run arguments must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Invalid command element ~a. Command elements must either be input identifiers or literal strings."))))
-    (begin (macroexpand
-            '(command #:run "echo" 42))
-           #f)))
+(test-condition "step supplied with an unknown key must raise a &ccwl-violation condition"
+  ccwl-violation?
+  (macroexpand
+   '(workflow ((message #:type string))
+      (print #:message mess))))
+
+(test-condition "unrecognized workflow syntaxes must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Unrecognized workflow syntax [expected (workflow (input ...) tree)]")
+  (macroexpand
+   '(workflow foo ((message #:type string))
+              (print #:message message))))
+
+(test-condition "multiple expressions in workflow body must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "More than one expression ~a in workflow body. Perhaps you need to combine them with a pipe or a tee?")
+  (macroexpand
+   '(workflow ((message1 #:type string)
+               (message2 #:type string))
+      (print (print1) #:message message1)
+      (print (print2) #:message message2))))
+
+(test-condition "commands with non-string #:stderr parameters must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Invalid #:stderr parameter ~a. #:stderr parameter must be a string")
+  (macroexpand
+   '(command #:inputs (message #:type string)
+             #:run "echo" message
+             #:outputs (printed #:type stderr)
+             #:stderr captured-stderr)))
+
+(test-condition "commands with non-string #:stdout parameters must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Invalid #:stdout parameter ~a. #:stdout parameter must be a string")
+  (macroexpand
+   '(command #:inputs (message #:type string)
+             #:run "echo" message
+             #:outputs (printed #:type stdout)
+             #:stdout captured-stdout)))
+
+(test-condition "command definitions with undefined inputs in their #:run arguments must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Undefined input ~a")
+  (macroexpand
+   '(command #:inputs (number #:type int)
+             #:run "echo" n)))
+
+(test-condition "command definitions with undefined prefix inputs in their #:run arguments must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Undefined input ~a")
+  (macroexpand
+   '(command #:inputs (number #:type int)
+             #:run "echo" ("-x" n))))
+
+(test-condition "command definitions with invalid #:run arguments must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Invalid command element ~a. Command elements must either be input identifiers or literal strings.")
+  (macroexpand
+   '(command #:run "echo" 42)))
 
 (test-assert "tolerate prefixed string arguments in command definitions"
   (command #:run "echo" ("-x" "foo")))
 
-(test-assert "command definitions with non-string prefixes in prefixed inputs must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Invalid prefix ~a. Prefixes must be strings."))))
-    (begin (macroexpand
-            '(command #:inputs (number #:type int)
-                      #:run "echo" (-x number)))
-           #f)))
-
-(test-assert "inputs with an invalid #:stage? parameter must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "Invalid #:stage? parameter ~a. #:stage? must either be #t or #f."))))
-    (begin (macroexpand
-            '(command #:inputs (file #:type File
-                                     #:stage? 42)
-                      #:run "cat" file))
-           #f)))
-
-(test-assert "inputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "#:other parameter not serializable to YAML"))))
-    (begin (macroexpand
-            '(command #:inputs (file #:type File
-                                     #:other '((secondaryFiles . ".fai")))
-                      #:run "cat" file))
-           #f)))
-
-(test-assert "outputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "#:other parameter not serializable to YAML"))))
-    (begin (macroexpand
-            '(command #:outputs (file #:type File
-                                      #:other '((secondaryFiles . ".fai")))
-                      #:run "cat" file))
-           #f)))
-
-(test-assert "commands with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
-  (guard (exception
-          (else (and (ccwl-violation? exception)
-                     (string=? (formatted-message-format exception)
-                               "#:other parameter not serializable to YAML"))))
-    (begin (macroexpand
-            '(command #:run "cat" file
-                      #:other '((secondaryFiles . ".fai"))))
-           #f)))
+(test-condition "command definitions with non-string prefixes in prefixed inputs must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Invalid prefix ~a. Prefixes must be strings.")
+  (macroexpand
+   '(command #:inputs (number #:type int)
+             #:run "echo" (-x number))))
+
+(test-condition "inputs with an invalid #:stage? parameter must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "Invalid #:stage? parameter ~a. #:stage? must either be #t or #f.")
+  (macroexpand
+   '(command #:inputs (file #:type File
+                            #:stage? 42)
+             #:run "cat" file)))
+
+(test-condition "inputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "#:other parameter not serializable to YAML")
+  (macroexpand
+   '(command #:inputs (file #:type File
+                            #:other '((secondaryFiles . ".fai")))
+             #:run "cat" file)))
+
+(test-condition "outputs with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "#:other parameter not serializable to YAML")
+  (macroexpand
+   '(command #:outputs (file #:type File
+                             #:other '((secondaryFiles . ".fai")))
+             #:run "cat" file)))
+
+(test-condition "commands with #:other parameters that fail to evaluate must raise a &ccwl-violation condition"
+  (ccwl-violation-with-message?
+   "#:other parameter not serializable to YAML")
+  (macroexpand
+   '(command #:run "cat" file
+             #:other '((secondaryFiles . ".fai")))))
 
 (test-eq "construct-type-syntax on primitive types"
   'File
-- 
cgit v1.2.3