Display result even when an exception is expected. Reformated expected exceptionS.

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

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

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";

(:~ ----------------------------------------------------------------------------------------
     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 $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

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

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"/>)
    return ()
};

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
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    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"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    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 $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

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:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

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

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $case/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $case/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($case, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($case//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

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'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        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 $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    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 ($tests) 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: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:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

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

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

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";

(:~ ----------------------------------------------------------------------------------------
     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 $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

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

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"/>)
    return ()
};

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
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    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"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    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 $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

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:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail">
                   <expected-error>{$case/catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

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

declare function xqts:run-test-case( $case as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($case)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			for $input in $case/catalog:input-file
           			return
               			<variable name="{$input/@variable}">{xqts:get-input-value($input)}</variable>,
            		for $var in $case/catalog:input-query
            		return
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($case, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false())
           return
               xqts:check-output($query, $result, $case),
           if ($case//catalog:expected-error) then
               <test-case name="{$case/@name}" result="pass">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{$case//catalog:expected-error/text()}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$case/@name}" result="fail">
                   <exception>{$util:exception-message}</exception>
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

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'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        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 $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    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 ($tests) 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: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:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

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


Fixed the xqts app to be more correct regarding alternative results and added fallbacks. Check comment in xqts:check-output() regarding reproducing corruption.

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

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

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";

(: $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 $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

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

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: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:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    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 object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    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 $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

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:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
  let $all-results :=
    for $output in $case/catalog:output-file
    return
        (: Expected only an error, but still got a result :)
        if (fn:exists($case/catalog:expected-error) and fn:empty($case/catalog:output-file)) then
            <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                (:
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $doh := doc(xdb:store("/db", $output, $xmlFrag, "text/xml"))
		:)
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, <f>{$result}</f>, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
      else
        <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}">
          <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
          <query>{$query}</query>
	</test-case>
    (: Use this let clause to get an update insert failure from the 5314th
       test and onward in xqts:report-progress(). in-memory-temp-frag corrpution
       reproducible in xqts, who could imagine... /ljo :)
    (: let $passed := $all-results//test-case[@result eq 'pass'] :)
    let $passed :=
      if (fn:exists($all-results[2])) then
	let $result-frag := concat("<f>", $all-results, "</f>")
	let $results-doc := doc(xdb:store("/db", "temp-res.xml", $result-frag, "text/xml"))
        return $results-doc//test-case[@result eq 'pass']
      else ()
    return
      if (fn:exists($passed)) then
	$passed[1]
      else if (fn:exists($all-results[1])) then
	$all-results[1]
      else
        (: Expected runtime-exception, but got a result :)
      if (fn:exists($case/catalog:expected-error) and $case/@scenario eq "runtime-error") then
        <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
          <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
          <result>{$result}</result>
          <query>{$query}</query>
        </test-case>
      else
	let $log-all := util:log("DEBUG", ("Unhandled error, no result for: ", xs:string($case/@name)))
	return
	  <test-case name="{$case/@name}" result="error" dateRun="{util:system-time()}">
    	    <error test="{$case/@name}">Cannot handle: {$case/@name}.</error>
            <query>{$query}</query>
          </test-case>

};

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

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			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
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($testCase, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
           if ($testCase//catalog:expected-error) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>{$util:exception-message}</exception>
		   {
		     for $output in $testCase/catalog:output-file
		     return <expected>{
                     let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $testCase/@FilePath, $output/text())
                     return util:file-read($filePath, "UTF-8")
                     }</expected>
		   }
                   <query>{$query}</query>
               </test-case>
       )
       let $log := if (fn:empty($result)) then util:log("DEBUG", ("FAILURE in-memory-frag in test: ", xs:string($testCase/@name))) else ()
   return $result
};

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:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-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
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    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: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-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: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
        ()

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

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";

(:~ ----------------------------------------------------------------------------------------
     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 $sources :=
        if ($sources0) then
            $sources0
        else
            let $sourceCol := xdb:create-collection("/db/XQTS", "TestSources")
            return
                xdb:store-files-from-pattern($sourceCol, concat($xqtsHome, "TestSources"), "*.xml", "text/xml")
    return
        $config
};

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

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"/>)
    return ()
};

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
            update value $progress/@passed with xs:int($progress/@passed + 1)
    )
};

declare function xqts:create-collections($group as element(catalog:test-group)) as node() {
    let $rootColl := xdb:create-collection("/db/XQTS", "test-results")
    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"/>)
    return
        doc($results)
};

declare function xqts:create-collections($parent as object,
    $pathElements as element()+, $currentPath as xs:string)
as object {
    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 $path := concat( $xqts:XQTS_HOME, "Queries/XQuery/", $case/@FilePath, $query-name, ".xq" )
   let $xq-string := util:file-read($path, "UTF-8")
   return $xq-string
};

declare function xqts:print-result($test-name as xs:string, $passed as xs:boolean, $query as xs:string,
    $result as item()*, $expected as item()*, $case as element(catalog:test-case)) as element() {
    <test-case name="{$test-name}" result="{if ($passed) then 'pass' else 'fail'}" dateRun="{util:system-time()}">
    {
        if (not($passed)) then (
            <result>{$result}</result>,
            if ($expected instance of element() and count($expected/*) > 10) then
            	<expected truncated="">{$expected/*[position() < 10]}</expected>
            else
                <expected>{$expected}</expected>,
            (: element {$case/catalog:input-file/@variable} { xqts:getInputValue($case) }, :)
            <query>{$query}</query>
        ) else ()
    }
    </test-case>
};

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:check-output($query as xs:string, $result as item()*, $case as element(catalog:test-case)) {
    let $output := $case/catalog:output-file[last()]
    return
        (: Expected an error, but got a result :)
        if (exists($case/catalog:expected-error)) then
            <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <expected-error>{string-join($case/catalog:expected-error/text(), ";")}</expected-error>
                   <result>{$result}</result>
                   <query>{$query}</query>
            </test-case>
        (: Comparison method: "Text" :)
        else if ($output/@compare eq "Text") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-and-expand($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)
        (: Comparison method: "XML" :)
        else if ($output/@compare eq "XML") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                    $output/text())
                let $expected := doc(xdb:store("/db", "temp.xml", xs:anyURI($filePath), "text/xml"))
                let $test := xdiff:compare($expected, $result)
                return
                    xqts:print-result($case/@name, $test, $query, $result, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>Exception while loading expected result: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Fragment" :)
        else if ($output/@compare eq "Fragment") then
            util:catch("java.lang.Exception",
                let $filePath := concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath, $output/text())
                let $expectedFrag := util:file-read($filePath, "UTF-8")
                let $xmlFrag := concat("<f>", $expectedFrag, "</f>")
                let $log := util:log("DEBUG", ("Frag stored: ", $xmlFrag))
                let $expected := doc(xdb:store("/db", "temp.xml", $xmlFrag, "text/xml"))
                let $doh := doc(xdb:store("/db", $case/@name, $xmlFrag, "text/xml"))
                let $test := xdiff:compare($expected, <f>{$result}</f>)
                return
                    xqts:print-result($case/@name, $test, $query, <f>{$result}</f>, $expected, $case),
                (: Handle unexpected exceptions :)
                <test-case name="{$case/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>Exception while loading expected result fragment: {$util:exception-message}</exception>
                   <query>{$query}</query>
                </test-case>
            )
        (: Comparison method: "Inspect" :)
        (: A text compare is sufficient in many test cases :)
        else if ($output/@compare eq "Inspect") then
            let $text := util:file-read(concat($xqts:XQTS_HOME, "ExpectedTestResults/", $case/@FilePath,
                "/", $output/text()), "UTF-8")
            let $test := xqts:normalize-text($text) eq xqts:normalize-text($result)
            return
                xqts:print-result($case/@name, $test, $query, $result, $text, $case)

        (: Don't know how to compare :)
        else
            <error test="{$case/@name}">Unknown comparison method: {$output/@compare}.</error>
};

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

declare function xqts:run-test-case( $testCase as element(catalog:test-case)) as item()* {
   let $query := xqts:get-query($testCase)
   let $result :=
       util:catch("java.lang.Exception",
			let $context :=
				<static-context>
       			{
           			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
                		<variable name="{$var/@variable}">
                    		{xqts:get-variable($testCase, $var/@name)}
                		</variable>
       			}
       			</static-context>
           let $result :=
               util:eval-with-context($query, $context, false(), xqts:get-context-item($testCase/catalog:contextItem))
           return
               xqts:check-output($query, $result, $testCase),
           if ($testCase//catalog:expected-error) then
               <test-case name="{$testCase/@name}" result="pass" dateRun="{util:system-time()}">
                   <exception>{$util:exception-message}</exception>
                   <expected-error>{string-join($testCase//catalog:expected-error/text(),";")}</expected-error>
                   <query>{$query}</query>
               </test-case>
           else
               <test-case name="{$testCase/@name}" result="fail" dateRun="{util:system-time()}">
                   <exception>{$util:exception-message}</exception>
					<!-- TODO : insert expected result here -->
                   <query>{$query}</query>
               </test-case>
       )
   return $result
};

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'])
    return (
        update value $result/@passed with xs:int($passed),
        update value $result/@failed with xs:int($failed)
    )
};

declare function xqts:run-single-test-case($case as element(catalog:test-case),
    $resultRoot as element()?) as empty() {
    let $result := xqts:run-test-case($case)
    return (
        update insert $result into $resultRoot,
        let $added := $resultRoot/test-case[@name = $case/@name]
        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 $tests := $group/catalog:test-case
(:
[
    	not(starts-with(@name, 'Constr-inscope-10')) and
    	not(starts-with(@name, 'Constr-inscope-12')) and
    	not(starts-with(@name, 'Constr-namespace-22'))
]
:)
    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 ($tests) 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: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-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:overall-result() {
    let $passed := count(//test-case[@result = "pass"])
    let $failed := count(//test-case[@result = "fail"])
    return
        <test-result failed="{$failed}" passed="{$passed}"
            percentage="{$passed div ($passed + $failed)}"/>
};

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


Added a catch around fn:codepoints-to-string() for unprintable ASCII control characters.

xquery version "1.0-ml";

declare namespace csv = "http://matthewroyal.com/csv";

declare variable $csv as xs:string := "http://matthewroyal.com/csv";

(:~
    Join a sequence of codepoints into a xs:string
:)
declare function local:joinCodes($codepoints) as xs:string {
  fn:string-join( for $c in $codepoints return try {fn:codepoints-to-string($c)} catch ($e) {""} )
};

(:~
    CORRECT CSV PARSER, author: Matthew Royal

    This CSV parser correctly parses CSV files with escaped quotation marks ("")
    and carriage returns in column data. It is probably slower than other parsers,
    because the XQuery language standard does not support several key Regex features
    and relies on parsing the file one character at a time instead.

    If your column data contains these escaped characters, to my knowledge this is
    currently the only XQuery-based CSV-to-XML converter that can parse them properly.
    If your data contains no such escape sequences, you will get much better performance
    using a different parser.

    GRAMMAR:
     file = [header CRLF] record *(CRLF record) [CRLF]
     header = field *(COMMA field)
     record = field *(COMMA field)
     field = (escaped / non-escaped)
     escaped = DQUOTE *(TEXTDATA / COMMA / CR / LF / 2DQUOTE) DQUOTE
     non-escaped = *TEXTDATA
     COMMA = %x2C
     CR = %x0D ;as per section 6.1 of RFC 2234 [2]
     DQUOTE =  %x22 ;as per section 6.1 of RFC 2234 [2]
     LF = %x0A ;as per section 6.1 of RFC 2234 [2]
     CRLF = CR LF ;as per section 6.1 of RFC 2234 [2]
     TEXTDATA =  %x20-21 / %x23-2B / %x2D-7E

    Parameters:
      $file as xs:string -- contents of CSV file to parse
      $header as xs:boolean -- indicates that the first row of the file is the header.
:)
declare function local:parseFile(
  $file as xs:string,
  $header as xs:boolean
) as element()* {

  let $mem := map:new(())
  let $fileLength := fn:string-length($file)
  let $_ := map:put($mem, "row", 1)
  let $_ := map:put($mem, "fieldNum", 1)
  let $_ := map:put($mem, "fields", 1)
  let $_ := map:put($mem, "origin", 1)
  let $_ := map:put($mem, "escaped", ())
  let $inputCodepoints := fn:string-to-codepoints($file)
  let $_ :=
    for $l at $i in $inputCodepoints
    let $letter := try { fn:codepoints-to-string($l) } catch ($e) { "" } (: Eliminate unprintable characters (ASCII control chars) :)
    return
      (: Quote mark:)
      if ($letter = '"') then
        if (fn:not(map:get($mem, "escaped")) and (fn:codepoints-to-string($inputCodepoints[$i - 1]) = "," or fn:not(fn:codepoints-to-string($inputCodepoints[$i - 1])))) then
          map:put($mem, "escaped", '"')
        else if (map:get($mem, "escaped") and fn:codepoints-to-string($inputCodepoints[$i - 1]) != '"' and fn:codepoints-to-string($inputCodepoints[$i + 1]) != '"') then
          map:put($mem, "escaped", ())
        else ()
      (: Comma; newline, end of row; End of file :)
      else if ( (($letter = ',' or $letter = '
') and not(map:get($mem, "escaped"))) or $i = $fileLength ) then
        let $fieldNum := map:get($mem, "fieldNum")
        (: Keep track of how many fields there are :)
        let $fieldMax := if ($fieldNum > map:get($mem, "fields")) then $fieldNum else map:get($mem, "fields")
        let $row := map:get($mem, "row")
        let $o := map:get($mem, "origin")
        let $fieldValue := local:joinCodes($inputCodepoints[$o to (if ($fileLength = $i) then $i else $i - 1)])
        let $_ :=
          if ($row = 1 and $header) then
            map:put($mem, "header-" || xs:string($fieldNum), $fieldValue)
          else
            map:put($mem, xs:string($row) || "-" || xs:string($fieldNum), $fieldValue)
        let $_ := map:put($mem, "fieldNum", $fieldNum + 1)
        let $_ := map:put($mem, "fields", $fieldMax)
        let $_ := map:put($mem, "origin", $i + 1)
        return
          if ($letter = '
' and not(map:get($mem, "escaped"))) then
            let $_ := map:put($mem, "row", $row + 1)
            let $_ := map:put($mem, "fieldNum", 1)
            return map:put($mem, "escaped", ())
          else
            map:put($mem, "escaped", ())
      else ()
  return
    let $fields := map:get($mem, "fields")
    let $rows   := map:get($mem, "row")
    for $r in 1 to $rows
    return
      if ($r = 1 and $header) then () else (: Skip the header row :)
      element { fn:QName( $csv, "row" ) }
      {
        if ($header) then
          attribute {xs:QName("num")} {$r - 1}
        else
          attribute {xs:QName("num")} {$r}
        ,
        for $f in 1 to $fields
        return
          if (
              map:get($mem, xs:string($r) || "-" || xs:string($f))
          ) then
            element
            {
              if ($header) then
                let $default := "field" || xs:string($f)
                let $custom := fn:replace(map:get($mem, "header-"||xs:string($f)), '["| ]', '')
                return fn:QName( $csv, if ($custom = "") then $default else $custom )
              else
                fn:QName($csv, "field" || xs:string($f))
            }
            { map:get($mem, xs:string($r) || "-" || xs:string($f)) }
          else ()
      }
};

let $fileContents := '"DRUG_CONCEPT_ID","INGREDIENT_CONCEPT_ID","AMOUNT_VALUE","AMOUNT_UNIT","CONCENTRATION_VALUE","CONCENTRATION_ENUM_UNIT","CONCENTRATION_DENOM_UNIT","VALID_START_DATE","VALID_END_DATE","INVALID_REASON"|
19035821,19069022,8.3,"mg",,,,1970-01-01,2099-12-31,|
19035837,1351461,,,100,"mg","ml",1970-01-01,2009-09-06,D|
19035864,19132972,,,150,"mg","ml",1970-01-01,2099-12-31,|
19035865,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035867,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035932,1351779,50,"mg",,,,1970-01-01,2099-12-31,|
19035937,1163944,,,40,"mg","ml",1970-01-01,2099-12-31,|
19035962,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035963,1201620,,,2,"mg","ml",1970-01-01,2099-12-31,|
19035965,1201620,,,2,"mg","ml",1970-01-01,2099-12-31,|
19036008,19035704,500,"mg",,,,1970-01-01,2099-12-31,|
19036138,1159811,,,.8,"mg","ml",1970-01-01,2099-12-31,|
19036172,933952,,,.8,"mg","ml",1970-01-01,2099-12-31,|
19036201,1135766,,,1,"mg","ml",1970-01-01,2099-12-31,|
19036208,933952,,,10,"mg","ml",1970-01-01,2099-12-31,|'

let $trickyFileContents := 'eapple,Pontius,multiline quotation,date1,date2,usually blank,another crazy multiline,user
pin,Pilatus,"Pilatus ""quoted
 string"" mountain",7/1/1984,7/31/1984,,",a word,
,,and another,,",dcassel'

return
  element csv:csv { local:parseFile($fileContents, fn:true()) }

xquery version "1.0-ml";

declare namespace csv = "http://matthewroyal.com/csv";

declare variable $csv as xs:string := "http://matthewroyal.com/csv";

(:~
    Join a sequence of codepoints into a xs:string
:)
declare function local:joinCodes($codepoints) as xs:string {
  fn:string-join( for $c in $codepoints return fn:codepoints-to-string($c) )
};

(:~
    CORRECT CSV PARSER, author: Matthew Royal

    This CSV parser correctly parses CSV files with escaped quotation marks ("")
    and carriage returns in column data. It is probably slower than other parsers,
    because the XQuery language standard does not support several key Regex features
    and relies on parsing the file one character at a time instead.

    If your column data contains these escaped characters, to my knowledge this is
    currently the only XQuery-based CSV-to-XML converter that can parse them properly.
    If your data contains no such escape sequences, you will get much better performance
    using a different parser.

    GRAMMAR:
     file = [header CRLF] record *(CRLF record) [CRLF]
     header = field *(COMMA field)
     record = field *(COMMA field)
     field = (escaped / non-escaped)
     escaped = DQUOTE *(TEXTDATA / COMMA / CR / LF / 2DQUOTE) DQUOTE
     non-escaped = *TEXTDATA
     COMMA = %x2C
     CR = %x0D ;as per section 6.1 of RFC 2234 [2]
     DQUOTE =  %x22 ;as per section 6.1 of RFC 2234 [2]
     LF = %x0A ;as per section 6.1 of RFC 2234 [2]
     CRLF = CR LF ;as per section 6.1 of RFC 2234 [2]
     TEXTDATA =  %x20-21 / %x23-2B / %x2D-7E

    Parameters:
      $file as xs:string -- contents of CSV file to parse
      $header as xs:boolean -- indicates that the first row of the file is the header.
:)
declare function local:parseFile(
  $file as xs:string,
  $header as xs:boolean
) as element()* {

  let $mem := map:new(())
  let $fileLength := fn:string-length($file)
  let $_ := map:put($mem, "row", 1)
  let $_ := map:put($mem, "fieldNum", 1)
  let $_ := map:put($mem, "fields", 1)
  let $_ := map:put($mem, "origin", 1)
  let $_ := map:put($mem, "escaped", ())
  let $inputCodepoints := fn:string-to-codepoints($file)
  let $_ :=
    for $l at $i in $inputCodepoints
    let $letter := fn:codepoints-to-string($l)
    return
      (: Quote mark:)
      if ($letter = '"') then
        if (fn:not(map:get($mem, "escaped")) and (local:joinCodes($inputCodepoints[$i - 1]) = "," or fn:not(local:joinCodes($inputCodepoints[$i - 1])))) then
          map:put($mem, "escaped", '"')
        else if (map:get($mem, "escaped") and local:joinCodes($inputCodepoints[$i - 1]) != '"' and local:joinCodes($inputCodepoints[$i + 1]) != '"') then
          map:put($mem, "escaped", ())
        else ()
      (: Comma; newline, end of row; End of file :)
      else if ( (($letter = ',' or $letter = '
') and not(map:get($mem, "escaped"))) or $i = $fileLength ) then
        let $fieldNum := map:get($mem, "fieldNum")
        (: Keep track of how many fields there are :)
        let $fieldMax := if ($fieldNum > map:get($mem, "fields")) then $fieldNum else map:get($mem, "fields")
        let $row := map:get($mem, "row")
        let $o := map:get($mem, "origin")
        let $fieldValue := local:joinCodes($inputCodepoints[$o to (if ($fileLength = $i) then $i else $i - 1)])
        let $_ :=
          if ($row = 1 and $header) then
            map:put($mem, "header-" || xs:string($fieldNum), $fieldValue)
          else
            map:put($mem, xs:string($row) || "-" || xs:string($fieldNum), $fieldValue)
        let $_ := map:put($mem, "fieldNum", $fieldNum + 1)
        let $_ := map:put($mem, "fields", $fieldMax)
        let $_ := map:put($mem, "origin", $i + 1)
        return
          if ($letter = '
' and not(map:get($mem, "escaped"))) then
            let $_ := map:put($mem, "row", $row + 1)
            let $_ := map:put($mem, "fieldNum", 1)
            return map:put($mem, "escaped", ())
          else
            map:put($mem, "escaped", ())
      else ()
  return
    let $fields := map:get($mem, "fields")
    let $rows   := map:get($mem, "row")
    for $r in 1 to $rows
    return
      if ($r = 1 and $header) then () else (: Skip the header row :)
      element { fn:QName( $csv, "row" ) }
      {
        if ($header) then
          attribute {xs:QName("num")} {$r - 1}
        else
          attribute {xs:QName("num")} {$r}
        ,
        for $f in 1 to $fields
        return
          if (
              map:get($mem, xs:string($r) || "-" || xs:string($f))
          ) then
            element
            {
              if ($header) then
                let $default := "field" || xs:string($f)
                let $custom := fn:replace(map:get($mem, "header-"||xs:string($f)), '["| ]', '')
                return fn:QName( $csv, if ($custom = "") then $default else $custom )
              else
                fn:QName($csv, "field" || xs:string($f))
            }
            { map:get($mem, xs:string($r) || "-" || xs:string($f)) }
          else ()
      }
};

let $fileContents := '"DRUG_CONCEPT_ID","INGREDIENT_CONCEPT_ID","AMOUNT_VALUE","AMOUNT_UNIT","CONCENTRATION_VALUE","CONCENTRATION_ENUM_UNIT","CONCENTRATION_DENOM_UNIT","VALID_START_DATE","VALID_END_DATE","INVALID_REASON"|
19035821,19069022,8.3,"mg",,,,1970-01-01,2099-12-31,|
19035837,1351461,,,100,"mg","ml",1970-01-01,2009-09-06,D|
19035864,19132972,,,150,"mg","ml",1970-01-01,2099-12-31,|
19035865,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035867,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035932,1351779,50,"mg",,,,1970-01-01,2099-12-31,|
19035937,1163944,,,40,"mg","ml",1970-01-01,2099-12-31,|
19035962,1163944,,,20,"mg","ml",1970-01-01,2099-12-31,|
19035963,1201620,,,2,"mg","ml",1970-01-01,2099-12-31,|
19035965,1201620,,,2,"mg","ml",1970-01-01,2099-12-31,|
19036008,19035704,500,"mg",,,,1970-01-01,2099-12-31,|
19036138,1159811,,,.8,"mg","ml",1970-01-01,2099-12-31,|
19036172,933952,,,.8,"mg","ml",1970-01-01,2099-12-31,|
19036201,1135766,,,1,"mg","ml",1970-01-01,2099-12-31,|
19036208,933952,,,10,"mg","ml",1970-01-01,2099-12-31,|'

let $trickyFileContents := 'eapple,Pontius,multiline quotation,date1,date2,usually blank,another crazy multiline,user
pin,Pilatus,"Pilatus ""quoted
 string"" mountain",7/1/1984,7/31/1984,,",a word,
,,and another,,",dcassel'

return
  element csv:csv { local:parseFile($fileContents, fn:true()) }