Clean up

Clean up

xquery version "3.1";

(:~
 : Origami μ-templates
 :)

module namespace μ = 'http://xokomola.com/xquery/origami/μ';

declare function μ:xml($mu as item()*)
as node()*
{
    μ:to-xml($mu, μ:qname-resolver())
};

declare function μ:xml($mu as item()*, $name-resolver as function(*))
as node()*
{
    μ:to-xml($mu, $name-resolver)
};

declare function μ:json($mu as item()*)
as xs:string
{
    μ:json($mu, function($name) { $name })
};

declare function μ:json($mu as item()*, $name-resolver as function(*))
as xs:string
{
    serialize(
        μ:to-json(if (count($mu) gt 1) then array { $mu } else $mu, $name-resolver),
        map { 'method': 'json' }
    )
};

declare function μ:apply($mu as item()*)
as item()*
{
    μ:apply($mu, [])
};

declare function μ:apply($mu as item()*, $args as item()*)
as item()*
{
    let $args := if ($args instance of array(*)) then $args else [ $args ]
    for $item in $mu
    return
        μ:to-apply($item, $args)
};

declare %private function μ:to-apply($mu as item(), $args as array(*))
as item()*
{
    typeswitch ($mu)
    case array(*)
    return
        let $name := array:head($mu)
        return
            if (empty($name)) then
                for $item in μ:seq(array:tail($mu)) return μ:to-apply($item, $args)
            else
                array:fold-left($mu, [],
                    function($a,$b) {
                        if (empty($b)) then
                            $a
                        else
                            array:append($a, for $item in $b return μ:to-apply($item, $args))
                    }
                )
    case map(*)
    return
        map:for-each($mu,
            function($k,$v) {
                typeswitch ($v)
                case function(*)
                return map:entry($k, apply($v, $args))
                default
                return $v
            }
        )
    case function(*)
    return for $item in apply($mu, $args) return μ:to-apply($item, $args)
    default return $mu
};

declare function μ:mu($xml)
as item()*
{
    μ:from-xml($xml)
};

declare %private function μ:to-json($mu as item()*, $name-resolver as function(*))
as item()*
{
    for $item in $mu
    return
        typeswitch ($item)
        case array(*)
        return
            array:fold-left($item, [],
                function($a,$b) {
                    if (count($b) gt 1) then
                        (: splice the sequence into the array to avoid JSON
                         : serialization error :)
                        array:join((
                            $a,
                            fold-left($b, [],
                                function($c,$d) {
                                    array:append($c, μ:to-json($d, $name-resolver))
                                })
                        ))
                    else
                        array:append($a, μ:to-json($b, $name-resolver))
                }
            )
        case map(*)
        return
            map:merge(
                map:for-each($item,
                    function($a,$b) {
                        map:entry($a, μ:to-json($b, $name-resolver)) }))
        case function(*) return ()
        case node() return μ:from-xml($item)
        default return $item
};

declare %private function μ:from-xml($xml)
as item()*
{
    for $node in $xml
    return
        typeswitch($node)
        case array(*)
        return
            array:fold-left($node, [],
                function($a,$b) { array:append($a, μ:from-xml($b)) }
            )
        case element()
        return
            array {
                name($node),
                if ($node/@*) then
                    map:merge((
                        for $a in $node/@*
                        return map:entry(name($a), data($a))))
                else
                    (),
                μ:from-xml($node/node())
            }
        case comment() | processing-instruction() return ()
        case text() return string($node)
        default return $node
};

declare %private function μ:to-xml($mu as item()*, $name-resolver as function(*))
as node()*
{
    for $item in $mu
    return
        typeswitch ($item)
        case array(*) return μ:to-element($item, $name-resolver)
        case map(*) return  μ:to-attributes($item, $name-resolver)
        case function(*) return ()
        case empty-sequence() return ()
        case node() return $item
        default return text { $item }
};

declare %private function μ:to-element($mu as array(*), $name-resolver as function(*))
as item()*
{
    if (array:size($mu) gt 0) then
        let $name := array:head($mu)
        return
            if (empty($name)) then
                array:fold-left(
                    array:tail($mu),
                    (),
                    function($n, $i) {
                        ($n, μ:to-xml($i, $name-resolver))
                    }
                )
            else
                element { $name-resolver($name) } {
                    array:fold-left(
                        array:tail($mu),
                        (),
                        function($n, $i) {
                            ($n, μ:to-xml($i, $name-resolver))
                        }
                    )
                }
    else
        ()
};

declare %private function μ:to-attributes($mu as map(*), $name-resolver as function(*))
as attribute()*
{
    map:for-each($mu,
        function($k,$v) {
            if (not(starts-with($k,'μ:'))) then
                attribute { $name-resolver($k) } {
                    data(
                        typeswitch ($v)
                        case array(*) return $v
                        case map(*) return $v
                        case function(*) return ()
                        default return $v
                    )
                }
            else
                ()
        })
};

declare function μ:qname-resolver()
as function(xs:string) as xs:QName
{
    μ:qname(?, μ:ns(), ())
};

declare function μ:qname-resolver($ns-map as map(*))
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, ())
};

declare function μ:qname-resolver($ns-map as map(*), $default-ns as xs:string)
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, $default-ns)
};

(:~
 : As XQuery doesn't allow access to namespace nodes (as XSLT does)
 : construct them indirectly via QName#2.
 :)
declare function μ:qname($name as xs:string, $ns-map as map(*))
as xs:QName
{
    μ:qname($name, $ns-map, ())
};

declare function μ:qname($name as xs:string, $ns-map as map(*), $default-ns as xs:string?)
as xs:QName
{
    if (contains($name, ':')) then
        let $prefix := substring-before($name,':')
        let $local := substring-after($name, ':')
        let $ns := $ns-map($prefix)
        return
            if ($ns = $default-ns) then
                QName($ns, $local)
            else
                QName($ns, concat($prefix,':',$local))
    else
        if ($default-ns) then
            QName($default-ns, $name)
        else
            QName((), $name)
};

declare function μ:ns()
as map(*)
{
    μ:ns(map {})
};

