[enhancement] allow custom assertions in xqsuite tests

Add new functions test:fail#3 and test:fail#4 to XQSuite.
Calling this function inside a XQSuite test function will
stop execution by throwing a special error `test:failure`.
This error is caught and handled as a failure allowing to
create arbitrary custom assertions and the ability to provide
specific error messages.

Works in both XQuery and jUnit context.
In jUnit you will only be presented with the serialized
expected and actual values.

For an example custom assertion see custom-assertion.xqm.

Author: line-o

exist-core/src/main/resources/org/exist/xquery/lib/xqsuite/xqsuite.xql

@@ -138,6 +138,23 @@ declare function test:suite(
         </testsuites>
 };
 
+declare function test:fail ($expected as item()*, $actual as item()*, $message as xs:string) as empty-sequence() {
+    test:fail($expected, $actual, $message, "custom-assertion-failure")
+};
+
+declare function test:fail (
+    $expected as item()*,
+    $actual as item()*,
+    $message as xs:string,
+    $type as xs:string
+) as empty-sequence() {
+    error(xs:QName("test:failure"), $message, map {
+        "expected": $expected,
+        "actual": $actual,
+        "type": $type
+    })
+};
+
 (:~
  : Find functions having the given annotation and call the callback function.
  :)
@@ -384,6 +401,32 @@ declare %private function test:test(
                         else(),
                         test:print-result($meta, $result, $assertResult)
                     )
+            } catch test:failure {
+                (: when test:fail was called :)
+                (: expected and actual can be of any type including functional ones :)
+                let $serialized-expected := serialize($err:value?expected, map {"method": "adaptive"})
+                let $serialized-actual := serialize($err:value?actual, map {"method": "adaptive"})
+
+                return (
+                    if (not(empty($test-failure-function))) then
+                        $test-failure-function(
+                            test:get-test-name($meta),
+                            (: expected :)
+                            map { "value": $serialized-expected },
+                            (: actual :)
+                            map { "result": $serialized-actual }
+                        )
+                    else ()
+                    ,
+                    test:print-result(
+                        $meta,
+                        $serialized-actual,
+                        <report>
+                            <failure message="{ $err:description }" type="{$err:value?type}" />
+                            <output>{ $serialized-actual }</output>
+                        </report>
+                    )
+                )
             } catch * {
                 if ($assertError) then
                     if (

exist-core/src/test/xquery/xqsuite/custom-assertion.xqm

@@ -0,0 +1,61 @@
+xquery version "3.1";
+
+(:~
+ : Some tests on features of the test suite itself.
+ :)
+module namespace ca="http://exist-db.org/xquery/test/xqsuite/custom-assertion";
+
+import module namespace test="http://exist-db.org/xquery/xqsuite"
+    at "resource:org/exist/xquery/lib/xqsuite/xqsuite.xql";
+
+declare variable $ca:var := map {"a": 1, "b": 2};
+
+declare
+    %test:assertEquals("Key 'b' is missing", "map-assertion-failure")
+function ca:missing-key-default-type() as item()* {
+    try {
+        ca:map-assertion($ca:var, map {"a": 1, "c": 3})
+    }
+    catch test:failure {
+        $err:description, $err:value?type
+    }
+};
+
+declare
+    %test:assertEquals("Value mismatch for key 'b'", "custom-assertion-failure")
+function ca:wrong-value-custom-type() as item()* {
+    try {
+        ca:map-assertion($ca:var, map {"a": 1, "b": 3})
+    }
+    catch test:failure {
+        $err:description, $err:value?type
+    }
+};
+
+declare
+    %test:assertEquals("Type mismatch", "type-mismatch")
+function ca:type-mismatch-custom-type() as item()* {
+    try {
+        ca:map-assertion($ca:var, [1,2])
+    }
+    catch test:failure {
+        $err:description, $err:value?type
+    }
+};
+
+declare %private
+function ca:map-assertion ($expected as map(*), $actual as item()*) as item()* {
+    if (exists($actual) and count($actual) eq 1  and $actual instance of map(*))
+    then (
+        for-each(map:keys($expected), function ($key as xs:anyAtomicType) {
+            if (not(map:contains($actual, $key)))
+            then test:fail($expected, $actual, "Key '" || $key || "' is missing", "map-assertion-failure")
+            else if ($expected($key) ne $actual($key))
+            then test:fail($expected, $actual, "Value mismatch for key '" || $key || "'")
+            else ()
+        })
+        ,
+        true()
+    )
+    else test:fail($expected, $actual, "Type mismatch", "type-mismatch")
+};