another hack to the XQTS app...

another hack to the XQTS app...

svn path=/trunk/eXist/; revision=6779

xquery version "1.0";

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";
declare namespace hack="http://exist-db.org/xquery/xqts/hacked-test-cases";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

declare option exist:output-size-limit "-1";

(: $Id$ :)

(:~  ----------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     -------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri($xqts:CONFIG/basedir/text());

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat("file:///", system:get-module-load-path(), "/hacked-tests.xml")
                    )))
        )
    return
        $config
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0" error="0"/>)
    return ()
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $temp := xdb:create-collection("/db/XQTS", "temp")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as xs:string,
    $pathElements as element()+, $currentPath as xs:string) as xs:string {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
    let $query-name := $case//catalog:query/@name
    let $filePath := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
    let $xq-string := util:file-read($filePath, "UTF-8")
    return
        $xq-string
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
};

declare function xqts:get-variable($case as element(catalog:test-case), $varName as xs:string) as item()* {
    let $filePath := concat($xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $varName, ".xq")
    let $xq-string := util:file-read($filePath, "UTF-8")
    return
        if (empty($xq-string)) then
            ()
        else
            util:eval($xq-string)
};

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
    if (empty($input)) then
       ()
    else (
        let $source := root($input)//catalog:source[@ID = $input/text()]
        return
            if (empty($source)) then
                concat("no input found: ", $input/text())
            else
                doc(concat("/db/XQTS/", $source/@FileName))
    )
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
    if (starts-with($path, "file:///")) then
        replace($path, "\\", "/")
    else if (starts-with($path, "/")) then
        concat("file://", replace($path, "\\", "/"))
    else
        concat("file:///", replace($path, "\\", "/"))
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:get-expected-results($testCase as element(catalog:test-case)) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        util:catch(
                            "java.lang.Exception",
                            doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                            (: Handle unexpected exceptions :)
                            util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                        )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", util:file-read($outputFilePath, "UTF-8"), "</f>")
                        return
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                            )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case)) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    if ($input eq "works") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works.xml")}</variable>
                    else if ($input eq "works-mod") then
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI("/db/XQTS/TestSources/works-mod.xml")}</variable>
                    else
                        <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:execute-test-case($case)
    return
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $log-resdoc := util:log("DEBUG", ("Creating resdoc collection: ", $resultsDoc))
    let $tests := $group/catalog:test-case
    return
        (
            (: Execute the test cases :)
            for $test in $tests
                let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
                return
                    xqts:run-single-test-case($test, $resultsDoc/test-result),
                    if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) then
                        xqts:finish($resultsDoc/test-result)
                    else
                        xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
                        (: Execute tests in child groups :)
                        for $childGroup in $group/catalog:test-group
                            let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
                            return
                                xqts:run-test-group($childGroup)
        )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else if ($result eq 'error') then
            update value $progress/@error with xs:int($progress/@error + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    let $error := count(//test-case[@result = "error"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
	       error="{$error}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()

xquery version "1.0";

declare namespace xqts="http://exist-db.org/xquery/xqts";
declare namespace catalog="http://www.w3.org/2005/02/query-test-XQTSCatalog";
declare namespace hack="http://exist-db.org/xquery/xqts/hacked-test-cases";

declare namespace props="java:java.io.File";

import module namespace util="http://exist-db.org/xquery/util";
import module namespace xdb="http://exist-db.org/xquery/xmldb";
import module namespace xdiff="http://exist-db.org/xquery/xmldiff"
at "java:org.exist.xquery.modules.xmldiff.XmlDiffModule";
import module namespace request="http://exist-db.org/xquery/request";
declare namespace system="http://exist-db.org/xquery/system";

declare option exist:output-size-limit "-1";

(: $Id$ :)

(:~  ----------------------------------------------------------------------------
     W3C XQuery Test Suite

     This is the main module for running the XQTS on eXist. You can either
     run the whole test suite, a specific test group or a single test case.

     Setup:

     * Make sure the XmlDiff module is registered in conf.xml

     * Edit config.xml and change basedir to point to the directory into
     which you unzipped the XQTS sources. Note: it needs to be an URI.

     * Create a collection /db/XQTS in the database.

     * From the XQTS directory, upload XQTSCatalog.xml into the created
     collection.

     * Upload the "TestSources" directory so the source docs can be found
     in /db/XQTS/TestSources.

     * Run this script with the client.
     -------------------------------------------------------------------------- :)
declare variable $xqts:CONFIG := xqts:initialize();
declare variable $xqts:XQTS_HOME := xqts:path-to-uri($xqts:CONFIG/basedir/text());

declare function xqts:initialize() as element() {
    let $home := system:get-exist-home()
    let $path := concat($home, "/webapp/xqts")
    let $collection := xdb:create-collection("/db", "XQTS")
    let $config0 := doc("/db/XQTS")/config
    let $config :=
        if ($config0) then
            $config0
        else
            let $stored := xdb:store-files-from-pattern("/db/XQTS", $path, "*.xml", "text/xml")
            return
                doc("/db/XQTS/config.xml")/config
    let $xqtsHome := $config/basedir/text()
    let $catalog0 := doc("/db/XQTS/XQTSCatalog.xml")
    let $catalog :=
        if ($catalog0) then $catalog0
        else
            xdb:store($collection, "XQTSCatalog.xml",
                xs:anyURI(xqts:path-to-uri(concat($xqtsHome, "XQTSCatalog.xml"))))
    let $sources0 := collection("/db/XQTS/TestSources")
    let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
    let $collection1 := xdb:create-collection("/db/XQTS/TestSources", "collection1")
    let $collection2 := xdb:create-collection("/db/XQTS/TestSources", "collection2")
    let $sources :=
        if ($sources0) then
            $sources0
        else
            xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    let $docs :=
        (
            (: since XQTS URIs are resolved against /db/XQTS/TestSources :)
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection1", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "bib.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "reviews.xml"),
            xdb:copy($sourceCol, "/db/XQTS/TestSources/collection2", "books.xml"),
            xdb:store($collection, "hacked-tests.xml",
                xs:anyURI(xqts:path-to-uri(
                        concat("file:///", system:get-module-load-path(), "/hacked-tests.xml")
                    )))
        )
    return
        $config
};

declare function xqts:create-progress-file($testCount as xs:int) as empty() {
    let $results := xdb:store("/db/XQTS", "progress.xml",
        <progress total="{$testCount}" done="0" failed="0" passed="0" error="0"/>)
    return ()
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    let $temp := xdb:create-collection("/db/XQTS", "temp")
    let $ancestors := reverse(($group/ancestor::catalog:test-group, $group))
    let $collection := xqts:create-collections($rootColl, $ancestors, "/db/XQTS/test-results")
    let $results := xdb:store($collection, "results.xml", <test-result failed="0" passed="0" error="0"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as xs:string,
    $pathElements as element()+, $currentPath as xs:string) as xs:string {
    let $next := $pathElements[last()]
    let $remainder := subsequence($pathElements, 1, count($pathElements) - 1)
    let $newColl := xdb:create-collection($parent, $next/@name)
    return
        if ($remainder) then
            xqts:create-collections($newColl, $remainder, concat($currentPath, "/", $next/@name))
        else
            $newColl
};

declare function xqts:get-query($case as element(catalog:test-case)) {
    let $query-name := $case//catalog:query/@name
    let $filePath := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
    let $xq-string := util:file-read($filePath, "UTF-8")
    return
        $xq-string
};

declare function xqts:get-input-value($input as element(catalog:input-file)) as item()* {
   if ($input eq "emptydoc") then
       ()
   else
       let $source := root($input)//catalog:source[@ID = $input/text()]
       return
           if (empty($source)) then
               concat("no input found: ", $input/text())
           else
               doc(concat("/db/XQTS/", $source/@FileName))
};

declare function xqts:get-variable($case as element(catalog:test-case), $varName as xs:string) as item()* {
    let $filePath := concat($xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $varName, ".xq")
    let $xq-string := util:file-read($filePath, "UTF-8")
    return
        if (empty($xq-string)) then
            ()
        else
            util:eval($xq-string)
};

declare function xqts:compute-specific-static-context($testCaseName as xs:string) as element()* {
    (
        <unbind-namespace uri="http://exist.sourceforge.net/NS/exist"/>
    ,
        if ($testCaseName eq "ForExpr013") then
            <output-size-limit value="-1"/>
        else if ($testCaseName eq "fn-current-time-4") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:03.455-05:00"/>
        else if ($testCaseName eq "fn-current-time-6") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-7") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.059-05:00"/>
        else if ($testCaseName eq "fn-current-time-10") then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T13:38:18.09-05:00"/>
        else if (starts-with($testCaseName, "fn-current-time-")) then
            (: arbitrary date :)
            <current-dateTime value="2005-12-05T10:15:03.408-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-6") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        (: bloody lower-case ! :)
        else if ($testCaseName eq "fn-current-datetime-7") then
            <current-dateTime value="2005-12-05T17:10:00.312-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-10") then
            <current-dateTime value="2005-12-05T17:10:00.344-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-21") then
            <current-dateTime value="2005-12-05T17:10:00.453-05:00"/>
        else if ($testCaseName eq "fn-current-dateTime-24") then
            <current-dateTime value="2005-12-05T17:10:00.469-05:00"/>
        else
            <current-dateTime value="2005-12-05T17:10:00.203-05:00"/>
    ,
        if (matches($testCaseName,"^fn-implicit-timezone-.*$") or
            matches($testCaseName,"^K-ContextImplicitTimezoneFunc-.*$")) then
            <implicit-timezone value="-PT5H"/>
        else
            ()
    )
};

