Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Made OASIS-suite.tcl better usable. Started comparing with the provided ref output.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 1387f10c239ad1b56a513572b22437c2c9029939
User & Date: rolf 2013-09-19 00:10:00
Context
2013-09-20
21:17
xslt.tcl better usable for memory debugging. check-in: 5bb0267890 user: rolf tags: trunk
2013-09-19
00:10
Made OASIS-suite.tcl better usable. Started comparing with the provided ref output. check-in: 1387f10c23 user: rolf tags: trunk
2013-09-08
23:32
Skeleton to run the OASIS xslt 1.0 test suite. check-in: 1e5a9b3310 user: rolf tags: trunk
Changes

Changes to tests/OASIS-suite.tcl.

12
13
14
15
16
17
18

















19
20

21
22
23
24
25



26
27


28
29
30








31
32












33
34
35
36
37
38
39
40
41
42
43

44
45
46
47
48



49
50
51










































52
53
54
55
56

57
58



59
60
61
62
63
64
65
66
67
68


69
70
71
72
73
74
75
76



77
78
79
80
81
82
83
84
85
86
87
88
89
90
91

92
93
94
95
96
97
98
99
100
101
102
103
104
105

106
107
108






















109
110
111
112
113
114
115
116


117
118
119
120
121
122
123
124
125



126
127
128

129
130



    # tcldomsh without the script library. Source the lib.
    source [file join [file dir [info script]] ../lib tdom.tcl]
}

# Import the tDOM helper procs
namespace import tDOM::*


















if {$argc != 1} {
    puts "usage: $argv0 path/to/catalog.xml"

    exit 1
}

set skiplist {
    "Show that apply-imports really means imports, not includes"



}
set skiplist [list]


set match [list]
array set skiparray [list]
foreach skip $skiplist {








    set skiparray($skip) 1
}













# This is the callback proc for xslt:message elements. This proc is
# called once every time an xslt:message element is encountered during
# processing the stylesheet. The callback proc simply sends the text
# message to stderr.
proc xsltmsgcmd {msg terminate} {
    puts stderr "xslt message: '$msg'"
}

proc readCatalog {catalogPath} {
    global catalogDir


    set fd [open $catalogPath]
    set doc [dom parse -channel $fd]
    close $fd
    set catalogDir [file dirname $catalogPath]



    return $doc
}











































proc runTest {testcase} {
    global catalogDir
    global majorpath
    global skiparray
    global match


    set filepath [$testcase selectNodes string(file-path)]



    set scenario [$testcase selectNodes scenario]
    if {[llength $scenario] != 1 || [$scenario @operation] ne "standard"} {
        puts "Non-standard scenario!"
        puts [$testcase asXML]
        return
    }
    set principaldata [$scenario selectNodes {input-file[@role="principal-data"]}]
    if {[llength $principaldata] != 1} {
        puts "Non-standard scenario - not exact one xml input file!"
        puts [$testcase asXML]


        return
    }
    set xmlfile [file join $catalogDir $majorpath $filepath [$principaldata text]]
    set principalstylesheet [$scenario selectNodes {input-file[@role="principal-stylesheet"]}]
    if {[llength $principalstylesheet] != 1} {
        puts "Non-standard scenario - not exact one xsl input file!"
        puts [$testcase asXML]
        return



    }
    set purpose [$testcase selectNodes string(purpose)]
    set matches 0
    if {[llength $match]} {
        foreach pattern $match {
            if {[string match $pattern $purpose]} {
                set matches 1
                break
            }
        }
        if {!$matches} {
            return
        }
    }
    if {[info exists skiparray($purpose)]} {

        puts "Skipping $filepath: $purpose"
        return
    }
    set xslfile [file join $catalogDir $majorpath $filepath [$principalstylesheet text]]
    set xmldoc [dom parse -baseurl [baseURL $xmlfile] \
                    -externalentitycommand extRefHandler \
                    -keepEmpties \
                    [xmlReadFile $xmlfile] ]
    dom setStoreLineColumn 1
    set xsltdoc [dom parse -baseurl [baseURL $xslfile] \
                       -externalentitycommand extRefHandler \
                       -keepEmpties \
                       [xmlReadFile $xslfile] ]
    dom setStoreLineColumn 0

    if {[catch {$xmldoc xslt -xsltmessagecmd xsltmsgcmd $xsltdoc resultDoc} \
             errMsg]} {
        puts stderr $errMsg






















    }
    $xmldoc delete
    $xsltdoc delete
    catch {$resultDoc delete}
}