declare function μ:ns($ns-map as map(*))
as map(*)
{
    map:merge((
        $ns-map,
        for $ns in doc(concat(file:base-dir(),'/nsmap.xml'))/nsmap/*
        return
            map:entry(string($ns/@prefix), string($ns/@uri))
    ))
};

declare function μ:mix($mu)
as array(*)
{
    [(), $mu]
};

declare function μ:head($mu as array(*)?)
as item()*
{
    if (empty($mu)) then
        ()
    else
        array:head($mu)
};

declare function μ:tail($mu as array(*)?)
as item()*
{
    if (empty($mu)) then
        ()
    else
        tail(μ:seq($mu))
};

(:~
 : Remove level of array and change it into a normal sequence.
 :)
declare function μ:seq($mu as array(*))
as item()*
{
    typeswitch ($mu)
        case array(*)
            return array:fold-left($mu, (), function($a,$b) { ($a,$b) })
        default
            return $mu
};

declare function μ:content($mu)
as item()*
{
    typeswitch($mu)
    case array(*)
    return
        let $c := array:tail($mu)
        return
            if (array:head($c) instance of map(*)) then
                array:tail($c)
            else
                $c
    default
    return $mu/node()
};

xquery version "3.1";

(:~
 : Origami μ-templates
 :)

module namespace μ = 'http://xokomola.com/xquery/origami/μ';

declare function μ:xml($items as item()*)
as node()*
{
    μ:to-xml($items, μ:qname-resolver())
};

declare function μ:xml($items as item()*, $name-resolver as function(*))
as node()*
{
    μ:to-xml($items, $name-resolver)
};

declare function μ:json($items as item()*)
as xs:string
{
    μ:json($items, function($name) { $name })
};

declare function μ:json($items as item()*, $name-resolver as function(*))
as xs:string
{
    serialize(
        μ:to-json(if (count($items) gt 1) then array { $items } else $items, $name-resolver),
        map { 'method': 'json' }
    )
};

declare function μ:apply($items as item()*)
as item()*
{
    μ:apply($items, [])
};

declare function μ:apply($items as item()*, $args as item()*)
as item()*
{
    let $args := if ($args instance of array(*)) then $args else [ $args ]
    for $item in $items
    return
        μ:to-apply($item, $args)
};

declare %private function μ:to-apply($item as item(), $args as array(*))
as item()*
{
    typeswitch ($item)
    case array(*)
    return
        let $name := array:head($item)
        return
            if (empty($name)) then
                for $item in μ:seq(array:tail($item)) return μ:to-apply($item, $args)
            else
                array:fold-left($item, [],
                    function($a,$b) {
                        if (empty($b)) then
                            $a
                        else
                            array:append($a, for $item in $b return μ:to-apply($item, $args))
                    }
                )
    case map(*)
    return
        map:for-each($item,
            function($k,$v) {
                typeswitch ($v)
                case function(*)
                return map:entry($k, apply($v, $args))
                default
                return $v
            }
        )
    case function(*)
    return for $item in apply($item, $args) return μ:to-apply($item, $args)
    default return $item
};

declare function μ:mu($xml)
as item()*
{
    μ:from-xml($xml)
};

declare %private function μ:to-json($items as item()*, $name-resolver as function(*))
as item()*
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*)
        return
            array:fold-left($item, [],
                function($a,$b) {
                    if (count($b) gt 1) then
                        (: splice the sequence into the array to avoid JSON
                         : serialization error :)
                        array:join((
                            $a,
                            fold-left($b, [],
                                function($c,$d) {
                                    array:append($c, μ:to-json($d, $name-resolver))
                                })
                        ))
                    else
                        array:append($a, μ:to-json($b, $name-resolver))
                }
            )
        case map(*)
        return
            map:merge(
                map:for-each($item,
                    function($a,$b) {
                        map:entry($a, μ:to-json($b, $name-resolver)) }))
        case function(*) return ()
        case node() return μ:from-xml($item)
        default return $item
};

declare %private function μ:from-xml($xml)
as item()*
{
    for $node in $xml
    return
        typeswitch($node)
        case array(*)
        return
            array:fold-left($node, [],
                function($a,$b) { array:append($a, μ:from-xml($b)) }
            )
        case element()
        return
            array {
                name($node),
                if ($node/@*) then
                    map:merge((
                        for $a in $node/@*
                        return map:entry(name($a), data($a))))
                else
                    (),
                μ:from-xml($node/node())
            }
        case comment() | processing-instruction() return ()
        case text() return string($node)
        default return $node
};

declare %private function μ:to-xml($items as item()*, $name-resolver as function(*))
as node()*
{
    for $item in $items
    return
        typeswitch ($item)
        case array(*) return μ:to-element($item, $name-resolver)
        case map(*) return  μ:to-attributes($item, $name-resolver)
        case function(*) return ()
        case empty-sequence() return ()
        case node() return $item
        default return text { $item }
};

declare %private function μ:to-element($item as array(*), $name-resolver as function(*))
as item()*
{
    if (array:size($item) gt 0) then
        let $name := array:head($item)
        return
            if (empty($name)) then
                array:fold-left(
                    array:tail($item),
                    (),
                    function($n, $i) {
                        ($n, μ:to-xml($i, $name-resolver))
                    }
                )
            else
                element { $name-resolver($name) } {
                    array:fold-left(
                        array:tail($item),
                        (),
                        function($n, $i) {
                            ($n, μ:to-xml($i, $name-resolver))
                        }
                    )
                }
    else
        ()
};

declare %private function μ:to-attributes($item as map(*), $name-resolver as function(*))
as attribute()*
{
    map:for-each($item,
        function($k,$v) {
            if (not(starts-with($k,'μ:'))) then
                attribute { $name-resolver($k) } {
                    data(
                        typeswitch ($v)
                        case array(*) return $v
                        case map(*) return $v
                        case function(*) return ()
                        default return $v
                    )
                }
            else
                ()
        })
};

declare function μ:qname-resolver()
as function(xs:string) as xs:QName
{
    μ:qname(?, μ:ns(), ())
};

declare function μ:qname-resolver($ns-map as map(*))
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, ())
};

declare function μ:qname-resolver($ns-map as map(*), $default-ns as xs:string)
as function(xs:string) as xs:QName
{
    μ:qname(?, $ns-map, $default-ns)
};

(:~
 : As XQuery doesn't allow access to namespace nodes (as XSLT does)
 : construct them indirectly via QName#2.
 :)
declare function μ:qname($name as xs:string, $ns-map as map(*))
as xs:QName
{
    μ:qname($name, $ns-map, ())
};

declare function μ:qname($name as xs:string, $ns-map as map(*), $default-ns as xs:string?)
as xs:QName
{
    if (contains($name, ':')) then
        let $prefix := substring-before($name,':')
        let $local := substring-after($name, ':')
        let $ns := $ns-map($prefix)
        return
            if ($ns = $default-ns) then
                QName($ns, $local)
            else
                QName($ns, concat($prefix,':',$local))
    else
        if ($default-ns) then
            QName($default-ns, $name)
        else
            QName((), $name)
};

declare function μ:ns()
as map(*)
{
    μ:ns(map {})
};

declare function μ:ns($ns-map as map(*))
as map(*)
{
    map:merge((
        $ns-map,
        for $ns in doc(concat(file:base-dir(),'/nsmap.xml'))/nsmap/*
        return
            map:entry(string($ns/@prefix), string($ns/@uri))
    ))
};

declare function μ:mixed($nodes)
as array(*)
{
    [(), $nodes]
};

declare function μ:head($mu as array(*)?)
as item()*
{
    if (empty($mu)) then
        ()
    else
        array:head($mu)
};

declare function μ:tail($mu as array(*)?)
as item()*
{
    if (not(empty($mu))) then
        tail(μ:seq($mu))
    else
        ()
};

(:~
 : Remove level of array and change it into a normal sequence.
 :)
declare function μ:seq($mu as array(*))
as item()*
{
    typeswitch ($mu)
        case array(*)
            return array:fold-left($mu, (), function($a,$b) { ($a,$b) })
        default
            return $mu
};

declare function μ:content($mu)
as item()*
{
    typeswitch($mu)
    case array(*)
    return
        let $c := array:tail($mu)
        return
            if (array:head($c) instance of map(*)) then
                array:tail($c)
            else
                $c
    default
    return $mu/node()
};


add expath file tests

add expath file tests

declare namespace _ = "http://xqerl.org/xquery/test_cases";
declare namespace x = "http://xqerl.org/xquery";

(: declare option db:chop 'false'; :)

declare variable $catalog := doc("/git/zadean/qt3tests/catalog.xml");

(: String helpers :)

declare variable $_:n := '
';
declare variable $_:cn := ',
';
declare variable $_:dn := '.
';
declare variable $_:scn := ';
';

declare function _:join-nl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:n) };

declare function _:join-cnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:cn) };

declare function _:join-dnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:dn) };

declare function _:join-scnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:scn) };

(: All tests must pass :)
declare function _:all-of($result) as xs:string
{
  "   case lists:all(fun({comment,_}) -> true; (_) -> false end, ["||$_:n||
  (for $t in $result/* return _:print-result($t)) => _:join-cnl() ||
  "   ]) of "||$_:n||
  "      true -> {comment, ""all-of""};" ||$_:n||
  "      _ -> false " ||$_:n||
  "   end"
};

(: Any test must pass :)
declare function _:any-of($result) as xs:string
{
  "   case lists:any(fun({comment,_}) -> true; (_) -> false end, ["||$_:n||
  (for $t in $result/* return _:print-result($t)) => _:join-cnl() ||
  "   ]) of "||$_:n||
  "      true -> {comment, ""any-of""};" ||$_:n||
  "      _ -> false " ||$_:n||
  "   end"
};

(: Negate test results by returning the comment text :)
declare function _:not($result) as xs:string
{
  "   case ("||_:print-result($result/*[1])||") of "||$_:n||
  "      {comment,C6} -> C6; _ -> {comment,ok}"||$_:n||
  "   end"
};

(: Empty sequence returned, parameter is unused :)
declare function _:assert-empty($null) as xs:string
{
  "   case xqerl_test:assert_empty(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: True returned, parameter is unused :)
declare function _:assert-true($null) as xs:string
{
  "   case xqerl_test:assert_true(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: False returned, parameter is unused :)
declare function _:assert-false($null) as xs:string
{
  "   case xqerl_test:assert_false(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Result count check :)
declare function _:assert-count($result) as xs:string
{
  let $ec := """"||$result||""""
  return
  "   case xqerl_test:assert_count(Res, "||$ec||") of " ||$_:n||
  "      true -> {comment, ""Count correct""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Check the atomized value. Space can be normalized :)
declare function _:assert-string-value($result) as xs:string
{
  let $text := $result/text()
    , $norm := if ($result/@normalize-space = "true") then true() else false()
    , $normText := if ($norm) then normalize-space($text) else $text
    , $mask := _:mask-string($normText)
    , $fun  := if ($norm) then "assert_norm_string_value" else "assert_string_value"
  return
    "   case xqerl_test:"||$fun||"(Res, "||$mask||") of " ||$_:n||
    "      true -> {comment, ""String correct""};" ||$_:n||
    "      {false, F} -> F " ||$_:n||
    "   end"
};

(: Error expected :)
declare function _:error($result) as xs:string
{
  let $ec := """"||$result/@code||""""
  return
  "   case xqerl_test:assert_error(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct error""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Values equal :)
declare function _:assert-eq($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_eq(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Correct type :)
declare function _:assert-type($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_type(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct type""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Value exists or is true :)
declare function _:assert($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct results""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Some combination of values in any order :)
declare function _:assert-permutation($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_permutation(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct permutation""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Values are deep-equal :)
declare function _:assert-deep-eq($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_deep_eq(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Deep equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: XML is deep-equal :)
declare function _:assert-xml($result) as xs:string
{
  let $ec := if ($result/@file) then
              "{file, filename:join(__BaseDir, """||string($result/@file)||""")}"
             else
               _:mask-string($result/data())
  return
  "   case xqerl_test:assert_xml(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""XML Deep equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Runs regex match on results :)
declare function _:assert-serialization-matches($result) as xs:string
{
  let $ec := _:mask-string($result/text())
  let $fl := _:mask-string($result/@flags)
  return
  "   case xqerl_test:assert_serialization_match(Res,<<"||$ec||"/utf8>>,<<"||$fl||">>) of " ||$_:n||
  "      true -> {comment, ""Correct serialization""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Catch-all :)
declare function _:assert-unknown($result) as xs:string
{
  "   case (catch ct:fail([" ||
  _:mask-string(fn:string($result)) ||
  ", Res])) of _ -> false end"
};

(: Call correct string function based on node name of result :)
declare function _:print-result($result) as xs:string
{
  let $name := local-name($result)
  let $f :=
    if ($name = "all-of") then _:all-of#1 else
    if ($name = "any-of") then _:any-of#1 else
    if ($name = "not") then _:not#1 else
    if ($name = "assert-empty") then _:assert-empty#1 else
    if ($name = "assert-true") then _:assert-true#1 else
    if ($name = "assert-false") then _:assert-false#1 else
    if ($name = "assert-count") then _:assert-count#1 else
    if ($name = "assert-string-value") then _:assert-string-value#1 else
    if ($name = ("error","assert-serialization-error")) then _:error#1 else
    if ($name = "assert-eq") then _:assert-eq#1 else
    if ($name = "assert-type") then _:assert-type#1 else
    if ($name = "assert") then _:assert#1 else
    if ($name = "assert-permutation") then _:assert-permutation#1 else
    if ($name = "assert-deep-eq") then _:assert-deep-eq#1 else
    if ($name = "assert-xml") then _:assert-xml#1 else
    if ($name = "serialization-matches") then _:assert-serialization-matches#1 else
    _:assert-unknown#1
  return
  $f($result)
};

(: Returns a test-case text as either being skipped due to some feature
   restriction, or the actual test-case text.
   Has all the skipping logic which could be moved out. :)
declare function _:print-testcase($test-case) as xs:string
{
  let $inscope-schema-envs :=
    ($test-case/../*:environment[*:source[@validation]]/@name union
     $catalog/*:catalog/*:environment[*:source[@validation]]/@name)
    , $name := $test-case/@name
    , $deps := $test-case//*:dependency  |
               $test-case/parent::*/*:dependency
    , $env  := $test-case/*:environment/@ref/string()
    , $f    := function(){ _:print-testcase2($test-case, $name, $env) }
  return
  "'"||$name||"'(Config) ->"||$_:n||
  "   __BaseDir = ?config(base_dir, Config),"||$_:n||
  (
    (: validation environments :)
    if ($env = $inscope-schema-envs) then
    "   {skip,""Validation Environment""}"
    else if ($test-case/*:environment/*:schema) then
    "   {skip,""Validation Environment""}"

    (: serialization feature :)
    (: else if (starts-with($test-case/../@name,"method-")) then
    "   {skip,""serialization feature""}"
    else if ($test-case/../@name = "fn-serialize") then
    "   {skip,""serialization feature""}" :)

    (: default-language :)
    else if ($deps[@type = "default-language" and @value != "en"]) then
    "   {skip,""default-language "||$deps[@type = "default-language"]/@value||" ""}"

    (: language :)
    else if ($deps[@type = "language" and @value != "en"]) then
      "   {skip,""language "||$deps[@type = "language"]/@value||" ""}"

    (: format-integer-sequence :)
    else if ($deps[@type = "format-integer-sequence" and
                   @value = ("一","α","Α")]) then
      "   {skip,""format-integer-sequence""}"

    (: XSD 1.1 stuff, Regex uses 1.1, the rest does not :)
    else if ($deps[@type = "xsd-version" and @value = "1.1"] and
                   not($test-case/../@name = ("fn-matches", "fn-matches.re")) ) then
      "   {skip,""XSD 1.1""}"
    else if ($deps[@type = "xsd-version" and @value = "1.0"] and
                   ($test-case/../@name = ("fn-matches", "fn-matches.re")) ) then
      "   {skip,""XSD 1.0 regex""}"

    (: unicode FULLY-NORMALIZED :)
    else if ($deps[@type = "unicode-normalization-form" and @value = "FULLY-NORMALIZED"
                   and not(exists(@satisfied)) ]) then
      "   {skip,""unicode-normalization-form FULLY-NORMALIZED""}"

    (: older unicode versions :)
    else if ($deps[@type = "unicode-version" and
                   @value = ("5.2", "6.0", "6.2", "7.0")]) then
      "   {skip,""unicode-version""}"

    (: spec examples with dependencies :)
    (: else if ($test-case/../@name = "app-spec-examples" and
                $test-case/@name = ('fo-test-fn-serialize-002','fo-test-fn-serialize-001')
            ) then
    "   {skip,""serialization feature""}" :)
    else if ($test-case/../@name = "app-spec-examples" and
                $test-case/@name = ('fo-test-fn-id-001','fo-test-fn-id-002',
                                    'fo-test-fn-element-with-id-001','fo-test-fn-element-with-id-002',
                                    'fo-test-fn-idref-001','fo-test-fn-idref-002')
            ) then
    "   {skip,""schemaAware""}"

    (: test case using environment instead of declare :)
    else if ($test-case/../@name eq "fn-static-base-uri" and
                $test-case/@name eq 'fn-static-base-15'
            ) then
    "   {skip,""static-base-uri environment""}"

    (: XML version :)
    else if ($deps[@type = "xml-version" and @value = "1.1"]) then
      "   {skip,""XML version 1.1""}"
    else if ($deps[@type = "xml-version" and @value = "1.0:4-"]) then
      "   {skip,""XML version 1.0:4-""}"

    (: spec :)
    else if (exists($deps[@type = "spec"])) then
      (
      let $d := $deps[@type = "spec"]
      let $v := $d/@value
      return
      if ($v = ("XQ10",
                "XQ10 XP20",
                "XP10 XQ10",
                "XP20 XP30 XQ10 XQ30",
                "XQ10 XP20 XQ30 XP30",
                "XP20 XQ10 XP30 XQ30",
                "XQ10 XQ30",
                "XQ30",
                "XQ30 XP30",
                "XP30 XQ30",
                "XP20",
                "XP20 XQ10",
                "XP20+",
                "XP30+")) then
        "   {skip,"""||$v[1]||"""}"

      (: features :)
      else if (exists($deps[@type = "feature"])) then
        let $d := $deps[@type = "feature"]
        let $v := $d/@value
        return
        if ($v = ("advanced-uca-fallback",
                  "staticTyping",
                  "schemaValidation",
                  "schemaImport",
                  "schemaAware",
                  "xpath-1.0-compatibility",
                  (: "serialization", :)
                  "namespace-axis",
                  "directory-as-collection-uri",
                  "typedData",
                  "schema-location-hint",
                  "olson-timezone")) then
          "   {skip,"""||$v[1]||"""}"
        else
          let $s := $d/@satisfied
          return
          if ($s = "true" and
              $v = ("fn-load-xquery-module",
                    "fn-transform-XSLT",
                    "fn-transform-XSLT30")) then
            "   {skip,"""||$v[1]||"""}"
          else if ($s = "false" and
              $v = ("serialization")) then
            "   {skip,"""||$v[1]||"""}"
          else
            $f()
      else
        $f()
    )
    (: features Duplicated due to if nesting :)
    else if (exists($deps[@type = "feature"])) then
      let $d := $deps[@type = "feature"]
      let $v := $d/@value
      return
      if ($v = ("advanced-uca-fallback",
                "staticTyping",
                "schemaValidation",
                "schemaImport",
                "schemaAware",
                "xpath-1.0-compatibility",
                (: "serialization", :)
                "namespace-axis",
                "directory-as-collection-uri",
                "typedData",
                "schema-location-hint",
                "olson-timezone")) then
        "   {skip,"""||$v[1]||"""}"
      else
        let $s := $d/@satisfied
        return
        if ($s = "true" and
            $v = ("fn-load-xquery-module",
                  "fn-transform-XSLT",
                  "fn-transform-XSLT30")) then
          "   {skip,"""||$v[1]||"""}"
        else if ($s = "false" and
            $v = ("serialization")) then
          "   {skip,"""||$v[1]||"""}"
        else
          $f()
    else
      $f()
  )
};

(: XQuery to run can be in a file, so read and input into text case module
   if need be.  :)
declare function _:get-query($test-case) as xs:string
{
  let $test := $test-case/*:test
  return
  "   Qry = "||
  (
    if ($test/@file) then
      resolve-uri($test/@file, base-uri($test-case)) =>
      (: BaseX fallback true for invalid XML characters :)
      (: file:read-text("utf-8",true())  => :)
      file:read-text("utf-8")   =>
      _:mask-string()
    else
      _:mask-string($test/text())
  )
};

(: Distinct list of used environments before skipping :)
declare function _:get-used-environments($test-cases) as xs:string*
{
  ($test-cases/*:environment/string(@name),
   $test-cases/*:environment/string(@ref)) => distinct-values()
};

(: The actual test-case text if being run :)
declare function _:print-testcase2($test-case, $name, $env)
{
  _:get-query($test-case) ||$_:cn||
  (: compile any imported modules, local imports will unload these :)
  (
    if ($test-case/*:module) then
      let $f := function($a)
                {
                  "   try xqerl_code_server:compile(filename:join(__BaseDir, """||
                  string($a/@file)||""")) catch _:_ -> ok end"
                }
      return
      ( reverse($test-case/*:module) ! $f(.) ) => _:join-cnl() || ',
'
    else
      ""
  ) ||
  (: handle any environment :)
  (
    if ($test-case/*:environment[@ref]) then
      "   {Env,Opts} = xqerl_test:handle_environment(environment('"||$env||"',__BaseDir)),"||$_:n||
      "   Qry1 = lists:flatten(Env ++ Qry),"||$_:n
    else if ($test-case/*:environment) then
      "   {Env,Opts} = xqerl_test:handle_environment("||
      string-join(_:print-local-environment($test-case))
      ||"),"||$_:n||
      "   Qry1 = lists:flatten(Env ++ Qry),"||$_:n
    else
      "   Qry1 = Qry,"||$_:n
  ) ||
  (: print final query :)
  "   io:format(""Qry1: ~p~n"",[Qry1]),"||$_:n||
  (: add options if there is an environment :)
  (
    if ($test-case/*:environment) then
      "   Res = try Mod = xqerl_code_server:compile(filename:join(__BaseDir, """||$name||".xq""), Qry1),
"||
      "             xqerl:run(Mod,Opts) of D -> D catch _:E -> E end,"||$_:n
    else
      "   Res = try Mod = xqerl_code_server:compile(filename:join(__BaseDir, """||$name||".xq""), Qry1),
"||
      "             xqerl:run(Mod) of D -> D catch _:E -> E end,"||$_:n
  ) ||
  "   Out = " || _:print-result($test-case/*:result/*) ||',
'||
  "   case Out of"||$_:n||
  "      {comment, C} -> {comment, C};"||$_:n||
  "      Err -> ct:fail(Err)"||$_:n||
  "   end"
};

(: Global module environment that can be used in any test.
   $is-local is to flag the file location of resources :)
declare function _:print-environment($env,$is-local) as xs:string
{
  let $name            := $env/@name
  let $sources         := $env/*:source
  let $schemas         := $env/*:schema
  let $collections     := $env/*:collection
  let $static-base-uri := $env/*:static-base-uri
  let $params          := $env/*:param[@declared = "true"]
  let $vars            := $env/*:param[@declared = "false" or not(exists(@declared))]
  let $namespaces      := $env/*:namespace
  let $resources       := $env/*:resource
  let $modules         := $env/*:module | $env/../*:module
  let $dec-formats     := $env/*:decimal-format
  let $def-collation   := $env/*:collation[@default = 'true']
  return
  "environment('"||$name||"',__BaseDir) ->" || $_:n ||
  "["||
  _:do-default-collation($def-collation) ||
  "{'decimal-formats', ["|| _:do-decimal-formats($dec-formats) ||"]}"|| $_:cn ||
  "{sources, ["|| _:do-sources($sources, $is-local) ||"]}"|| $_:cn ||
  "{collections, [" || _:do-collections($collections, $is-local) ||"]}"|| $_:cn ||
  "{'static-base-uri', ["||_:do-static-base-uri($static-base-uri)||"]}"|| $_:cn ||
  "{params, ["|| _:do-name-as-select($params) ||"]}"|| $_:cn ||
  "{vars, ["|| _:do-name-as-select($vars) ||"]}"|| $_:cn ||
  "{namespaces, ["|| _:do-uri-prefix($namespaces) ||"]},"|| $_:n ||
  "{schemas, ["|| _:do-file-uri($schemas, $is-local) || "]}" || $_:cn ||
  "{resources, ["|| _:do-file-uri-type($resources, $is-local) || "]}" || $_:cn ||
  "{modules, ["|| _:do-file-uri($modules, $is-local) || "]}" || $_:n ||
  "]"
};

(: Local environments are only used in a single test, so inline :)
declare function _:print-local-environment($env as item()*) as item()*
{
  let $sources         := $env/*:environment/*:source
  let $schemas         := $env/*:environment/*:schema
  let $collections     := $env/*:environment/*:collection
  let $static-base-uri := $env/*:environment/*:static-base-uri
  let $params          := $env/*:environment/*:param[@declared = "true"]
  let $vars            := $env/*:environment/*:param[@declared = "false" or not(exists(@declared))]
  let $namespaces      := $env/*:environment/*:namespace
  let $resources       := $env/*:environment/*:resource
  let $modules         := $env/*:environment/*:module | $env/*:module
  let $dec-formats     := $env/*:environment/*:decimal-format
  let $def-collation   := $env/*:environment/*:collation[@default = 'true']
  let $context-item    := $env/*:environment/*:context-item

  return (
  "["||
  _:do-default-collation($def-collation) ||
  "{'decimal-formats', ["|| _:do-decimal-formats($dec-formats) ||"]}"|| $_:cn ||
  "{sources, ["|| _:do-sources($sources, true()) ||"]}"|| $_:cn ||
  "{collections, [" || _:do-collections($collections, true()) ||"]}"|| $_:cn ||
  "{'static-base-uri', ["||_:do-static-base-uri($static-base-uri)||"]}"|| $_:cn ||
  "{'context-item', ["||_:mask-string($context-item/@select)||"]}"|| $_:cn ||
  "{vars, ["  || _:do-name-as-select($vars) ||"]}"|| $_:cn ||
  "{params, ["|| _:do-name-as-select($params) ||"]}"|| $_:cn ||
  "{namespaces, ["|| _:do-uri-prefix($namespaces) ||"]}"|| $_:cn ||
  "{schemas, ["   || _:do-file-uri($schemas,true()) || "]}" || $_:cn ||
  "{resources, [" || _:do-file-uri-type($resources,true()) || "]}" || $_:cn ||
  "{modules, ["   || _:do-file-uri($modules,true()) || "]}" || $_:n ||
  "]")
};

declare function _:do-decimal-formats($dec-formats) as xs:string?
{
  (
    for $res in $dec-formats
    let $name :=
      (let $q := fn:resolve-QName($res/@name,$res)
       return
       if (namespace-uri-from-QName($q) = 'http://www.w3.org/2010/09/qt-fots-catalog') then
         $res/@name
       else if (not(exists($res/@name))) then
         ""
       else
         ("Q{"||namespace-uri-from-QName($q)||"}" || local-name-from-QName($q))
      )
    return
    "{"""|| $name ||""",["||
    (for $a in $res/@*[name(.) != "name"]
     return
     "{'"||name($a)||"',"||_:mask-string($a)||"}"
    ) => _:join-cnl() ||"]}"
  ) => _:join-cnl()
};

declare function _:do-default-collation($def-collation) as xs:string?
{
  if (exists($def-collation)) then
    "{'default-collation', """||$def-collation/@uri||"""}"|| $_:cn
  else ()
};

declare function _:do-sources($sources, $is-local) as xs:string?
{
  (
    for $res in $sources
    let $head := if ($is-local) then
                   "{filename:join(__BaseDir, """||string($res/@file)||"""), """||$res/@role||""","
                 else
                   "{filename:join(__BaseDir, ""../"||string($res/@file)||"""), """||$res/@role||""","
    let $uri := $res/@uri
    let $tail := if (exists($uri)) then
                   (: special case for fn:doc tests with relative uris :)
                   if (resolve-uri($uri, base-uri($res)) eq $uri) then
                     """"||$uri||"""}"
                   else
                     "filename:join(__BaseDir, """||string($uri)||""")}"
                 else
                   "[]}"
    return
    $head || $tail
  ) => _:join-cnl()
};

declare function _:do-collections($collections, $is-local) as xs:string?
{
  (
    for $res in $collections
    return
    "{"""||$res/@uri||""",["||
    (
      for $s in $res/*:source
      return
      if ($is-local) then
      "{src,filename:join(__BaseDir, """||string($s/@file)||""")}"
      else
      "{src,filename:join(__BaseDir, ""../"||string($s/@file)||""")}" ,
      for $s in $res/*:query
      return
      "{query,__BaseDir,"||_:mask-string($s)||"}"
    ) => _:join-cnl()
    ||"]}"
  ) => _:join-cnl()
};

declare function _:do-static-base-uri($static-base-uri) as xs:string?
{
  let $uri := $static-base-uri/@uri
  return
  if ($uri eq '#UNDEFINED') then
    "{[]}"
  else if (empty($uri)) then
    ""
  else
    "{"""||$uri||"""}"
};

declare function _:do-name-as-select($vars) as xs:string?
{
  let $f := function($a)
            {
              "{"""||$a/@name||""","""||
              $a/@as||""","||
              _:mask-string($a/@select)||"}"
            }
  return
  ( $vars ! $f(.) ) => _:join-cnl()
};

declare function _:do-uri-prefix($namespaces) as xs:string?
{
  let $f := function($a)
            {
              "{"""||$a/@uri||""","""||$a/@prefix||"""}"
            }
  return
  ( $namespaces ! $f(.) ) => _:join-cnl()
};

declare function _:do-file-uri($files, $is-local) as xs:string?
{
  let $f := function($a)
          {
            (
              if ($is-local) then
                "{filename:join(__BaseDir, """
              else
                "{filename:join(__BaseDir, ""../"
            ) ||
            string($a/@file) ||
            """),""" ||
            $a/@uri||"""}"
          }
  return
  ( reverse($files) ! $f(.) ) => _:join-cnl()
};

declare function _:do-file-uri-type($files, $is-local) as xs:string?
{
  let $f := function($a)
          {
            "{""" || string($a/@media-type) || """, " ||
            (
              if ($is-local) then
                "filename:join(__BaseDir, """
              else
                "filename:join(__BaseDir, ""../"
            ) ||
            string($a/@file) ||
            """),""" ||
            $a/@uri||"""}"
          }
  return
  ( reverse($files) ! $f(.) ) => _:join-cnl()
};

(:~ Mask a string for Erlang :)
declare function _:mask-string($text as xs:string*) as xs:string
{
  """" || (
    $text => string-join()
          => replace('\','\\','q')
          => replace("""","\""",'q')
  ) || """"
};

declare function _:mask-name($text as xs:string) as xs:string
{
  $text => replace('-','_','q')
        => replace(".","_",'q')
};

declare function _:mod_exports($testCases)
{
  let $f := function($a){"-export(['"||$a/@name||"'/1])."}
  return _:join-nl(($testCases ! $f(.)))
};

declare function _:mod_all($testCases, $single)
{
  (: tests that step on each other need to be done in a singleton group :)
  let $max := if ($single) then 1000 else 24
  let $f  := function($a){"'"||$a/@name||"'"}
  let $grpd :=
      for $tc at $y in $testCases
      group by $z := $y idiv $max
      return
      [$z, $tc]
  return
  "all() -> ["||$_:n||
  ($grpd ! ("   {group, group_" || .?1 || "}" ) ) => _:join-cnl() ||$_:n||
  "   ]." ||$_:n||
  "groups() -> ["||$_:n||
  ($grpd ! ("   {group_" || .?1 ||
    (
      if ($single) then
        ", [], ["
      else
        ", [parallel], ["
    )
  ||$_:n||
  (.?2 ! ("    " || $f(.)) ) => _:join-cnl()
  ||
  "]}" ) ) => _:join-cnl()
  ||"]."
};

(: Return all used environments if any :)
declare function _:mod_environments($globals, $locals, $usedEnvironments)
{
  let $g := ($globals[@name = $usedEnvironments] ! _:print-environment(.,false()))
  let $l := ($locals[@name = $usedEnvironments] ! _:print-environment(.,true()))
  let $a := ($g,$l)
  return
  if (empty($a)) then "" else _:join-scnl(($g,$l)) || "."
};

(: Erlang SUITE :)

(: All test case sets from catalog :)
let $globalEnvs         := $catalog/*:catalog/*:environment
  , $globalBaseUri      := base-uri($catalog)
(: Each test case set from catalog :)
(: The parallel pragma causes the list to spawn a process for each value :)
(: 'unordered' allows the processes to return in any order :)
for $catalogTestSet     in
    (# x:parallel unordered #){
      $catalog/*:catalog/*:test-set(: [@name = "fn-static-base-uri"] :)
    }
let $catalogTestSetFile := $catalogTestSet/@file
  , $catalogTestSetName := _:mask-name($catalogTestSet/@name) => trace()
  , $testSetFile        := resolve-uri($catalogTestSetFile, $globalBaseUri)
  , $testSetDir         := substring-before($catalogTestSetFile,"/")
  , $testSetDoc         := doc($testSetFile)
  , $localEnvs          := $testSetDoc/*:test-set/*:environment
  , $SUITE              := $catalogTestSetName||"_SUITE"
  , $suiteFile          := resolve-uri($catalogTestSetName)||"_SUITE.erl"
  , $testCases          := $testSetDoc/*:test-set/*:test-case
let $header             :=
  "-module('"||$SUITE||"')."                           ||$_:n||
  "-include_lib(""common_test/include/ct.hrl"")."      ||$_:n||
  "-export([all/0,"                                    ||$_:n||
  "         groups/0,"                                 ||$_:n||
  "         suite/0])."                                ||$_:n||
  "-export([init_per_suite/1,"                         ||$_:n||
  "         init_per_group/2,"                         ||$_:n||
  "         end_per_group/2,"                          ||$_:n||
  "         end_per_suite/1])."                        ||$_:n||
  (: exports for each test case :)
  _:mod_exports($testCases)
let $standardFuns       :=
  (if ($catalogTestSetName = ("app_XMark",
                              "app_Demos")) then
     (: Possibly time consuming tests so give them time to finish :)
     "suite() -> [{timetrap,{seconds, 240}}]."
   else
     "suite() -> [{timetrap,{seconds, 180}}]."
  )||$_:n||
  "init_per_group(_, Config) ->  Config."              ||$_:n||
  "end_per_group(_, _Config) -> "                   ||$_:n||
  (: Clears all compiled modules in the DB :)
  "   xqerl_code_server:unload(all)."                 ||$_:n||
  "end_per_suite(_Config) -> "                   ||$_:n||
  (: Timetrap set to 60 seconds to allow modules to be purged :)
  "   ct:timetrap({seconds,60}), "               ||$_:n||
  (: Clears all compiled modules in the DB :)
  "   xqerl_code_server:unload(all)."                 ||$_:n||
  "init_per_suite(Config) -> "                   ||$_:n||
  "   {ok,_} = application:ensure_all_started(xqerl)," ||$_:n||
  "   DD = filename:dirname(filename:dirname(?config(data_dir, Config))),"||$_:n||
  "   TD = filename:join(DD, ""QT3-test-suite""),"||$_:n||
  "   __BaseDir = filename:join(TD, """||$testSetDir||"""),"||$_:n||
  (: Add a base directory for tests to use :)
  "   [{base_dir, __BaseDir}|Config]."||$_:n||
  (: the all() function :)
  _:mod_all($testCases, $SUITE = ('expath_file_SUITE',
                                  'fn_collection_SUITE',
                                  'prod_ModuleImport_SUITE',
                                  'app_Demos_SUITE',
                                  'prod_ContextItemDecl_SUITE'))
let $usedEnvironments := _:get-used-environments($testCases)
  , $environments       := _:mod_environments($globalEnvs, $localEnvs, $usedEnvironments)
  , $testCasesStr       := _:join-dnl(($testCases ! _:print-testcase(.))) || "."
  , $mod                := $header       ||$_:n||
                           $standardFuns ||$_:n||
                           $environments ||$_:n||
                           $testCasesStr
return
  file:write-text($suiteFile, $mod, "utf-8")

(: SD = filename:dirname(filename:dirname(filename:dirname(filename:dirname(?config(priv_dir, Config))))),
Zip = filename:join([SD,"sandpit.zip"]),
{ok,_} = file:copy("/git/expath/expath-cg/tests/qt3/file/sandpit.zip", Zip),
zip:extract(Zip), :)

declare namespace _ = "http://xqerl.org/xquery/test_cases";
declare namespace x = "http://xqerl.org/xquery";

(: declare option db:chop 'false'; :)

declare variable $catalog := doc("/git/zadean/qt3tests/catalog.xml");

(: String helpers :)

declare variable $_:n := '
';
declare variable $_:cn := ',
';
declare variable $_:dn := '.
';
declare variable $_:scn := ';
';

declare function _:join-nl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:n) };

declare function _:join-cnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:cn) };

declare function _:join-dnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:dn) };

declare function _:join-scnl($strs as xs:string*) as xs:string?
{ fn:string-join($strs, $_:scn) };

(: All tests must pass :)
declare function _:all-of($result) as xs:string
{
  "   case lists:all(fun({comment,_}) -> true; (_) -> false end, ["||$_:n||
  (for $t in $result/* return _:print-result($t)) => _:join-cnl() ||
  "   ]) of "||$_:n||
  "      true -> {comment, ""all-of""};" ||$_:n||
  "      _ -> false " ||$_:n||
  "   end"
};

(: Any test must pass :)
declare function _:any-of($result) as xs:string
{
  "   case lists:any(fun({comment,_}) -> true; (_) -> false end, ["||$_:n||
  (for $t in $result/* return _:print-result($t)) => _:join-cnl() ||
  "   ]) of "||$_:n||
  "      true -> {comment, ""any-of""};" ||$_:n||
  "      _ -> false " ||$_:n||
  "   end"
};

(: Negate test results by returning the comment text :)
declare function _:not($result) as xs:string
{
  "   case ("||_:print-result($result/*[1])||") of "||$_:n||
  "      {comment,C6} -> C6; _ -> {comment,ok}"||$_:n||
  "   end"
};

(: Empty sequence returned, parameter is unused :)
declare function _:assert-empty($null) as xs:string
{
  "   case xqerl_test:assert_empty(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: True returned, parameter is unused :)
declare function _:assert-true($null) as xs:string
{
  "   case xqerl_test:assert_true(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: False returned, parameter is unused :)
declare function _:assert-false($null) as xs:string
{
  "   case xqerl_test:assert_false(Res) of " ||$_:n||
  "      true -> {comment, ""Empty""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Result count check :)
declare function _:assert-count($result) as xs:string
{
  let $ec := """"||$result||""""
  return
  "   case xqerl_test:assert_count(Res, "||$ec||") of " ||$_:n||
  "      true -> {comment, ""Count correct""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Check the atomized value. Space can be normalized :)
declare function _:assert-string-value($result) as xs:string
{
  let $text := $result/text()
    , $norm := if ($result/@normalize-space = "true") then true() else false()
    , $normText := if ($norm) then normalize-space($text) else $text
    , $mask := _:mask-string($normText)
    , $fun  := if ($norm) then "assert_norm_string_value" else "assert_string_value"
  return
    "   case xqerl_test:"||$fun||"(Res, "||$mask||") of " ||$_:n||
    "      true -> {comment, ""String correct""};" ||$_:n||
    "      {false, F} -> F " ||$_:n||
    "   end"
};

(: Error expected :)
declare function _:error($result) as xs:string
{
  let $ec := """"||$result/@code||""""
  return
  "   case xqerl_test:assert_error(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct error""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Values equal :)
declare function _:assert-eq($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_eq(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Correct type :)
declare function _:assert-type($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_type(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct type""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Value exists or is true :)
declare function _:assert($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct results""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Some combination of values in any order :)
declare function _:assert-permutation($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_permutation(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Correct permutation""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Values are deep-equal :)
declare function _:assert-deep-eq($result) as xs:string
{
  let $ec := _:mask-string($result/data())
  return
  "   case xqerl_test:assert_deep_eq(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""Deep equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: XML is deep-equal :)
declare function _:assert-xml($result) as xs:string
{
  let $ec := if ($result/@file) then
              "{file, filename:join(__BaseDir, """||string($result/@file)||""")}"
             else
               _:mask-string($result/data())
  return
  "   case xqerl_test:assert_xml(Res,"||$ec||") of " ||$_:n||
  "      true -> {comment, ""XML Deep equal""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Runs regex match on results :)
declare function _:assert-serialization-matches($result) as xs:string
{
  let $ec := _:mask-string($result/text())
  let $fl := _:mask-string($result/@flags)
  return
  "   case xqerl_test:assert_serialization_match(Res,<<"||$ec||"/utf8>>,<<"||$fl||">>) of " ||$_:n||
  "      true -> {comment, ""Correct serialization""};" ||$_:n||
  "      {false, F} -> F " ||$_:n||
  "   end"
};

(: Catch-all :)
declare function _:assert-unknown($result) as xs:string
{
  "   case (catch ct:fail([" ||
  _:mask-string(fn:string($result)) ||
  ", Res])) of _ -> false end"
};

(: Call correct string function based on node name of result :)
declare function _:print-result($result) as xs:string
{
  let $name := local-name($result)
  let $f :=
    if ($name = "all-of") then _:all-of#1 else
    if ($name = "any-of") then _:any-of#1 else
    if ($name = "not") then _:not#1 else
    if ($name = "assert-empty") then _:assert-empty#1 else
    if ($name = "assert-true") then _:assert-true#1 else
    if ($name = "assert-false") then _:assert-false#1 else
    if ($name = "assert-count") then _:assert-count#1 else
    if ($name = "assert-string-value") then _:assert-string-value#1 else
    if ($name = ("error","assert-serialization-error")) then _:error#1 else
    if ($name = "assert-eq") then _:assert-eq#1 else
    if ($name = "assert-type") then _:assert-type#1 else
    if ($name = "assert") then _:assert#1 else
    if ($name = "assert-permutation") then _:assert-permutation#1 else
    if ($name = "assert-deep-eq") then _:assert-deep-eq#1 else
    if ($name = "assert-xml") then _:assert-xml#1 else
    if ($name = "serialization-matches") then _:assert-serialization-matches#1 else
    _:assert-unknown#1
  return
  $f($result)
};

(: Returns a test-case text as either being skipped due to some feature
   restriction, or the actual test-case text.
   Has all the skipping logic which could be moved out. :)
declare function _:print-testcase($test-case) as xs:string
{
  let $inscope-schema-envs :=
    ($test-case/../*:environment[*:source[@validation]]/@name union
     $catalog/*:catalog/*:environment[*:source[@validation]]/@name)
    , $name := $test-case/@name
    , $deps := $test-case//*:dependency  |
               $test-case/parent::*/*:dependency
    , $env  := $test-case/*:environment/@ref/string()
    , $f    := function(){ _:print-testcase2($test-case, $name, $env) }
  return
  "'"||$name||"'(Config) ->"||$_:n||
  "   __BaseDir = ?config(base_dir, Config),"||$_:n||
  (
    (: validation environments :)
    if ($env = $inscope-schema-envs) then
    "   {skip,""Validation Environment""}"
    else if ($test-case/*:environment/*:schema) then
    "   {skip,""Validation Environment""}"

    (: serialization feature :)
    (: else if (starts-with($test-case/../@name,"method-")) then
    "   {skip,""serialization feature""}"
    else if ($test-case/../@name = "fn-serialize") then
    "   {skip,""serialization feature""}" :)

    (: default-language :)
    else if ($deps[@type = "default-language" and @value != "en"]) then
    "   {skip,""default-language "||$deps[@type = "default-language"]/@value||" ""}"

    (: language :)
    else if ($deps[@type = "language" and @value != "en"]) then
      "   {skip,""language "||$deps[@type = "language"]/@value||" ""}"

    (: format-integer-sequence :)
    else if ($deps[@type = "format-integer-sequence" and
                   @value = ("一","α","Α")]) then
      "   {skip,""format-integer-sequence""}"

    (: XSD 1.1 stuff, Regex uses 1.1, the rest does not :)
    else if ($deps[@type = "xsd-version" and @value = "1.1"] and
                   not($test-case/../@name = ("fn-matches", "fn-matches.re")) ) then
      "   {skip,""XSD 1.1""}"
    else if ($deps[@type = "xsd-version" and @value = "1.0"] and
                   ($test-case/../@name = ("fn-matches", "fn-matches.re")) ) then
      "   {skip,""XSD 1.0 regex""}"

    (: unicode FULLY-NORMALIZED :)
    else if ($deps[@type = "unicode-normalization-form" and @value = "FULLY-NORMALIZED"
                   and not(exists(@satisfied)) ]) then
      "   {skip,""unicode-normalization-form FULLY-NORMALIZED""}"

    (: older unicode versions :)
    else if ($deps[@type = "unicode-version" and
                   @value = ("5.2", "6.0", "6.2", "7.0")]) then
      "   {skip,""unicode-version""}"

    (: spec examples with dependencies :)
    (: else if ($test-case/../@name = "app-spec-examples" and
                $test-case/@name = ('fo-test-fn-serialize-002','fo-test-fn-serialize-001')
            ) then
    "   {skip,""serialization feature""}" :)
    else if ($test-case/../@name = "app-spec-examples" and
                $test-case/@name = ('fo-test-fn-id-001','fo-test-fn-id-002',
                                    'fo-test-fn-element-with-id-001','fo-test-fn-element-with-id-002',
                                    'fo-test-fn-idref-001','fo-test-fn-idref-002')
            ) then
    "   {skip,""schemaAware""}"

    (: test case using environment instead of declare :)
    else if ($test-case/../@name eq "fn-static-base-uri" and
                $test-case/@name eq 'fn-static-base-15'
            ) then
    "   {skip,""static-base-uri environment""}"

    (: XML version :)
    else if ($deps[@type = "xml-version" and @value = "1.1"]) then
      "   {skip,""XML version 1.1""}"
    else if ($deps[@type = "xml-version" and @value = "1.0:4-"]) then
      "   {skip,""XML version 1.0:4-""}"

    (: spec :)
    else if (exists($deps[@type = "spec"])) then
      (
      let $d := $deps[@type = "spec"]
      let $v := $d/@value
      return
      if ($v = ("XQ10",
                "XQ10 XP20",
                "XP10 XQ10",
                "XP20 XP30 XQ10 XQ30",
                "XQ10 XP20 XQ30 XP30",
                "XP20 XQ10 XP30 XQ30",
                "XQ10 XQ30",
                "XQ30",
                "XQ30 XP30",
                "XP30 XQ30",
                "XP20",
                "XP20 XQ10",
                "XP20+",
                "XP30+")) then
        "   {skip,"""||$v[1]||"""}"

      (: features :)
      else if (exists($deps[@type = "feature"])) then
        let $d := $deps[@type = "feature"]
        let $v := $d/@value
        return
        if ($v = ("advanced-uca-fallback",
                  "staticTyping",
                  "schemaValidation",
                  "schemaImport",
                  "schemaAware",
                  "xpath-1.0-compatibility",
                  (: "serialization", :)
                  "namespace-axis",
                  "directory-as-collection-uri",
                  "typedData",
                  "schema-location-hint",
                  "olson-timezone")) then
          "   {skip,"""||$v[1]||"""}"
        else
          let $s := $d/@satisfied
          return
          if ($s = "true" and
              $v = ("fn-load-xquery-module",
                    "fn-transform-XSLT",
                    "fn-transform-XSLT30")) then
            "   {skip,"""||$v[1]||"""}"
          else if ($s = "false" and
              $v = ("serialization")) then
            "   {skip,"""||$v[1]||"""}"
          else
            $f()
      else
        $f()
    )
    (: features Duplicated due to if nesting :)
    else if (exists($deps[@type = "feature"])) then
      let $d := $deps[@type = "feature"]
      let $v := $d/@value
      return
      if ($v = ("advanced-uca-fallback",
                "staticTyping",
                "schemaValidation",
                "schemaImport",
                "schemaAware",
                "xpath-1.0-compatibility",
                (: "serialization", :)
                "namespace-axis",
                "directory-as-collection-uri",
                "typedData",
                "schema-location-hint",
                "olson-timezone")) then
        "   {skip,"""||$v[1]||"""}"
      else
        let $s := $d/@satisfied
        return
        if ($s = "true" and
            $v = ("fn-load-xquery-module",
                  "fn-transform-XSLT",
                  "fn-transform-XSLT30")) then
          "   {skip,"""||$v[1]||"""}"
        else if ($s = "false" and
            $v = ("serialization")) then
          "   {skip,"""||$v[1]||"""}"
        else
          $f()
    else
      $f()
  )
};

(: XQuery to run can be in a file, so read and input into text case module
   if need be.  :)
declare function _:get-query($test-case) as xs:string
{
  let $test := $test-case/*:test
  return
  "   Qry = "||
  (
    if ($test/@file) then
      resolve-uri($test/@file, base-uri($test-case)) =>
      (: BaseX fallback true for invalid XML characters :)
      (: file:read-text("utf-8",true())  => :)
      file:read-text("utf-8")   =>
      _:mask-string()
    else
      _:mask-string($test/text())
  )
};

(: Distinct list of used environments before skipping :)
declare function _:get-used-environments($test-cases) as xs:string*
{
  ($test-cases/*:environment/string(@name),
   $test-cases/*:environment/string(@ref)) => distinct-values()
};

(: The actual test-case text if being run :)
declare function _:print-testcase2($test-case, $name, $env)
{
  _:get-query($test-case) ||$_:cn||
  (: compile any imported modules, local imports will unload these :)
  (
    if ($test-case/*:module) then
      let $f := function($a)
                {
                  "   try xqerl_code_server:compile(filename:join(__BaseDir, """||
                  string($a/@file)||""")) catch _:_ -> ok end"
                }
      return
      ( reverse($test-case/*:module) ! $f(.) ) => _:join-cnl() || ',
'
    else
      ""
  ) ||
  (: handle any environment :)
  (
    if ($test-case/*:environment[@ref]) then
      "   {Env,Opts} = xqerl_test:handle_environment(environment('"||$env||"',__BaseDir)),"||$_:n||
      "   Qry1 = lists:flatten(Env ++ Qry),"||$_:n
    else if ($test-case/*:environment) then
      "   {Env,Opts} = xqerl_test:handle_environment("||
      string-join(_:print-local-environment($test-case))
      ||"),"||$_:n||
      "   Qry1 = lists:flatten(Env ++ Qry),"||$_:n
    else
      "   Qry1 = Qry,"||$_:n
  ) ||
  (: print final query :)
  "   io:format(""Qry1: ~p~n"",[Qry1]),"||$_:n||
  (: add options if there is an environment :)
  (
    if ($test-case/*:environment) then
      "   Res = try Mod = xqerl_code_server:compile(filename:join(__BaseDir, """||$name||".xq""), Qry1),
"||
      "             xqerl:run(Mod,Opts) of D -> D catch _:E -> E end,"||$_:n
    else
      "   Res = try Mod = xqerl_code_server:compile(filename:join(__BaseDir, """||$name||".xq""), Qry1),
"||
      "             xqerl:run(Mod) of D -> D catch _:E -> E end,"||$_:n
  ) ||
  "   Out = " || _:print-result($test-case/*:result/*) ||',
'||
  "   case Out of"||$_:n||
  "      {comment, C} -> {comment, C};"||$_:n||
  "      Err -> ct:fail(Err)"||$_:n||
  "   end"
};

(: Global module environment that can be used in any test.
   $is-local is to flag the file location of resources :)
declare function _:print-environment($env,$is-local) as xs:string
{
  let $name            := $env/@name
  let $sources         := $env/*:source
  let $schemas         := $env/*:schema
  let $collections     := $env/*:collection
  let $static-base-uri := $env/*:static-base-uri
  let $params          := $env/*:param[@declared = "true"]
  let $vars            := $env/*:param[@declared = "false" or not(exists(@declared))]
  let $namespaces      := $env/*:namespace
  let $resources       := $env/*:resource
  let $modules         := $env/*:module | $env/../*:module
  let $dec-formats     := $env/*:decimal-format
  let $def-collation   := $env/*:collation[@default = 'true']
  return
  "environment('"||$name||"',__BaseDir) ->" || $_:n ||
  "["||
  _:do-default-collation($def-collation) ||
  "{'decimal-formats', ["|| _:do-decimal-formats($dec-formats) ||"]}"|| $_:cn ||
  "{sources, ["|| _:do-sources($sources, $is-local) ||"]}"|| $_:cn ||
  "{collections, [" || _:do-collections($collections, $is-local) ||"]}"|| $_:cn ||
  "{'static-base-uri', ["||_:do-static-base-uri($static-base-uri)||"]}"|| $_:cn ||
  "{params, ["|| _:do-name-as-select($params) ||"]}"|| $_:cn ||
  "{vars, ["|| _:do-name-as-select($vars) ||"]}"|| $_:cn ||
  "{namespaces, ["|| _:do-uri-prefix($namespaces) ||"]},"|| $_:n ||
  "{schemas, ["|| _:do-file-uri($schemas, $is-local) || "]}" || $_:cn ||
  "{resources, ["|| _:do-file-uri-type($resources, $is-local) || "]}" || $_:cn ||
  "{modules, ["|| _:do-file-uri($modules, $is-local) || "]}" || $_:n ||
  "]"
};

(: Local environments are only used in a single test, so inline :)
declare function _:print-local-environment($env as item()*) as item()*
{
  let $sources         := $env/*:environment/*:source
  let $schemas         := $env/*:environment/*:schema
  let $collections     := $env/*:environment/*:collection
  let $static-base-uri := $env/*:environment/*:static-base-uri
  let $params          := $env/*:environment/*:param[@declared = "true"]
  let $vars            := $env/*:environment/*:param[@declared = "false" or not(exists(@declared))]
  let $namespaces      := $env/*:environment/*:namespace
  let $resources       := $env/*:environment/*:resource
  let $modules         := $env/*:environment/*:module | $env/*:module
  let $dec-formats     := $env/*:environment/*:decimal-format
  let $def-collation   := $env/*:environment/*:collation[@default = 'true']
  let $context-item    := $env/*:environment/*:context-item

  return (
  "["||
  _:do-default-collation($def-collation) ||
  "{'decimal-formats', ["|| _:do-decimal-formats($dec-formats) ||"]}"|| $_:cn ||
  "{sources, ["|| _:do-sources($sources, true()) ||"]}"|| $_:cn ||
  "{collections, [" || _:do-collections($collections, true()) ||"]}"|| $_:cn ||
  "{'static-base-uri', ["||_:do-static-base-uri($static-base-uri)||"]}"|| $_:cn ||
  "{'context-item', ["||_:mask-string($context-item/@select)||"]}"|| $_:cn ||
  "{vars, ["  || _:do-name-as-select($vars) ||"]}"|| $_:cn ||
  "{params, ["|| _:do-name-as-select($params) ||"]}"|| $_:cn ||
  "{namespaces, ["|| _:do-uri-prefix($namespaces) ||"]}"|| $_:cn ||
  "{schemas, ["   || _:do-file-uri($schemas,true()) || "]}" || $_:cn ||
  "{resources, [" || _:do-file-uri-type($resources,true()) || "]}" || $_:cn ||
  "{modules, ["   || _:do-file-uri($modules,true()) || "]}" || $_:n ||
  "]")
};

declare function _:do-decimal-formats($dec-formats) as xs:string?
{
  (
    for $res in $dec-formats
    let $name :=
      (let $q := fn:resolve-QName($res/@name,$res)
       return
       if (namespace-uri-from-QName($q) = 'http://www.w3.org/2010/09/qt-fots-catalog') then
         $res/@name
       else if (not(exists($res/@name))) then
         ""
       else
         ("Q{"||namespace-uri-from-QName($q)||"}" || local-name-from-QName($q))
      )
    return
    "{"""|| $name ||""",["||
    (for $a in $res/@*[name(.) != "name"]
     return
     "{'"||name($a)||"',"||_:mask-string($a)||"}"
    ) => _:join-cnl() ||"]}"
  ) => _:join-cnl()
};

declare function _:do-default-collation($def-collation) as xs:string?
{
  if (exists($def-collation)) then
    "{'default-collation', """||$def-collation/@uri||"""}"|| $_:cn
  else ()
};

declare function _:do-sources($sources, $is-local) as xs:string?
{
  (
    for $res in $sources
    let $head := if ($is-local) then
                   "{filename:join(__BaseDir, """||string($res/@file)||"""), """||$res/@role||""","
                 else
                   "{filename:join(__BaseDir, ""../"||string($res/@file)||"""), """||$res/@role||""","
    let $uri := $res/@uri
    let $tail := if (exists($uri)) then
                   (: special case for fn:doc tests with relative uris :)
                   if (resolve-uri($uri, base-uri($res)) eq $uri) then
                     """"||$uri||"""}"
                   else
                     "filename:join(__BaseDir, """||string($uri)||""")}"
                 else
                   "[]}"
    return
    $head || $tail
  ) => _:join-cnl()
};

declare function _:do-collections($collections, $is-local) as xs:string?
{
  (
    for $res in $collections
    return
    "{"""||$res/@uri||""",["||
    (
      for $s in $res/*:source
      return
      if ($is-local) then
      "{src,filename:join(__BaseDir, """||string($s/@file)||""")}"
      else
      "{src,filename:join(__BaseDir, ""../"||string($s/@file)||""")}" ,
      for $s in $res/*:query
      return
      "{query,__BaseDir,"||_:mask-string($s)||"}"
    ) => _:join-cnl()
    ||"]}"
  ) => _:join-cnl()
};

declare function _:do-static-base-uri($static-base-uri) as xs:string?
{
  let $uri := $static-base-uri/@uri
  return
  if ($uri eq '#UNDEFINED') then
    "{[]}"
  else if (empty($uri)) then
    ""
  else
    "{"""||$uri||"""}"
};

declare function _:do-name-as-select($vars) as xs:string?
{
  let $f := function($a)
            {
              "{"""||$a/@name||""","""||
              $a/@as||""","||
              _:mask-string($a/@select)||"}"
            }
  return
  ( $vars ! $f(.) ) => _:join-cnl()
};

declare function _:do-uri-prefix($namespaces) as xs:string?
{
  let $f := function($a)
            {
              "{"""||$a/@uri||""","""||$a/@prefix||"""}"
            }
  return
  ( $namespaces ! $f(.) ) => _:join-cnl()
};

declare function _:do-file-uri($files, $is-local) as xs:string?
{
  let $f := function($a)
          {
            (
              if ($is-local) then
                "{filename:join(__BaseDir, """
              else
                "{filename:join(__BaseDir, ""../"
            ) ||
            string($a/@file) ||
            """),""" ||
            $a/@uri||"""}"
          }
  return
  ( reverse($files) ! $f(.) ) => _:join-cnl()
};

declare function _:do-file-uri-type($files, $is-local) as xs:string?
{
  let $f := function($a)
          {
            "{""" || string($a/@media-type) || """, " ||
            (
              if ($is-local) then
                "filename:join(__BaseDir, """
              else
                "filename:join(__BaseDir, ""../"
            ) ||
            string($a/@file) ||
            """),""" ||
            $a/@uri||"""}"
          }
  return
  ( reverse($files) ! $f(.) ) => _:join-cnl()
};

(:~ Mask a string for Erlang :)
declare function _:mask-string($text as xs:string*) as xs:string
{
  """" || (
    $text => string-join()
          => replace('\','\\','q')
          => replace("""","\""",'q')
  ) || """"
};

declare function _:mask-name($text as xs:string) as xs:string
{
  $text => replace('-','_','q')
        => replace(".","_",'q')
};

declare function _:mod_exports($testCases)
{
  let $f := function($a){"-export(['"||$a/@name||"'/1])."}
  return _:join-nl(($testCases ! $f(.)))
};

declare function _:mod_all($testCases, $single)
{
  (: tests that step on each other need to be done in a singleton group :)
  let $max := if ($single) then 1000 else 24
  let $f  := function($a){"'"||$a/@name||"'"}
  let $grpd :=
      for $tc at $y in $testCases
      group by $z := $y idiv $max
      return
      [$z, $tc]
  return
  "all() -> ["||$_:n||
  ($grpd ! ("   {group, group_" || .?1 || "}" ) ) => _:join-cnl() ||$_:n||
  "   ]." ||$_:n||
  "groups() -> ["||$_:n||
  ($grpd ! ("   {group_" || .?1 ||
    (
      if ($single) then
        ", [], ["
      else
        ", [parallel], ["
    )
  ||$_:n||
  (.?2 ! ("    " || $f(.)) ) => _:join-cnl()
  ||
  "]}" ) ) => _:join-cnl()
  ||"]."
};

(: Return all used environments if any :)
declare function _:mod_environments($globals, $locals, $usedEnvironments)
{
  let $g := ($globals[@name = $usedEnvironments] ! _:print-environment(.,false()))
  let $l := ($locals[@name = $usedEnvironments] ! _:print-environment(.,true()))
  let $a := ($g,$l)
  return
  if (empty($a)) then "" else _:join-scnl(($g,$l)) || "."
};

(: Erlang SUITE :)

(: All test case sets from catalog :)
let $globalEnvs         := $catalog/*:catalog/*:environment
  , $globalBaseUri      := base-uri($catalog)
(: Each test case set from catalog :)
(: The parallel pragma causes the list to spawn a process for each value :)
(: 'unordered' allows the processes to return in any order :)
for $catalogTestSet     in
    (# x:parallel unordered #){
      $catalog/*:catalog/*:test-set(: [@name = "fn-static-base-uri"] :)
    }
let $catalogTestSetFile := $catalogTestSet/@file
  , $catalogTestSetName := _:mask-name($catalogTestSet/@name) => trace()
  , $testSetFile        := resolve-uri($catalogTestSetFile, $globalBaseUri)
  , $testSetDir         := substring-before($catalogTestSetFile,"/")
  , $testSetDoc         := doc($testSetFile)
  , $localEnvs          := $testSetDoc/*:test-set/*:environment
  , $SUITE              := $catalogTestSetName||"_SUITE"
  , $suiteFile          := resolve-uri($catalogTestSetName)||"_SUITE.erl"
  , $testCases          := $testSetDoc/*:test-set/*:test-case
let $header             :=
  "-module('"||$SUITE||"')."                           ||$_:n||
  "-include_lib(""common_test/include/ct.hrl"")."      ||$_:n||
  "-export([all/0,"                                    ||$_:n||
  "         groups/0,"                                 ||$_:n||
  "         suite/0])."                                ||$_:n||
  "-export([init_per_suite/1,"                         ||$_:n||
  "         init_per_group/2,"                         ||$_:n||
  "         end_per_group/2,"                          ||$_:n||
  "         end_per_suite/1])."                        ||$_:n||
  (: exports for each test case :)
  _:mod_exports($testCases)
let $standardFuns       :=
  (if ($catalogTestSetName = ("app_XMark",
                              "app_Demos")) then
     (: Possibly time consuming tests so give them time to finish :)
     "suite() -> [{timetrap,{seconds, 240}}]."
   else
     "suite() -> [{timetrap,{seconds, 180}}]."
  )||$_:n||
  "init_per_group(_, Config) ->  Config."              ||$_:n||
  "end_per_group(_, _Config) -> "                   ||$_:n||
  (: Clears all compiled modules in the DB :)
  "   xqerl_code_server:unload(all)."                 ||$_:n||
  "end_per_suite(_Config) -> "                   ||$_:n||
  (: Timetrap set to 60 seconds to allow modules to be purged :)
  "   ct:timetrap({seconds,60}), "               ||$_:n||
  (: Clears all compiled modules in the DB :)
  "   xqerl_code_server:unload(all)."                 ||$_:n||
  "init_per_suite(Config) -> "                   ||$_:n||
  "   {ok,_} = application:ensure_all_started(xqerl)," ||$_:n||
  "   DD = filename:dirname(filename:dirname(?config(data_dir, Config))),"||$_:n||
  "   TD = filename:join(DD, ""QT3-test-suite""),"||$_:n||
  "   __BaseDir = filename:join(TD, """||$testSetDir||"""),"||$_:n||
  (: Add a base directory for tests to use :)
  "   [{base_dir, __BaseDir}|Config]."||$_:n||
  (: the all() function :)
  _:mod_all($testCases, $SUITE = ('fn_collection_SUITE',
                                  'prod_ModuleImport_SUITE',
                                  'app_Demos_SUITE',
                                  'prod_ContextItemDecl_SUITE'))
let $usedEnvironments := _:get-used-environments($testCases)
  , $environments       := _:mod_environments($globalEnvs, $localEnvs, $usedEnvironments)
  , $testCasesStr       := _:join-dnl(($testCases ! _:print-testcase(.))) || "."
  , $mod                := $header       ||$_:n||
                           $standardFuns ||$_:n||
                           $environments ||$_:n||
                           $testCasesStr
return
  file:write-text($suiteFile, $mod, "utf-8")


[MOD] Module calls updated.

[MOD] Module calls updated.

(: global namespace of the test suite. :)
declare namespace fots = "http://www.w3.org/2010/09/qt-fots-catalog";

(: prefix of catalog to test. :)
declare variable $doc := doc('catalog.xml');
(: prefix of catalog to test. :)
declare variable $catalog := '';
(: prefix of tests to test. :)
declare variable $prefix := '';

(: loops throgh the test set and evaluates all test cases :)
declare function fots:main() {
  let $env := $doc//*:environment
  for $set in $doc//*:test-set[starts-with(@name, $catalog)]
  let $href := $set/@href
  let $base-dir := replace($href, '/.*','/')
  let $doc := doc($href)
  for $case in $doc//*:test-case[starts-with(@name, $prefix)]
  let $env := $env | $doc//*:environment
  return fots:test($case, $env, $base-dir)
};

(: runs a single test :)
declare function fots:test($case, $envir, $base) {
  let $query := $case/*:test/text()
  let $env := $envir[@name = $case/*:environment/@ref]/*:source/@file
  let $result := $case/*:result
  let $prolog :=
    if($env)
    then concat("declare context item := doc('",
     if(file:exists(concat($base, $env))) then $base else (), $env, "');")
    else ()
  let $query := concat($prolog, $query)
  return
  try {
    let $val := xquery:eval($query)
    return if
     (fots:allof($result, $val) or
      fots:anyof($result, $val) or
      fots:true($result, $val) or
      fots:false($result, $val) or
      fots:eq($result, $val) or
      fots:string($result, $val))
      then fots:wrong($case, $val, $result/*)
      else ()
  } catch * {
    if(xs:string($err:code) = $result//*:error/@code)
    then ()
    else fots:wrong($case, concat($err:code,': ',$err:description), $result/*)
  }
};

(: gives feedback on an erroneous query :)
declare function fots:wrong($test, $found, $exp) {
  <test name="{ $test/@name }">
    <query>{ $test/*:test/text() }</query>
    <found>{ $found }</found>
    <expected>{
      if($exp/self::*:error)
      then data($exp/@code)
      else $exp
    }</expected>
  </test>
};

(: converts a value to the specified type :)
declare function fots:convert($type, $val) {
  if($type)
  then
    try {
      xquery:eval(concat($type, '("', $val, '")'))
    } catch * {
      trace('', concat($err:code, ': ', $err:description))
    }
  else $val
};

(: checks if any of the given tests is wrong :)
declare function fots:allof($result, $val) {
  let $type := $result//*:assert-type
  let $val := fots:convert($type, $val)
  for $c in $result/*:all-of/*
  let $eq := replace($c/self::*:assert-eq, "^('|"")|('|"")$", "")
  return
    if(not($eq) or fots:convert($type, $eq) eq $val)
    then ()
    else false()
};

(: checks if none of the given tests is true :)
declare function fots:anyof($result, $val) {
  let $type := $result//*:assert-type
  let $val := fots:convert($type, $val)
  let $ok :=
    for $c in $result/*:any-of/*
    return if(
      not(fots:true($c, $val)) and
      not(fots:false($c, $val)) and
      not(fots:string($c, $val)))
      then true()
      else ()
  return exists($result/*:any-of) and empty($ok)
};

(: checks if the given value is not true :)
declare function fots:true($result, $val) {
  $result/*:assert-true and not($val)
};

(: checks if the given value is not false :)
declare function fots:false($result, $val) {
  $result/*:assert-false and $val
};

(: checks if the given string is wrong :)
declare function fots:string($result, $val) {
  $result/*:assert-string-value ne string($val)
};

(: checks if the equality yields false :)
declare function fots:eq($result, $val) {
  for $i in $result/*:assert-eq
  return
    try {
      let $r := xquery:eval($i)
      return (typeswitch($val)
        case xs:string  return xs:string($r)
        case xs:double  return xs:double($r)
        case xs:float   return xs:float($r)
        case xs:integer return xs:integer($r)
        default return $val) ne $val
    } catch * {
      trace('', concat($err:code, ': ', $err:description))
    }
};

(: runs the main function :)
fots:main()

(: global namespace of the test suite. :)
declare namespace fots = "http://www.w3.org/2010/09/qt-fots-catalog";

(: prefix of catalog to test. :)
declare variable $doc := doc('catalog.xml');
(: prefix of catalog to test. :)
declare variable $catalog := '';
(: prefix of tests to test. :)
declare variable $prefix := '';

(: loops throgh the test set and evaluates all test cases :)
declare function fots:main() {
  let $env := $doc//*:environment
  for $set in $doc//*:test-set[starts-with(@name, $catalog)]
  let $href := $set/@href
  let $base-dir := replace($href, '/.*','/')
  let $doc := doc($href)
  for $case in $doc//*:test-case[starts-with(@name, $prefix)]
  let $env := $env | $doc//*:environment
  return fots:test($case, $env, $base-dir)
};

(: runs a single test :)
declare function fots:test($case, $envir, $base) {
  let $query := $case/*:test/text()
  let $env := $envir[@name = $case/*:environment/@ref]/*:source/@file
  let $result := $case/*:result
  let $prolog :=
    if($env)
    then concat("declare context item := doc('",
     if(file:exists(concat($base, $env))) then $base else (), $env, "');")
    else ()
  let $query := concat($prolog, $query)
  return
  try {
    let $val := util:eval($query)
    return if
     (fots:allof($result, $val) or
      fots:anyof($result, $val) or
      fots:true($result, $val) or
      fots:false($result, $val) or
      fots:eq($result, $val) or
      fots:string($result, $val))
      then fots:wrong($case, $val, $result/*)
      else ()
  } catch *($code, $msg) {
    if(xs:string($code) = $result//*:error/@code)
    then ()
    else fots:wrong($case, concat($code,': ',$msg), $result/*)
  }
};

(: gives feedback on an erroneous query :)
declare function fots:wrong($test, $found, $exp) {
  <test name="{ $test/@name }">
    <query>{ $test/*:test/text() }</query>
    <found>{ $found }</found>
    <expected>{
      if($exp/self::*:error)
      then data($exp/@code)
      else $exp
    }</expected>
  </test>
};

(: converts a value to the specified type :)
declare function fots:convert($type, $val) {
  if($type)
  then
    try {
      util:eval(concat($type, '("', $val, '")'))
    } catch *($c,$m) {
      trace('', concat($c, ': ', $m))
    }
  else $val
};

(: checks if any of the given tests is wrong :)
declare function fots:allof($result, $val) {
  let $type := $result//*:assert-type
  let $val := fots:convert($type, $val)
  for $c in $result/*:all-of/*
  let $eq := replace($c/self::*:assert-eq, "^('|"")|('|"")$", "")
  return
    if(not($eq) or fots:convert($type, $eq) eq $val)
    then ()
    else false()
};

(: checks if none of the given tests is true :)
declare function fots:anyof($result, $val) {
  let $type := $result//*:assert-type
  let $val := fots:convert($type, $val)
  let $ok :=
    for $c in $result/*:any-of/*
    return if(
      not(fots:true($c, $val)) and
      not(fots:false($c, $val)) and
      not(fots:string($c, $val)))
      then true()
      else ()
  return exists($result/*:any-of) and empty($ok)
};

(: checks if the given value is not true :)
declare function fots:true($result, $val) {
  $result/*:assert-true and not($val)
};

(: checks if the given value is not false :)
declare function fots:false($result, $val) {
  $result/*:assert-false and $val
};

(: checks if the given string is wrong :)
declare function fots:string($result, $val) {
  $result/*:assert-string-value ne string($val)
};

(: checks if the equality yields false :)
declare function fots:eq($result, $val) {
  for $i in $result/*:assert-eq
  return
    try {
      let $r := util:eval($i)
      return (typeswitch($val)
        case xs:string  return xs:string($r)
        case xs:double  return xs:double($r)
        case xs:float   return xs:float($r)
        case xs:integer return xs:integer($r)
        default return $val) ne $val
    } catch *($c,$m) {
      trace('', concat($c, ': ', $m))
    }
};

(: runs the main function :)
fots:main()


virtual attributes XQuery template module from XQuery 3.0 -> 3.1

xquery version "3.1";

declare namespace va="http://www.armatiek.nl/xmlindex/virtualattribute";

(:
  Take into acccount that when an index is reindexed (for instance when adding a typed value definition),
  the root of the passed element node is the document node of the complete index. When a new document is
  added or an existing document is overwritten, the root is the document node of the new document.
:)

(:
declare function va:my-fts-function($elem as element()) as xs:string* {
  string-join($elem//text(), ' ')
};
:)

()

xquery version "3.0";

declare namespace va="http://www.armatiek.nl/xmlindex/virtualattribute";

(:
  Take into acccount that when an index is reindexed (for instance when adding a typed value definition),
  the root of the passed element node is the document node of the complete index. When a new document is
  added or an existing document is overwritten, the root is the document node of the new document.
:)

(:
declare function va:my-fts-function($elem as element()) as xs:string* {
  string-join($elem//text(), ' ')
};
:)

()


fixed return in lcs

fixed return in lcs

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_psd = "https://github.com/openhie/openinfoman/csd_psd";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare function csd_lsc:get_document_name($name) {
  csd_dm:document_source($name)
(:  concat("local_services_cache/",$name,".xml") :)
};

declare function csd_lsc:directory_exists($db,$name) {
  db:is-xml($db,csd_lsc:get_document_name($name))
};

declare updating function csd_lsc:empty_cache($db,$name)
{
  (
    csd_dm:empty($db,$name)
    ,csd_lsc:set_service_directory_mtime($db,$name,$csd_lsc:beginning_of_time)
   )

};

declare function csd_lsc:get_cache($db,$name)
{
 if (csd_lsc:directory_exists($db,$name)) then
    db:open($db,csd_lsc:get_document_name($name))
  else csd_dm:blank_directory()
};

declare variable $csd_lsc:beginning_of_time := '1970-01-01T00:00:00+00:00';
declare variable $csd_lsc:cache_meta_doc := 'local_cache_meta.xml';

declare function csd_lsc:get_cache_data($db,$name)
{
  if ( not( db:is-xml($db,$csd_lsc:cache_meta_doc)))  then
    if ($name) then
      ()
    else
      <cacheData/>
  else
    let $meta_doc :=  db:open($db,$csd_lsc:cache_meta_doc)
    return if ($name) then
      $meta_doc/cacheData/serviceCache[@name = $name]
    else
      $meta_doc/cacheData
};

declare updating function csd_lsc:drop_cache_data($db,$name)
{
  if ( not(db:is-xml($db,$csd_lsc:cache_meta_doc)))  then
    ()
  else
    let $meta_doc :=  db:open($db,$csd_lsc:cache_meta_doc)
      return if ($name) then
	delete node $meta_doc/cacheData/serviceCache[@name = $name]
      else
	delete node $meta_doc/cacheData/*

};

declare  function csd_lsc:cache_meta_exists($db) {
  db:is-xml($db,$csd_lsc:cache_meta_doc)
};

declare updating function csd_lsc:init_cache_meta($db) {
  if ( not(csd_lsc:cache_meta_exists($db)))  then
    db:add($db, <cacheData/>,$csd_lsc:cache_meta_doc)
  else
      ()
};

declare updating function csd_lsc:set_service_directory_mtime($db,$name,$mtime)
{
  ( csd_lsc:init_cache_meta($db)
  ,
  try {
    let $dt :=  xs:dateTime($mtime) (: just to make sure it's valid :)
    let $meta :=  db:open($db,$csd_lsc:cache_meta_doc)/cacheData
    return
      if (not(exists($meta/serviceCache[@name = $name])))
      then insert node <serviceCache name="{$name}" mtime="{$csd_lsc:beginning_of_time}"/> into $meta
      else if (not(exists($meta/serviceCache[@name = $name]/@mtime)))
      then
        let $attr := attribute {"mtime"}{ $csd_lsc:beginning_of_time}
        return ( insert  node $attr into $meta/serviceCache[@name = $name])
      else
        replace value of node $meta/serviceCache[@name = $name]/@mtime with $mtime
  } catch * {
    let $t := trace($mtime,"Invalid date time sent")
    return ()  (: do nothing :)
  }
  )

};

declare function csd_lsc:get_service_directory_mtime($db,$name)
{
  if ( db:is-xml($db,$csd_lsc:cache_meta_doc))  then
    let $mtime := text{db:open($db,$csd_lsc:cache_meta_doc)/cacheData/serviceCache[@name = $name]/@mtime}
    return if ($mtime) then
	$mtime
      else
	$csd_lsc:beginning_of_time
    else
      $csd_lsc:beginning_of_time

};

declare  updating  function csd_lsc:update_cache($db,$name)
{

  let $mtime :=  csd_lsc:get_service_directory_mtime($db,$name)
(:  querying against self during an update will cause a deadlock :)
(:  see or :)
(:  http://www.mail-archive.com/basex-talk@mailman.uni-konstanz.de/msg02999.htmlhttp://www.mail-archive.com/basex-talk@mailman.uni-konstanz.de/msg02999.html  :)
(:  possible work-around: http://docs.basex.org/wiki/Server_Protocol ? :)
  let $currtime := current-dateTime()
  let $result := csd_psd:poll_service_directory($db,$name,$mtime)
  let $cache_doc := csd_lsc:get_cache($db,$name)

  return (
    csd_lsc:refresh_doc($cache_doc,$result)
    ,csd_lsc:set_service_directory_mtime($db,$name,$currtime)

  )

};

declare updating function csd_lsc:refresh_doc($cache_doc,$updates)
{
  (
   csd_lsc:update_directory($cache_doc/csd:CSD/csd:organizationDirectory,$updates/(csd:CSD/csd:organizationDirectory|csd:organizationDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:facilityDirectory,$updates/(csd:CSD/csd:facilityDirectory|csd:facilityDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:serviceDirectory,$updates/(csd:CSD/csd:serviceDirectory|csd:serviceDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:providerDirectory,$updates/(csd:CSD/csd:providerDirectory|csd:providerDirectory))
  )
};

declare updating function csd_lsc:update_directory($oldDir,$newDir)
{
  for $new in  $newDir/*
  let $old := $oldDir/*[@entityID = $new/@entityID] (:there may be more than one:)
  let $t:=
    for $o in $old
    return delete node $o
  return  insert node $new into $oldDir
};

(:~
: This is the Care Services Discovery stored query registry
: @version 1.0
: @see https://github.com/openhie/openinfoman
:
:)
module namespace csd_lsc = "https://github.com/openhie/openinfoman/csd_lsc";
import module namespace csd_psd = "https://github.com/openhie/openinfoman/csd_psd";
import module namespace csd_dm = "https://github.com/openhie/openinfoman/csd_dm";
declare namespace csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare function csd_lsc:get_document_name($name) {
  csd_dm:document_source($name)
(:  concat("local_services_cache/",$name,".xml") :)
};

declare function csd_lsc:directory_exists($db,$name) {
  db:is-xml($db,csd_lsc:get_document_name($name))
};

declare updating function csd_lsc:empty_cache($db,$name)
{
  (
    csd_dm:empty($db,$name)
    ,csd_lsc:set_service_directory_mtime($db,$name,$csd_lsc:beginning_of_time)
   )

};

declare function csd_lsc:get_cache($db,$name)
{
 if (csd_lsc:directory_exists($db,$name)) then
    db:open($db,csd_lsc:get_document_name($name))
  else csd_dm:blank_directory()
};

declare variable $csd_lsc:beginning_of_time := '1970-01-01T00:00:00+00:00';
declare variable $csd_lsc:cache_meta_doc := 'local_cache_meta.xml';

declare function csd_lsc:get_cache_data($db,$name)
{
  if ( not( db:is-xml($db,$csd_lsc:cache_meta_doc)))  then
    if ($name) then
      ()
    else
      <cacheData/>
  else
    let $meta_doc :=  db:open($db,$csd_lsc:cache_meta_doc)
    return if ($name) then
      $meta_doc/cacheData/serviceCache[@name = $name]
    else
      $meta_doc/cacheData
};

declare updating function csd_lsc:drop_cache_data($db,$name)
{
  if ( not(db:is-xml($db,$csd_lsc:cache_meta_doc)))  then
    ()
  else
    let $meta_doc :=  db:open($db,$csd_lsc:cache_meta_doc)
      return if ($name) then
	delete node $meta_doc/cacheData/serviceCache[@name = $name]
      else
	delete node $meta_doc/cacheData/*

};

declare  function csd_lsc:cache_meta_exists($db) {
  db:is-xml($db,$csd_lsc:cache_meta_doc)
};

declare updating function csd_lsc:init_cache_meta($db) {
  if ( not(csd_lsc:cache_meta_exists($db)))  then
    db:add($db, <cacheData/>,$csd_lsc:cache_meta_doc)
  else
      ()
};

declare updating function csd_lsc:set_service_directory_mtime($db,$name,$mtime)
{
  ( csd_lsc:init_cache_meta($db)
  ,
  try {
    let $dt :=  xs:dateTime($mtime) (: just to make sure it's valid :)
    let $meta :=  db:open($db,$csd_lsc:cache_meta_doc)/cacheData
    return
      if (not(exists($meta/serviceCache[@name = $name])))
      then insert node <serviceCache name="{$name}" mtime="{$csd_lsc:beginning_of_time}"/> into $meta
      else if (not(exists($meta/serviceCache[@name = $name]/@mtime)))
      then
        let $attr := attribute {"mtime"}{ $csd_lsc:beginning_of_time}
        return ( insert  node $attr into $meta/serviceCache[@name = $name])
      else
        replace value of node $meta/serviceCache[@name = $name]/@mtime with $mtime
  } catch * {
    trace($mtime,"Invalid date time sent")
    ()  (: do nothing :)
  }
  )

};

declare function csd_lsc:get_service_directory_mtime($db,$name)
{
  if ( db:is-xml($db,$csd_lsc:cache_meta_doc))  then
    let $mtime := text{db:open($db,$csd_lsc:cache_meta_doc)/cacheData/serviceCache[@name = $name]/@mtime}
    return if ($mtime) then
	$mtime
      else
	$csd_lsc:beginning_of_time
    else
      $csd_lsc:beginning_of_time

};

declare  updating  function csd_lsc:update_cache($db,$name)
{

  let $mtime :=  csd_lsc:get_service_directory_mtime($db,$name)
(:  querying against self during an update will cause a deadlock :)
(:  see or :)
(:  http://www.mail-archive.com/basex-talk@mailman.uni-konstanz.de/msg02999.htmlhttp://www.mail-archive.com/basex-talk@mailman.uni-konstanz.de/msg02999.html  :)
(:  possible work-around: http://docs.basex.org/wiki/Server_Protocol ? :)
  let $currtime := current-dateTime()
  let $result := csd_psd:poll_service_directory($db,$name,$mtime)
  let $cache_doc := csd_lsc:get_cache($db,$name)

  return (
    csd_lsc:refresh_doc($cache_doc,$result)
    ,csd_lsc:set_service_directory_mtime($db,$name,$currtime)

  )

};

declare updating function csd_lsc:refresh_doc($cache_doc,$updates)
{
  (
   csd_lsc:update_directory($cache_doc/csd:CSD/csd:organizationDirectory,$updates/(csd:CSD/csd:organizationDirectory|csd:organizationDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:facilityDirectory,$updates/(csd:CSD/csd:facilityDirectory|csd:facilityDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:serviceDirectory,$updates/(csd:CSD/csd:serviceDirectory|csd:serviceDirectory))
  ,csd_lsc:update_directory($cache_doc/csd:CSD/csd:providerDirectory,$updates/(csd:CSD/csd:providerDirectory|csd:providerDirectory))
  )
};

declare updating function csd_lsc:update_directory($oldDir,$newDir)
{
  for $new in  $newDir/*
  let $old := $oldDir/*[@entityID = $new/@entityID] (:there may be more than one:)
  let $t:=
    for $o in $old
    return delete node $o
  return  insert node $new into $oldDir
};