declare function xqts:get-context-item($input as element(catalog:contextItem)?) as item()* {
    if (empty($input)) then
       ()
    else (
        let $source := root($input)//catalog:source[@ID = $input/text()]
        return
            if (empty($source)) then
                concat("no input found: ", $input/text())
            else
                doc(concat("/db/XQTS/", $source/@FileName))
    )
};

declare function xqts:path-to-uri($path as xs:string) as xs:string {
    if (starts-with($path, "file:///")) then
        replace($path, "\\", "/")
    else if (starts-with($path, "/")) then
        concat("file://", replace($path, "\\", "/"))
    else
        concat("file:///", replace($path, "\\", "/"))
};

declare function xqts:normalize-text($result as item()*) as xs:string {
    let $str := string-join(for $i in $result return string($i), " ")
    return
        (: Remove leading and trailing whitespace :)
        replace(replace($str, "^\s+", ""), "\s+$", "")
};

declare function xqts:normalize-and-expand($text as item()*) as xs:string {
	replace(replace(replace(xqts:normalize-text($text), "&amp;", "&", "m"), "&lt;", "<"),
		"&gt;", ">")
};

declare function xqts:get-expected-results($testCase as element(catalog:test-case)) as element()* {
    let $testName := $testCase/@name
    let $hackedTest := /hack:test-cases/hack:test-case[@name = $testName]
    return
    (
        for $output in $testCase/catalog:output-file
        return
            let $compare :=
                if (exists($hackedTest/@compare)) then
                    $hackedTest/@compare
                else if ($output/@compare eq "Inspect") then
                    (: "Text" by default. OK in most if not all the cases :)
                    "Text"
                else
                    $output/@compare
            let $outputFilePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath,
                $output/text())
            return
                <expected-result compare="{$compare}">
                {
                    if ($compare eq "Text") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "UnnormalizedText") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "TextAsXML") then
                        xqts:normalize-and-expand(util:file-read($outputFilePath, "UTF-8"))
                    else if ($compare eq "XML") then
                        util:catch(
                            "java.lang.Exception",
                            doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), xs:anyURI($outputFilePath), "text/xml")),
                            (: Handle unexpected exceptions :)
                            util:log("ERROR", concat("Exception while loading expected result: ", $util:exception-message))
                        )
                    else if ($compare eq "Fragment") then
                        let $xmlFrag := concat("<f>", util:file-read($outputFilePath, "UTF-8"), "</f>")
                        return
                            util:catch(
                                "java.lang.Exception",
                                doc(xdb:store("/db/XQTS/temp", substring-before($output/text(), "."), $xmlFrag, "text/xml")),
                                (: Handle unexpected exceptions :)
                                util:log("ERROR", concat("Exception while loading expected result fragment: ", $util:exception-message))
                            )
                    else
                        util:log("ERROR", concat("Unknown comparison method: ", $compare))
                }
                </expected-result>
    ,
        (: due to a possible bug in the MemTreeBuilder, the parent element will be copied ! :)
        if (exists($hackedTest/hack:expected-result)) then
            $hackedTest/hack:expected-result
        else
            ()
    )
};