proc runTests {catalogRoot} {
    global majorpath



    foreach testcatalog [$catalogRoot selectNodes test-catalog] {
        if {[$testcatalog @submitter] ne "Lotus"} {
            continue
        }
        set majorpath [$testcatalog selectNodes string(major-path)]
        foreach testcase [$testcatalog selectNodes test-case] {
            runTest $testcase
        }



    }
}


set catalogDoc [readCatalog $argv]
runTests [$catalogDoc documentElement]










>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
|
|
|
<
<
>
>
>
|
<
>
>
|
<
<
>
>
>
>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>











>





>
>
>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



|
|
>


>
>
>






|
|
|
|
>
>


|
|
<
<
|
|
>
>
>


<
<
<
|
<
<
<
<
<
|
|
<
<
>



<










>



>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








>
>









>
>
>



>
|

>
>
>
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40


41
42
43
44

45
46
47


48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161


162
163
164
165
166
167
168



169





170
171


172
173
174
175

176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    # tcldomsh without the script library. Source the lib.
    source [file join [file dir [info script]] ../lib tdom.tcl]
}

# Import the tDOM helper procs
namespace import tDOM::*

set catalogfile ""
set skip [list]
set match [list]
set matchgroup [list]
set matchfile [list]

proc putsUsage {{channel stderr}} {
    puts $channel "usage: $argv0 ?options? path/to/catalog.xml"
}

proc processArgs {argc argv} {
    global catalogfile
    global skip
    global match
    global matchgroup
    global matchfile

    if {$argc == 0 || $argc % 2 == 0} {

        putsUsage
        exit 1
    }
    


    foreach {option value} $argv {
        if {$value eq ""} {
            break
        }

        switch $option {
            "-match" {
                set match $value


            }
            "-matchgroup" {
                set matchgroup $value
            }
            "-matchfile" {
                set matchfile $value
            }
            "-skip" {
                set skip $value
            }
            default {
                puts stderr "Unknown option \"$option\""
                putsUsage
                exit 1
            }
        }
    }
    set catalogfile [lindex $argv end]
}

set compareOK 0
set compareDIFF 0

# This is the callback proc for xslt:message elements. This proc is
# called once every time an xslt:message element is encountered during
# processing the stylesheet. The callback proc simply sends the text
# message to stderr.
proc xsltmsgcmd {msg terminate} {
    puts stderr "xslt message: '$msg'"
}

proc readCatalog {catalogPath} {
    global catalogDir
    global infoset

    set fd [open $catalogPath]
    set doc [dom parse -channel $fd]
    close $fd
    set catalogDir [file dirname $catalogPath]
    set infosetxsl [file join $catalogDir .. TOOLS infoset.xsl]
    set infosetdoc [dom parse -keepEmpties [xmlReadFile $infosetxsl]]
    set infoset [$infosetdoc toXSLTcmd]
    return $doc
}

proc checkAgainstPattern {patternlist text} {
    foreach pattern $patternlist {
        if {[string match $pattern $text]} {
            return 1
        }
    }
    return 0
}

proc runFilepath {filepath} {
    global matchgroup

    if {![llength $matchgroup]} {
        return 1
    }
    return [checkAgainstPattern $matchgroup $filepath]
}

proc runXslfile {xslfile} {
    global matchfile

    if {![llength $matchfile]} {
        return 1
    }
    return [checkAgainstPattern $matchfile $xslfile]
}