declare function xqts:execute-test-case($testCase as element(catalog:test-case)) as element()? {
    let $context :=
        <static-context>
            {
                xqts:compute-specific-static-context(string($testCase/@name))
            }
            {
                for $input in $testCase/catalog:input-file
                return
                    <variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
                for $var in $testCase/catalog:input-query
                return
                    let $variable := xqts:get-variable($testCase, $var/@name)
                    return
                        <variable name="{$var/@variable}" type="{util:get-sequence-type($variable)}">{$variable}</variable>,
                for $input in $testCase/catalog:input-URI
                return
                    <variable name="{$input/@variable}" type="xs:anyURI">{xs:anyURI(concat("/db/XQTS/TestSources/", $input))}</variable>
            }
            {
                for $input in $testCase/catalog:defaultCollection
                return
                    <staticallyKnownDocuments>{concat("/db/XQTS/TestSources/", $input)}</staticallyKnownDocuments>
            }
        </static-context>
    let $query := xqts:get-query($testCase)
    let $expectedResults := xqts:get-expected-results($testCase)
    let $formatedResult :=
        util:catch(
            "java.lang.Exception",
            let $raw_result := util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
            return
                xqts:compute-result($testCase, $query, $raw_result, $expectedResults),

            (: Exception processing :)
            (: Only expected exception and got exception. No check on if it is the right exception, though. :)
            if (fn:exists($testCase//catalog:expected-error) and empty($expectedResults)) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-got-exception">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
               </test-case>
            (: Expected either output or exception. :)
            else if (fn:exists($testCase//catalog:expected-error) and fn:exists($expectedResults)) then
                <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}" print="expected-exception-or-output">
                    (: TODO : check exception code :)
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
            (: Expected output, but got exception. :)
            else if (fn:empty($testCase//catalog:expected-error) and fn:exists($testCase//catalog:output-file)) then
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="expected-output-got-exception">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    <query>{$query}</query>
                </test-case>
            (: Don't know what is expected but got here anyway. :)
            else
                <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}" print="unhandled-error">
                    <exception>{$util:exception-message}</exception>
                    {
                        for $expectedResult in $expectedResults
                        return
                            $expectedResult
                    }
                    {
                        for $expected-error in $testCase//catalog:expected-error
                        return
                            <expected-error>{$expected-error/text()}</expected-error>
                    }
                    <query>{$query}</query>
                </test-case>
        )
        let $log :=
            if (fn:empty($formatedResult)) then
                util:log("DEBUG", ("Unable to generate a formated result: ", xs:string($testCase/@name)))
            else
                ()
    return $formatedResult
};

declare function xqts:compute-result($testCase as element(catalog:test-case), $query as xs:string, $result as item()*, $expectedResults as element()* ) {
    let $passed := some $expectedResultTest in (
        for $expectedResult in $expectedResults
        return
            let $comparisonMethod := $expectedResult/@compare
            return
                if ($comparisonMethod eq "Text") then
                    (: don't use text() because () neq "" :)
                    $expectedResult/string() eq xqts:normalize-text($result)
                else if ($comparisonMethod eq "UnnormalizedText") then
                    (: don't use text() because () neq "" :)
                    (: join the results in one single string :)
                    $expectedResult/string() eq string-join($result, "")
                else if ($comparisonMethod eq "TextAsXML") then
                    xdiff:compare($expectedResult/*, util:eval($result))
                else if ($comparisonMethod eq "XML") then
                    xdiff:compare($expectedResult/*, $result)
                else if ($comparisonMethod eq "Fragment") then
                    xdiff:compare($expectedResult/*, <f>{$result}</f>)
                (: unlikely :)
                else
                    false()
    ) satisfies $expectedResultTest
    return
        xqts:format-result($testCase, $passed, $query, $result, $expectedResults)
};

declare function xqts:format-result($testCase as element(catalog:test-case), $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expectedResults as item()*) as element() {
    <test-case name="{$testCase/@name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}" print="result-without-exception">
        <result>{$result}</result>
        {
            for $expectedResult in $expectedResults
            return
                $expectedResult
        }
        {
            for $expected-error in $testCase//catalog:expected-error
            return
                <expected-error>{$expected-error/text()}</expected-error>
        }
        <query>{$query}</query>
    </test-case>
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:execute-test-case($case)
    return
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        let $log :=
            if (fn:empty($added)) then
                util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($case/@name)))
            else
                ()
        return
            if ($added) then
                xqts:report-progress($added)
            else
                ()
};

declare function xqts:run-test-group($group as element(catalog:test-group)) as empty() {
    (: Create the collection hierarchy for this group and get the results.xml doc to append to. :)
    let $resultsDoc := xqts:create-collections($group)
    let $log-resdoc := util:log("DEBUG", ("Creating resdoc collection: ", $resultsDoc))
    let $tests := $group/catalog:test-case
    return
        (
            (: Execute the test cases :)
            for $test in $tests
                let $log := util:log("DEBUG", ("Running test case: ", string($test/@name)))
                return
                    xqts:run-single-test-case($test, $resultsDoc/test-result),
                    if (fn:exists($tests) and fn:exists($resultsDoc/test-result)) then
                        xqts:finish($resultsDoc/test-result)
                    else
                        xdb:remove(util:collection-name($resultsDoc), util:document-name($resultsDoc)),
                        (: Execute tests in child groups :)
                        for $childGroup in $group/catalog:test-group
                            let $log := util:log("DEBUG", ("Entering group: ", string($childGroup/@name)))
                            return
                                xqts:run-test-group($childGroup)
        )
};

declare function xqts:test-single($name as xs:string) as element() {
    let $test := //catalog:test-case[@name = $name]
    return
        if ($test) then
            let $resultsDoc := xqts:create-collections($test/parent::catalog:test-group)
            let $dummy := xqts:run-single-test-case($test, $resultsDoc/test-result)
            return
                $resultsDoc/test-result
        else
            <error>Test case not found: {$name}.</error>
};

declare function xqts:test-group($groupName as xs:string) as empty() {
    let $group := //catalog:test-group[@name = $groupName]
    return (
        xqts:create-progress-file(count($group//catalog:test-case)),
        xqts:run-test-group($group)
    )
};

declare function xqts:test-all() as empty() {
    for $test in /catalog:test-suite/catalog:test-group
    return
        xqts:test-group($test/@name)
};

declare function xqts:report-progress($test-case as element()) as empty() {
    let $result := string($test-case/@result)
    let $progress := doc("/db/XQTS/progress.xml")/progress
    let $counter := $progress/@done
    return (
        update value $counter with xs:int($counter + 1),
        if ($result eq 'fail') then
            update value $progress/@failed with xs:int($progress/@failed + 1)
        else if ($result eq 'error') then
            update value $progress/@error with xs:int($progress/@error + 1)
        else
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:finish($result as element()) as empty() {
    let $passed := count($result//test-case[@result = 'pass'])
    let $failed := count($result//test-case[@result = 'fail'])
    let $error := count($result//test-case[@result = 'error'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed),
        update value $result/@error with xs:int($error)
    )
};

declare function xqts:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    let $error := count(//test-case[@result = "error"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
	       error="{$error}"
            percentage="{$passed div ($passed + $failed)}"/>
};

let $group := request:get-parameter('group', ())
return
    if ($group) then
        xqts:test-group($group)
    else
        ()


XQTS collect reports.... last fix

XQTS collect reports.... last fix

svn path=/trunk/eXist-1.0/; revision=4038

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename="results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml"" ) )

return
(: <test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"> :)
<test-suite-result>
        <implementation name="{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="me@not.com"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>
{ for $feature in doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/*:features/*:feature
							return
							<feature name="{$feature/@name}" supported="true"/>
						}</features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in fn:collection(  '/db/XQTS' )//test-case
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>

declare option exist:serialize "method=xml indent=yes";
declare option exist:output-size-limit "-1";
declare namespace response="http://exist-db.org/xquery/response";

let $product-version := util:system-property("product-version")
let $product-build := util:system-property("product-build")
let $test-suite := doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/@version
let $dummy := response:set-header("Content-Disposition", concat(
	"attachment; filename='results_XQTS-" , $test-suite , "_eXist-" ,
	$product-version , '_' , $product-build , ".xml'" ) )

return
(: <test-suite-result xmlns="http://www.w3.org/2005/02/query-test-XQTSResult"
        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"> :)
<test-suite-result>
        <implementation name="{$product-version}" version="{$product-build}" anonymous-result-column="false">

                <organization name="eXist Open Source native XML database"  website="http://www.exist-db.org" anonymous="false"/>

                <submittor name="eXist XQTS testsuite runner" email="me@not.com"/>

                <description>

eXist is an Open Source native XML database featuring efficient,
                        index-based XQuery processing, automatic indexing, extensions for full-text
                        search,  XUpdate  support and tight integration with existing XML development tools.

                </description>

                <implementation-defined-items>

                </implementation-defined-items>

                <features>
{ for $feature in doc('/db/XQTS/XQTSCatalog.xml')/*:test-suite/*:features/*:feature
							return
							<feature name="{$feature/@name}" supported="true"/>
						}</features>

                <context-properties>

                </context-properties>

        </implementation>

        <syntax>XQuery</syntax>

        <test-run dateRun="{fn:current-dateTime()}">
                <test-suite version="{$test-suite}"/>
                <transformation>

No unusual transformations.

                </transformation>
                <comparison>

No unusual comparisons

                </comparison>
                <otherComments>

The test run took n seconds.

                </otherComments>
        </test-run>

{
		(: for $case in fn:collection(  '/db/XQTS' )//*:test-case :)
    for $case in fn:collection(  '/db/XQTS' )//test-case
    return <test-case name="{$case/@name}" result="{$case/@result}" />
}
</test-suite-result>


Verbose is set to 'false' by default.

Verbose is set to 'false' by default.

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";
import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

(:~ path to the place where FOTS can be found :)
declare variable $fotsPath as xs:string external := "";

(:~ path to the place where the FOTS Zorba manifest can be found :)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~ Path to the results from a previous run :)
declare variable $failuresFilePath as xs:string external := "";

(:~ choose the CLI option you want to run :)
declare variable $mode as xs:string external := "";

(:~ name/criteria for the test sets :)
declare variable $testSetPrefixes as xs:string external := "";

(:~ name/criteria for the test cases :)
declare variable $testCasePrefixes as xs:string external := "";

(:~ name for the test set :)
declare variable $testSetName as xs:string external := "";

(:~ name for the test case :)
declare variable $testCaseName as xs:string external := "";

(:~ Enable or disable verbose output :)
declare variable $verbose as xs:string external := "false";

(:~ assertion type :)
declare variable $assertType as xs:string external := "";

(:~ dependency: used in 'list-test-cases' and 'run-test-sets' modes:)
declare variable $dependency as xs:string external := "";

(:~ regex for the tests in the 'list-matching-test-cases' option :)
declare variable $pattern as xs:string external := "";

(:~ flags for the tests in the 'list-matching-test-cases' option :)
declare variable $flags as xs:string external := "";

(:~ Path to the ExpectedFailures file :)
declare variable $expectedFailuresPath  as xs:string external :="";

(:~ Tokenize comma or empty string :)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  let $tokens := tokenize($input, ",")
  return if (exists($tokens)) then $tokens else ""
};

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertType:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertType:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e failuresFilePath:=failures.xml -e verbose:=false -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e failuresFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~ The test cases in this list have bugs assigned and should not be run :)
variable $exceptedTestCases := (
"cbcl-subsequence-011", "cbcl-subsequence-012", "cbcl-subsequence-013",
"cbcl-subsequence-014"                                  (:see bug lp:1069794 :)
, "re00975", "re00976", "re00976a"                      (:see bug lp:1070533 :)
, "fn-unparsed-text-lines-052"                          (:see bug lp:1073175 :)
);

(:~  The test in this list have bugs assigned already and should not be run :)
variable $exceptedTestSets := ();

switch ($mode)
case "list-test-sets"
  return
    string-join(
      (d:list-test-sets(
        trace($fotsPath, "Path to FOTS catalog.xml set to: "),
        local:tokenize(trace($testSetPrefixes, "'testSetPrefixes' set to: ")))),
       "
")
case "list-test-cases"
  return
    string-join(
      (d:list-test-cases( trace($fotsPath,
                                "Path to FOTS catalog.xml set to: "),
                          local:tokenize(trace($testSetPrefixes,
                                          "'testSetPrefixes' set to: ")),
                          "",
                          trace($dependency,
                                "'dependency' set to:"),
                          trace($assertType,
                                "'assertType' set to: "))),
               "
")
case "list-matching-test-cases"
  return string-join((d:list-matching-test-cases(
                            trace($fotsPath,
                                  "Path to FOTS catalog.xml set to: "),
                            trace($pattern,
                                  "pattern set to: "),
                            trace($flags,
                                  "flags were set to: ")), ""),
                     "
")
case "run-test-sets"
  return d:run-fots($fotsPath,
                    $fotsZorbaManifestPath,
                    d:list-test-sets($fotsPath,
                                     local:tokenize(trace($testSetPrefixes,
                                       "'testSetPrefixes' set to: "))),
                    d:list-test-cases($fotsPath,
                                      local:tokenize($testSetPrefixes),
                                      local:tokenize(trace($testCasePrefixes,
                                        "'testCasePrefixes' set to: ")),
                                      trace($dependency,
                                        "'dependency' set to:"),
                                      trace($assertType,
                                         "'assertType' set to: ")),
                    $exceptedTestCases,
                    $exceptedTestSets,
                    xs:boolean($verbose),
                    $expectedFailuresPath)
case "run-test-case"
  return d:run-fots($fotsPath,
                    $fotsZorbaManifestPath,
                    trace($testSetName, "'testSetName' set to: "),
                    trace($testCaseName,"'testCaseName' set to: "),
                    $exceptedTestCases,
                    $exceptedTestSets,
                    xs:boolean($verbose),
                    $expectedFailuresPath)
case "run-and-report"
  return r:run-and-report($fotsPath,
                          $fotsZorbaManifestPath,
                          $exceptedTestCases,
                          $exceptedTestSets,
        (: the reports to W3C are always generated with verbose set to false:)
                          fn:false())
case "report"
  return r:report($fotsPath,
                  $failuresFilePath,
                  $exceptedTestCases,
                  $exceptedTestSets,
                  xs:boolean($verbose))
case "generate-expected-failures"
  return r:generate-expected-failures($failuresFilePath)
default
  return local:usage()

(:
 : Copyright 2006-2011 The FLWOR Foundation.
 :
 : Licensed under the Apache License, Version 2.0 (the "License");
 : you may not use this file except in compliance with the License.
 : You may obtain a copy of the License at
 :
 : http://www.apache.org/licenses/LICENSE-2.0
 :
 : Unless required by applicable law or agreed to in writing, software
 : distributed under the License is distributed on an "AS IS" BASIS,
 : WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 : See the License for the specific language governing permissions and
 : limitations under the License.
 :)

(:~
 : Zorba FOTS driver CLI
 : @author Ghislain Fourny, Sorin Nasoi
 :)

import module namespace d =
  "http://www.zorba-xquery.com/fots-driver" at "fots-driver.xq";
import module namespace r =
  "http://www.zorba-xquery.com/fots-driver/reporting" at "reporting.xq";

(:~ path to the place where FOTS can be found :)
declare variable $fotsPath as xs:string external := "";

(:~ path to the place where the FOTS Zorba manifest can be found :)
declare variable $fotsZorbaManifestPath as xs:string external :=
  "FOTSZorbaManifest.xml";

(:~ Path to the results from a previous run :)
declare variable $failuresFilePath as xs:string external := "";

(:~ choose the CLI option you want to run :)
declare variable $mode as xs:string external := "";

(:~ name/criteria for the test sets :)
declare variable $testSetPrefixes as xs:string external := "";

(:~ name/criteria for the test cases :)
declare variable $testCasePrefixes as xs:string external := "";

(:~ name for the test set :)
declare variable $testSetName as xs:string external := "";

(:~ name for the test case :)
declare variable $testCaseName as xs:string external := "";

(:~ Enable or disable verbose output :)
declare variable $verbose as xs:string external := "true";

(:~ assertion type :)
declare variable $assertType as xs:string external := "";

(:~ dependency: used in 'list-test-cases' and 'run-test-sets' modes:)
declare variable $dependency as xs:string external := "";

(:~ regex for the tests in the 'list-matching-test-cases' option :)
declare variable $pattern as xs:string external := "";

(:~ flags for the tests in the 'list-matching-test-cases' option :)
declare variable $flags as xs:string external := "";

(:~ Path to the ExpectedFailures file :)
declare variable $expectedFailuresPath  as xs:string external :="";

(:~ Tokenize comma or empty string :)
declare %private function local:tokenize(
  $input as xs:string
) as xs:string*
{
  let $tokens := tokenize($input, ",")
  return if (exists($tokens)) then $tokens else ""
};

declare function local:usage() as xs:string
{
  string-join((
    "Zorba FOTS driver usage examples:",
    "If you run Zorba from a checkout of the trunk and the build/bin folder,",
    "- /path/to/cli.xq can be set to ../../test/fots_driver/cli.xq",
    "",
    "Always try to output the result back to an XML file with nice indentation:",
    "./zorba -f -q ../../test/fots_driver/cli.xq -e SET_CLI_OPTIONS_HERE -o output.xml --indent",
    "",
    " This way you will see trace information in the CLI window and detailed",
    " results of the test cases in the 'output.xml'.",
    "",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e fotsZorbaManifestPath:=/path/to/Zorba_manifest.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-sets -e testSetPrefixes:=prod,app",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e testSetPrefixes:=prod-Literal",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-test-cases -e dependency:=higherOrderFunctions -e assertType:=assert-count",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=list-matching-test-cases -e pattern:=catch",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e expectedFailuresPath:=ExpectedFailures.xml -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e dependency:=higherOrderFunctions_false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod -e assertType:=assert-count -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-sets -e testSetPrefixes:=prod-Literal -e verbose:=false -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-test-case -e testSetName:=prod-Literal -e testCaseName:=Literals001 -o result.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=run-and-report -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e fotsPath:=/path/to/QT3-test-suite/catalog.xml -e mode:=report -e failuresFilePath:=failures.xml -e verbose:=false -o report.xml --indent",
    "zorba -f -q /path/to/cli.xq -e mode:=generate-expected-failures -e failuresFilePath:=failures.xml -o ExpectedFailures.xml --indent",
    ""
    ), "
")
};

(:~ The test cases in this list have bugs assigned and should not be run :)
variable $exceptedTestCases := (
"cbcl-subsequence-011", "cbcl-subsequence-012", "cbcl-subsequence-013",
"cbcl-subsequence-014"                                  (:see bug lp:1069794 :)
, "re00975", "re00976", "re00976a"                      (:see bug lp:1070533 :)
, "fn-unparsed-text-lines-052"                          (:see bug lp:1073175 :)
);

(:~  The test in this list have bugs assigned already and should not be run :)
variable $exceptedTestSets := ();

switch ($mode)
case "list-test-sets"
  return
    string-join(
      (d:list-test-sets(
        trace($fotsPath, "Path to FOTS catalog.xml set to: "),
        local:tokenize(trace($testSetPrefixes, "'testSetPrefixes' set to: ")))),
       "
")
case "list-test-cases"
  return
    string-join(
      (d:list-test-cases( trace($fotsPath,
                                "Path to FOTS catalog.xml set to: "),
                          local:tokenize(trace($testSetPrefixes,
                                          "'testSetPrefixes' set to: ")),
                          "",
                          trace($dependency,
                                "'dependency' set to:"),
                          trace($assertType,
                                "'assertType' set to: "))),
               "
")
case "list-matching-test-cases"
  return string-join((d:list-matching-test-cases(
                            trace($fotsPath,
                                  "Path to FOTS catalog.xml set to: "),
                            trace($pattern,
                                  "pattern set to: "),
                            trace($flags,
                                  "flags were set to: ")), ""),
                     "
")
case "run-test-sets"
  return d:run-fots($fotsPath,
                    $fotsZorbaManifestPath,
                    d:list-test-sets($fotsPath,
                                     local:tokenize(trace($testSetPrefixes,
                                       "'testSetPrefixes' set to: "))),
                    d:list-test-cases($fotsPath,
                                      local:tokenize($testSetPrefixes),
                                      local:tokenize(trace($testCasePrefixes,
                                        "'testCasePrefixes' set to: ")),
                                      trace($dependency,
                                        "'dependency' set to:"),
                                      trace($assertType,
                                         "'assertType' set to: ")),
                    $exceptedTestCases,
                    $exceptedTestSets,
                    xs:boolean($verbose),
                    $expectedFailuresPath)
case "run-test-case"
  return d:run-fots($fotsPath,
                    $fotsZorbaManifestPath,
                    trace($testSetName, "'testSetName' set to: "),
                    trace($testCaseName,"'testCaseName' set to: "),
                    $exceptedTestCases,
                    $exceptedTestSets,
                    xs:boolean($verbose),
                    $expectedFailuresPath)
case "run-and-report"
  return r:run-and-report($fotsPath,
                          $fotsZorbaManifestPath,
                          $exceptedTestCases,
                          $exceptedTestSets,
        (: the reports to W3C are always generated with verbose set to false:)
                          fn:false())
case "report"
  return r:report($fotsPath,
                  $failuresFilePath,
                  $exceptedTestCases,
                  $exceptedTestSets,
                  xs:boolean($verbose))
case "generate-expected-failures"
  return r:generate-expected-failures($failuresFilePath)
default
  return local:usage()


[bugfix] Make sure not to assume the URL is /exist/ when reverse proxying Closes https://github.com/eXist-db/exist/issues/1122

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "3.0";

(:~ -------------------------------------------------------
    Main controller: handles all requests not matched by
    sub-controllers.
    ------------------------------------------------------- :)

declare namespace c="http://exist-db.org/xquery/controller";
declare namespace expath="http://expath.org/ns/pkg";

import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb = "http://exist-db.org/xquery/xmldb";

declare function local:get-dashboard() {
	let $path := collection(repo:get-root())//expath:package[@name = "http://exist-db.org/apps/dashboard"]
    return
        if ($path) then
            substring-after(util:collection-name($path), repo:get-root())
        else
            ()
};

let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($exist:path eq '') then
	   <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	     <redirect url="{concat(request:get-uri(), '/')}"/>
	   </dispatch>
    else if ($exist:path eq '/') then
    	let $dashboard := local:get-dashboard()
    	return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			{
			if ($dashboard) then
                if(request:get-uri() = "/exist/" and request:get-header("X-Forwarded-URI") = "/") then
                   <redirect url="/apps/{$dashboard}/"/>
                else
                   <redirect url="apps/{$dashboard}/"/>
            else
                <redirect url="404.html"/>
			}
			</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>

(: 	This is the main controller for the web application. It is called from the
	XQueryURLRewrite filter configured in web.xml. :)
xquery version "3.0";

(:~ -------------------------------------------------------
    Main controller: handles all requests not matched by
    sub-controllers.
    ------------------------------------------------------- :)

declare namespace c="http://exist-db.org/xquery/controller";
declare namespace expath="http://expath.org/ns/pkg";

import module namespace request="http://exist-db.org/xquery/request";
import module namespace xdb = "http://exist-db.org/xquery/xmldb";

declare function local:get-dashboard() {
	let $path := collection(repo:get-root())//expath:package[@name = "http://exist-db.org/apps/dashboard"]
    return
        if ($path) then
            substring-after(util:collection-name($path), repo:get-root())
        else
            ()
};

let $query := request:get-parameter("q", ())
return
	(: redirect webapp root to index.xml :)
    if ($exist:path eq '') then
	   <dispatch xmlns="http://exist.sourceforge.net/NS/exist">
	     <redirect url="{concat(request:get-uri(), '/')}"/>
	   </dispatch>
    else if ($exist:path eq '/') then
    	let $dashboard := local:get-dashboard()
    	return
			<dispatch xmlns="http://exist.sourceforge.net/NS/exist">
			{
				if ($dashboard) then
					<redirect url="apps/{$dashboard}/"/>
				else
					<redirect url="404.html"/>
			}
			</dispatch>
	else
		<ignore xmlns="http://exist.sourceforge.net/NS/exist">
            <cache-control cache="yes"/>
		</ignore>


DBA: Aligned with db:create-backup

DBA: Aligned with db:create-backup

(:~
 : Create backup.
 :
 : @author Christian Grün, BaseX Team 2005-22, BSD License
 :)
module namespace dba = 'dba/databases';

import module namespace html = 'dba/html' at '../../lib/html.xqm';
import module namespace util = 'dba/util' at '../../lib/util.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'databases';
(:~ Sub category :)
declare variable $dba:SUB := 'database';

(:~
 : Form for creating a backup.
 : @param  $name  database
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/backup-create')
  %rest:query-param('name', '{$name}')
  %output:method('html')
function dba:backup-create(
  $name  as xs:string
) as element(html) {
  html:wrap(map { 'header': ($dba:CAT, $name) },

        <form action='backup-create' method='post' autocomplete='off'>
          <input type='hidden' name='name' value='{ $name }'/>

{
            html:link('Databases', $dba:CAT), ' » ',
            html:link($name, $dba:SUB, map { 'name': $name }), ' » ',
            html:button('backup-create', 'Create Backup')
          }

              Comment (optional):

                <input type='text' name='comment' id='comment' size='64'/>
                { html:focus('comment') }

        </form>

  )
};

(:~
 : Creates a backup.
 : @param  $name     database
 : @param  $comment  comment
 : @return redirection
 :)
declare
  %updating
  %rest:POST
  %rest:path('/dba/backup-create')
  %rest:query-param('name',    '{$name}')
  %rest:query-param('comment', '{$comment}')
function dba:db-rename(
  $name     as xs:string,
  $comment  as xs:string
) as empty-sequence() {
  try {
    db:create-backup($name, map { 'comment': $comment }),
    util:redirect($dba:SUB, map { 'name': $name, 'info': 'Backup was created.' })
  } catch * {
    util:redirect($dba:SUB, map { 'name': $name, 'error': $err:description })
  }
};

(:~
 : Create backup.
 :
 : @author Christian Grün, BaseX Team 2005-22, BSD License
 :)
module namespace dba = 'dba/databases';

import module namespace html = 'dba/html' at '../../lib/html.xqm';
import module namespace util = 'dba/util' at '../../lib/util.xqm';

(:~ Top category :)
declare variable $dba:CAT := 'databases';
(:~ Sub category :)
declare variable $dba:SUB := 'database';

(:~
 : Form for creating a backup.
 : @param  $name  database
 : @return page
 :)
declare
  %rest:GET
  %rest:path('/dba/backup-create')
  %rest:query-param('name', '{$name}')
  %output:method('html')
function dba:backup-create(
  $name  as xs:string
) as element(html) {
  html:wrap(map { 'header': ($dba:CAT, $name) },

        <form action='backup-create' method='post' autocomplete='off'>
          <input type='hidden' name='name' value='{ $name }'/>

{
            html:link('Databases', $dba:CAT), ' » ',
            html:link($name, $dba:SUB, map { 'name': $name }), ' » ',
            html:button('backup-create', 'Create Backup')
          }

              Comment (optional):

                <input type='text' name='comment' id='comment' size='64'/>
                { html:focus('comment') }

        </form>

  )
};

(:~
 : Creates a backup.
 : @param  $name     database
 : @param  $comment  comment
 : @return redirection
 :)
declare
  %updating
  %rest:POST
  %rest:path('/dba/backup-create')
  %rest:query-param('name',    '{$name}')
  %rest:query-param('comment', '{$comment}')
function dba:db-rename(
  $name     as xs:string,
  $comment  as xs:string
) as empty-sequence() {
  try {
    db:create-backup($name, $comment),
    util:redirect($dba:SUB, map { 'name': $name, 'info': 'Backup was created.' })
  } catch * {
    util:redirect($dba:SUB, map { 'name': $name, 'error': $err:description })
  }
};


cosmetic

cosmetic

(: flwor has if statement in return collapsed into existing where as
joining of original where and if condition through boolean AND operation
and will chain multiple nested if statements :)

for $x in (1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
where $x < 8
return if ($x > 2)
       then if ($x mod 2 eq 0) then $x else ()
       else ()

(: flwor has if statement in return collapsed into existing where as
joining of original where and if condition through boolean AND operation
and will chain multiple nested if statements :)

for $x in (1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
where $x < 8
return if($x > 2)
then if($x mod 2 eq 0) then $x else ()
else ()