proc runPurpose {purpose} {
    global match

    if {![llength $match]} {
        return 1
    }
    return [checkAgainstPattern $match $purpose]
}

proc skip {purpose} {
    global skip

    return [checkAgainstPattern $skip $purpose]
}

proc runTest {testcase} {
    global catalogDir
    global majorpath
    global infoset
    global compareOK
    global compareDIFF

    set filepath [$testcase selectNodes string(file-path)]
    if {![runFilepath $filepath]} {
        return
    }
    set scenario [$testcase selectNodes scenario]
    if {[llength $scenario] != 1 || [$scenario @operation] ne "standard"} {
        puts "Non-standard scenario!"
        puts [$testcase asXML]
        return
    }
    set xmlfile [$scenario selectNodes \
                     {string(input-file[@role="principal-data"])}]
    set xmlfile [file join $catalogDir $majorpath $filepath $xmlfile]
    set xslfile [$scenario selectNodes \
                     {string(input-file[@role="principal-stylesheet"])}]
    if {![runXslfile $xslfile]} {
        return
    }
    set xslfile [file join $catalogDir $majorpath $filepath $xslfile]
    set xmlout [$scenario selectNodes \


                    {string(output-file[@role="principal" and @compare="XML"])}]
    set xmloutfile ""
    if {$xmlout ne ""} {
        set xmloutfile [file join $catalogDir $majorpath "REF_OUT" $filepath \
                            $xmlout]
    }
    set purpose [$testcase selectNodes string(purpose)]



    if {![runPurpose $purpose]} {





        return
    }


    if {[skip $purpose]} {
        puts "Skipping $filepath: $purpose"
        return
    }

    set xmldoc [dom parse -baseurl [baseURL $xmlfile] \
                    -externalentitycommand extRefHandler \
                    -keepEmpties \
                    [xmlReadFile $xmlfile] ]
    dom setStoreLineColumn 1
    set xsltdoc [dom parse -baseurl [baseURL $xslfile] \
                       -externalentitycommand extRefHandler \
                       -keepEmpties \
                       [xmlReadFile $xslfile] ]
    dom setStoreLineColumn 0
    set resultDoc ""
    if {[catch {$xmldoc xslt -xsltmessagecmd xsltmsgcmd $xsltdoc resultDoc} \
             errMsg]} {
        puts stderr $errMsg
    }
    if {$xmloutfile ne "" && [llength [info commands $resultDoc]]} {
        if {![catch {
            set refdoc [dom parse -keepEmpties [xmlReadFile $xmloutfile]]
        } errMsg]} {
            set refinfosetdoc [$infoset $refdoc]
            set resultinfosetdoc [$infoset $resultDoc]
            if {[$refinfosetdoc asXML] ne [$resultinfosetdoc asXML]} {
                incr compareDIFF
                puts "Result and ref differ."
                puts "Ref:"
                puts [$refinfosetdoc asXML]
                puts "Result:"
                puts [$resultinfosetdoc asXML]
            } else {
                incr compareOK
            }
            $refinfosetdoc delete
            $resultinfosetdoc delete
        } else {
            puts "Unable to parse REF doc. Reason:\n$errMsg"
        }
    }
    $xmldoc delete
    $xsltdoc delete
    catch {$resultDoc delete}
}

proc runTests {catalogRoot} {
    global majorpath
    global compareOK
    global compareDIFF

    foreach testcatalog [$catalogRoot selectNodes test-catalog] {
        if {[$testcatalog @submitter] ne "Lotus"} {
            continue
        }
        set majorpath [$testcatalog selectNodes string(major-path)]
        foreach testcase [$testcatalog selectNodes test-case] {
            runTest $testcase
        }
        puts "Finished."
        puts "Compare OK: $compareOK"
        puts "Compare FAIL: $compareDIFF"
    }
}

processArgs $argc $argv
set catalogDoc [readCatalog $catalogfile]
runTests [$catalogDoc documentElement]

# See http://mini.net/tcl/3248 for an explanation.
proc exit args {}