1
2
3
4
5
6
7
8
9
10
11
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
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
| # Features covered: dom command
#
# This file contains a collection of tests for the dom command of
# tDOM.
#
# dom-1.*: createDocument, createDocumentNS
# dom-2.*: parse
# dom-3.*: isName, isNCName, isCharData, isPIName, isComment, isCDATA
# dom-4.*: parse -useForeignDTD
# dom-5.*: external entities
# dom-6.*: use in slave interpreter
# dom-7.*: setNameCheck, setTextCheck
# dom-8.*: createDocumentNode, documentNodes
# dom-9.*: setObjectCommands
# dom-10.*: createNodeCmd
# dom-11.*: featureinfo
# dom-12.*: -feedbackAfter
#
# Copyright (c) 2002, 2003, 2004 Rolf Ade.
source [file join [file dir [info script]] loadtdom.tcl]
test dom-1.1 {createDocument with root node name not a XML Name} {
list [catch {dom createDocument "root node"} msg] $msg
} "1 {invalid root element name}"
test dom-1.2 {createDocument with root node name not a XML Name} {
list [catch {dom createDocument "1root"} msg] $msg
} "1 {invalid root element name}"
test dom-1.3 {createDocument - root name us-ascii} {
dom createDocument "root" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "root"
test dom-1.4 {createDocument - root name with UTF-8 chars} {
dom createDocument "\u00c4\u00d4\u00dc" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "\u00c4\u00d4\u00dc"
test dom-1.5 {createDocument with FQ root name} {
dom createDocument "foo:bar" doc
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "foo:bar"
test dom-1.6 {createDocument with wrong # of args} {
list [catch {dom createDocument "root" "http:/foo:bar" doc} msg] $msg
} "1 {wrong \# args: should be \"createDocument docElemName ?newObjVar?\"}"
test dom-1.7 {createDocumentNS - check root name} {
set doc [dom createDocumentNS "http://foo.bar" "root"]
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "root"
test dom-1.8 {createDocumentNS - check the NS of the created root} {
dom createDocumentNS "http://foo.bar" "root" doc
set root [$doc documentElement]
set result [$root namespaceURI]
$doc delete
set result
} "http://foo.bar"
test dom-1.9 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "foo bar" doc} msg] $msg
} "1 {invalid local name}"
test dom-1.10 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a:b:c" doc} msg] $msg
} "1 {invalid local name}"
test dom-1.11 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a b:b" doc} msg] $msg
} "1 {invalid prefix name}"
test dom-1.12 {createDocumentNS with root name not a NCName} {
list [catch {dom createDocumentNS "http://foo.bar" "a:a b" doc} msg] $msg
} "1 {invalid local name}"
test dom-1.13 {createDocumentNS - check root name} {
set doc [dom createDocumentNS "http://foo.bar" foo:root]
set root [$doc documentElement]
set result [$root nodeName]
$doc delete
set result
} "foo:root"
test dom-1.14 {createDocument - rename the doc cmd} {
set doc [dom createDocument root]
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
rename $doc fooCmd
set result [[fooCmd documentElement] nodeName]
fooCmd delete
set result
} {root}
test dom-1.15 {createDocument - rename the doc cmd} {
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
set nrOfCommands [llength [info commands]]
set doc [dom createDocument root]
rename $doc fooCmd
fooCmd delete
expr {[llength [info commands]] == $nrOfCommands}
} {1}
test dom-1.16 {createDocumentNS - empty namespace, no prefix} {
dom createDocumentNS "" doc doc
set result [$doc asXML -indent none]
$doc delete
set result
} {<doc/>}
test dom-1.17 {createDocumentNS - namespace, no prefix} {
dom createDocumentNS "uri" doc doc
set result [$doc asXML -indent none]
$doc delete
set result
} {<doc xmlns="uri"/>}
test dom-1.18 {createDocumentNS - namespace, no prefix} {
dom createDocumentNS "uri" doc doc
set result [$doc selectNodes -namespaces {ns uri} count(/ns:doc)]
$doc delete
set result
} 1
test dom-1.19 {createDocumentNS - namespace, prefix} {
dom createDocumentNS "uri" n1:doc doc
set result [$doc selectNodes -namespaces {ns uri} count(/ns:doc)]
$doc delete
set result
} 1
test dom-1.20 {createDocumentNS - empty namespace, prefix} {
catch {dom createDocumentNS "" n1:doc doc} errMsg
set errMsg
} {Missing URI in Namespace declaration}
test dom-2.1 {Don't quash white space at start or end of non white space content} {
set doc [dom parse {<root>
some content
</root>}]
set root [$doc documentElement]
$root text
} {
some content
}
test dom-2.2 {parse doc with various re-declaration of a prefix} {
set doc [dom parse {<p:a xmlns:p="uri1">
<p:b xmlns:p="uri2">
<p:c xmlns:p="uri1"/>
</p:b>
</p:a>}]
set root [$doc documentElement]
set result [$root asXML]
$doc delete
set result
} {<p:a xmlns:p="uri1">
<p:b xmlns:p="uri2">
<p:c xmlns:p="uri1"/>
</p:b>
</p:a>
}
test dom-2.3 {parse doc with default NS declaration} {
set doc [dom parse {<a xmlns:p="uri">
<p:b/>
<p:b/>
</a>}]
set root [$doc documentElement]
set result [$root asXML]
$doc delete
set result
} {<a xmlns:p="uri">
<p:b/>
<p:b/>
</a>
}
test dom-2.4 {parse method: syntax check} {
set doc [dom parse -keepEmpties {<root>
text
</root>}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<root>
text
</root>}
test dom-2.5 {parse method: syntax check} {
set doc [dom parse -useForeignDTD 0 -keepEmpties {<root>
text
</root>}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<root>
text
</root>}
test dom-2.6 {parse method: syntax check} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -keepEmpties]
close $fd
set root [$doc documentElement]
set result [$root asXML -indent none]
$doc delete
set result
} -cleanup {
removeFile dom.xml
} -result {<root> </root>}
test dom-2.7 {parse method: syntax check} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
catch {unset -keepEmpties}
set fd [open $xmlFile]
set doc [dom parse -channel $fd -keepEmpties]
close $fd
$doc delete
info exists -keepEmpties
} -cleanup {
removeFile dom.xml
} -result 0
test dom-2.8 {parse method: bogus option} -body {
set result [catch {set doc [dom parse -bogusOption foo <root/>]} errMsg]
lappend result $errMsg
} -match regexp -result {1 {bad option "-bogusOption": must be .*}}
test dom-2.9 {parse method: bogus option} -setup {
set xmlFile [makeFile {<root> </root>} dom.xml]
} -body {
catch {unset -keepEmpties}
set fd [open $xmlFile]
set result [catch {set doc [dom parse -channel $fd -bogusOption]} errMsg]
close $fd
lappend result $errMsg
} -cleanup {
removeFile dom.xml
} -match regexp -result {1 {bad option "-bogusOption": must be .*}}
set dom_dtd "
<!ELEMENT root EMPTY>
<!ATTLIST root lang CDATA #FIXED \"en\">"
proc extRefResolver {base systemId publicId} {
global dom_dtd
if {$publicId == "DOMCMDTEST"} {
return [list string $base $dom_dtd]
} else {
return [::tDOM::extRefHandler $base $systemId $publicId]
}
}
test dom-2.10 {parse method: -paramentityparsing default is 'always'} {
set doc [dom parse -externalentitycommand extRefResolver {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.11 {parse method: explicit -paramentityparsing always} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing always {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.12 {parse method: -paramentityparsing never} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing never {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [catch {set result [$root @lang]} errMsg]
$doc delete
lappend result $errMsg
set result
} {1 {Attribute "lang" not found!}}
test dom-2.13 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.14 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone \
{<?xml version="1.0" standalone="yes"?>
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [catch {set result [$root @lang]} errMsg]
$doc delete
lappend result $errMsg
set result
} {1 {Attribute "lang" not found!}}
test dom-2.15 {parse method: -paramentityparsing notstandalone} {
set doc [dom parse -externalentitycommand extRefResolver \
-paramentityparsing notstandalone \
{<?xml version="1.0" standalone="no"?>
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]
set root [$doc documentElement]
set result [$root @lang]
$doc delete
set result
} {en}
test dom-2.16 {parse method: wrong value arg for -paramentityparsing} {
set result [catch {set doc [dom parse -paramentityparsing wrong {
<root/>}]} errMsg]
lappend result $errMsg
} {1 {bad value "wrong": must be always, never, or notstandalone}}
# The following is syntactically wrong. It's used, to test the
# error reporting in external DTDs
set dom_dtd "<!ATTLIST root lang #FIXED \"en\">"
test dom-2.17 {parse method: test reporting of error in external subset} {
set result [catch {set doc [dom parse \
-externalentitycommand extRefResolver {
<!DOCTYPE root PUBLIC "DOMCMDTEST" "dummysystemID">
<root/>
}]} errMsg]
lappend result $errMsg
} {1 {error "syntax error" in entity "dummysystemID" at line 1 character 20
"<!ATTLIST root lang # <--Error-- FIXED "en">", referenced at line 2 character 58}}
test dom-2.18 {parse document with nodes before and after the documentElement} {
set doc [dom parse {<!-- First comment -->
<doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc>
<!-- Last comment -->}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<!-- First comment --><doc><!-- Front comment --><inner/><!-- Back comment --></doc><!-- Last comment -->}
test dom-2.19 {parse document - rename docCmd} {
set doc [dom parse {<root>foo<child/></root>}]
if {[info commands fooCmd] == "fooCmd"} {
rename fooCmd {}
}
rename $doc fooCmd
set result [fooCmd asXML -indent none]
fooCmd delete
set result
} {<root>foo<child/></root>}
test dom-2.20 {parse - doc with internal subset parsed with -keepEmpties} {
set doc [dom parse -keepEmpties {
<!DOCTYPE root [
<!ELEMENT root EMPTY>
<!-- Comment inside the DTD -->
<?aPI Inside the DTD?>
<!ATTLIST root lang CDATA #FIXED "en">
]>
<root/>}]
$doc documentElement root
set result ""
foreach node [$root selectNodes /node()] {
switch [$node nodeType] {
TEXT_NODE {
lappend result TEXT_NODE
lappend result [string length [$node value]]
}
COMMENT_NODE {
lappend result COMMENT_NODE
lappend result [string length [$node value]]
}
PROCESSING_INSTRUCTION_NODE {
lappend result PROCESSING_INSTRUCTION_NODE
lappend result [$node target]
lappend result [$node data]
}
ELEMENT_NODE {
lappend result ELEMENT_NODE
lappend result [$node nodeName]
}
default {
lappend result [$node nodeType]
}
}
}
$doc delete
set result
} {ELEMENT_NODE root}
test dom-2.21 {parse - empty CDATA section} {
set doc [dom parse {<doc><![CDATA[]]></doc>}]
set root [$doc documentElement]
set result [$root hasChildNodes]
$doc delete
set result
} {0}
test dom-2.22 {parse - empty comment section} {
set doc [dom parse {<doc><!----></doc>}]
set root [$doc documentElement]
set result [$root hasChildNodes]
lappend result [[$root firstChild] nodeValue]
$doc delete
set result
} {1 {}}
test dom-2.23 {parse - pi without pivalue} {
set doc [dom parse {<doc><?p?></doc>}]
set pi [[$doc documentElement] firstChild]
set result [list [$pi nodeName] [$pi nodeValue] [$pi target] [$pi data]]
$doc delete
set result
} {p {} p {}}
proc 2.24 {args} {
error "2.24 external entitiy resolver script error"
}
test dom-2.24 {parse - script error in -externalentitycommand} {
set result [catch {
dom parse -externalentitycommand 2.24 {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}} errMsg]
lappend result $errMsg
} {1 {2.24 external entitiy resolver script error}}
test dom-2.25 {White space outside the document element is markup and ignored, even with -keepEmpties} {
set doc [dom parse -keepEmpties {
<!-- First comment -->
<doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc>
<!-- Last comment -->}]
set result [$doc asXML -indent none]
$doc delete
set result
} {<!-- First comment --><doc>
<!-- Front comment -->
<inner/>
<!-- Back comment -->
</doc><!-- Last comment -->}
test dom-2.26 {Not well-formed input} {
catch {dom parse {<xsl:transform
xmlns:xsl="http://www.w3.org/1999/XSL/Transform
<http://www.w3.org/1999/XSL/Transform> "/>}}
} 1
test dom-2.27 {parse -ignorexmlns} {
set result [list]
set doc [dom parse {<doc xmlns="foo.bar"><child/></doc>}]
set root [$doc documentElement]
lappend result [$root localName]
lappend result [$root namespaceURI]
set child [$root firstChild]
lappend result [$child localName]
lappend result [$child namespaceURI]
lappend result [$doc selectNodes count(/doc/child)]
$doc delete
set doc [dom parse -ignorexmlns {<doc xmlns="foo.bar"><child/></doc>}]
set root [$doc documentElement]
lappend result [$root nodeName]
lappend result [$root namespaceURI]
set child [$root firstChild]
lappend result [$child nodeName]
lappend result [$child namespaceURI]
lappend result [$doc selectNodes count(/doc/child)]
$doc delete
set result
} {doc foo.bar child foo.bar 0 doc {} child {} 1}
test dom-2.28 {parse document with undeclared xml prefix} {
catch {dom parse {<doc><foo:e/></doc>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
# This is an expat bug. If XML_StopParser is called in the
# elementstarthandler function for the document element and there
# isn't anything else in the document than this document element, then
# the XML_Parse() return code doesn't reflects this. This is an edge
# case, see the next test below.
test dom-2.29 {parse not well-formed document with undeclared xml prefix} {knownBug} {
catch {dom parse {<foo:e/>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
test dom-2.30 {parse document with undeclared xml prefix} {
catch {dom parse {<foo:e><a/></foo:e>}} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
proc dom-2.31 {base systemId publicId} {
switch $publicId {
"e1" {
# Not well-formed
set data "<foo:e/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-2.31 {parse document with undeclared xml prefix} {
catch {dom parse -externalentitycommand dom-2.31 \
{<!DOCTYPE doc [<!ENTITY e1 PUBLIC "e1" "e1.xml">]>
<doc>&e1;</doc>}
} errMsg
string range $errMsg 0 30
} {Namespace prefix is not defined}
test dom-2.32 {parse document with undeclared xml prefix and -ignorexmlns} {
set doc [dom parse -ignorexmlns {<foo:e><a/></foo:e>}]
set result [[$doc documentElement] nodeName]
$doc delete
set result
} {foo:e}
test dom-2.33 {end of options option} {
set doc [dom parse -json -- -0.123]
set result [$doc asXML -indent none]
$doc delete
set result
} -0.123
test dom-2.34 {XML prefix declaration with empty namespace} {
catch {dom parse {<foo:doc xmlns:foo=""><e1/></foo:doc>}} errMsg
set errMsg
} {Missing URI in Namespace declaration, referenced at line 1 character 22}
test dom-3.1 {isName} {
dom isName ":foo"
} {1}
test dom-3.2 {isName} {
dom isName "_foo"
} {1}
test dom-3.3 {isName} {
dom isName "foo:bar:baz"
} {1}
test dom-3.4 {isName} {
dom isName "-foo"
} {0}
test dom-3.5 {isName} {
dom isName ".foo"
} {0}
test dom-3.6 {isName} {
catch {dom isName}
} {1}
test dom-3.7 {isName} {
catch {dom isName foo bar}
} {1}
# The following character classes are out of XML 1.0 Second Edition rec,
# Appendix B (which is following the Unicode standard).
set BaseChar {
{0x0041 0x005A} {0x0061 0x007A} {0x00C0 0x00D6}
{0x00D8 0x00F6} {0x00F8 0x00FF} {0x0100 0x0131} {0x0134 0x013E}
{0x0141 0x0148} {0x014A 0x017E} {0x0180 0x01C3}
{0x01CD 0x01F0} {0x01F4 0x01F5} {0x01FA 0x0217} {0x0250 0x02A8}
{0x02BB 0x02C1} 0x0386 {0x0388 0x038A} 0x038C
{0x038E 0x03A1} {0x03A3 0x03CE} {0x03D0 0x03D6} 0x03DA 0x03DC
0x03DE 0x03E0 {0x03E2 0x03F3} {0x0401 0x040C}
{0x040E 0x044F} {0x0451 0x045C} {0x045E 0x0481} {0x0490 0x04C4}
{0x04C7 0x04C8} {0x04CB 0x04CC} {0x04D0 0x04EB}
{0x04EE 0x04F5} {0x04F8 0x04F9} {0x0531 0x0556} 0x0559
{0x0561 0x0586} {0x05D0 0x05EA} {0x05F0 0x05F2} {0x0621 0x063A}
{0x0641 0x064A} {0x0671 0x06B7} {0x06BA 0x06BE}
{0x06C0 0x06CE} {0x06D0 0x06D3} 0x06D5 {0x06E5 0x06E6}
{0x0905 0x0939} 0x093D {0x0958 0x0961} {0x0985 0x098C}
{0x098F 0x0990} {0x0993 0x09A8} {0x09AA 0x09B0} 0x09B2
{0x09B6 0x09B9} {0x09DC 0x09DD} {0x09DF 0x09E1} {0x09F0 0x09F1}
{0x0A05 0x0A0A} {0x0A0F 0x0A10} {0x0A13 0x0A28}
{0x0A2A 0x0A30} {0x0A32 0x0A33} {0x0A35 0x0A36} {0x0A38 0x0A39}
{0x0A59 0x0A5C} 0x0A5E {0x0A72 0x0A74} {0x0A85 0x0A8B}
0x0A8D {0x0A8F 0x0A91} {0x0A93 0x0AA8} {0x0AAA 0x0AB0}
{0x0AB2 0x0AB3} {0x0AB5 0x0AB9} 0x0ABD 0x0AE0 {0x0B05 0x0B0C}
{0x0B0F 0x0B10} {0x0B13 0x0B28} {0x0B2A 0x0B30}
{0x0B32 0x0B33} {0x0B36 0x0B39} 0x0B3D {0x0B5C 0x0B5D}
{0x0B5F 0x0B61} {0x0B85 0x0B8A} {0x0B8E 0x0B90} {0x0B92 0x0B95}
{0x0B99 0x0B9A} 0x0B9C {0x0B9E 0x0B9F} {0x0BA3 0x0BA4}
{0x0BA8 0x0BAA} {0x0BAE 0x0BB5} {0x0BB7 0x0BB9} {0x0C05 0x0C0C}
{0x0C0E 0x0C10} {0x0C12 0x0C28} {0x0C2A 0x0C33}
{0x0C35 0x0C39} {0x0C60 0x0C61} {0x0C85 0x0C8C} {0x0C8E 0x0C90}
{0x0C92 0x0CA8} {0x0CAA 0x0CB3} {0x0CB5 0x0CB9} 0x0CDE
{0x0CE0 0x0CE1} {0x0D05 0x0D0C} {0x0D0E 0x0D10} {0x0D12 0x0D28}
{0x0D2A 0x0D39} {0x0D60 0x0D61} {0x0E01 0x0E2E} 0x0E30
{0x0E32 0x0E33} {0x0E40 0x0E45} {0x0E81 0x0E82} 0x0E84
{0x0E87 0x0E88} 0x0E8A 0x0E8D {0x0E94 0x0E97} {0x0E99 0x0E9F}
{0x0EA1 0x0EA3} 0x0EA5 0x0EA7 {0x0EAA 0x0EAB}
{0x0EAD 0x0EAE} 0x0EB0 {0x0EB2 0x0EB3} 0x0EBD {0x0EC0 0x0EC4}
{0x0F40 0x0F47} {0x0F49 0x0F69} {0x10A0 0x10C5}
{0x10D0 0x10F6} 0x1100 {0x1102 0x1103} {0x1105 0x1107} 0x1109
{0x110B 0x110C} {0x110E 0x1112} 0x113C 0x113E 0x1140
0x114C 0x114E 0x1150 {0x1154 0x1155} 0x1159 {0x115F 0x1161}
0x1163 0x1165 0x1167 0x1169 {0x116D 0x116E}
{0x1172 0x1173} 0x1175 0x119E 0x11A8 0x11AB {0x11AE 0x11AF}
{0x11B7 0x11B8} 0x11BA {0x11BC 0x11C2} 0x11EB 0x11F0
0x11F9 {0x1E00 0x1E9B} {0x1EA0 0x1EF9} {0x1F00 0x1F15}
{0x1F18 0x1F1D} {0x1F20 0x1F45} {0x1F48 0x1F4D} {0x1F50 0x1F57}
0x1F59 0x1F5B 0x1F5D {0x1F5F 0x1F7D} {0x1F80 0x1FB4}
{0x1FB6 0x1FBC} 0x1FBE {0x1FC2 0x1FC4} {0x1FC6 0x1FCC}
{0x1FD0 0x1FD3} {0x1FD6 0x1FDB} {0x1FE0 0x1FEC} {0x1FF2 0x1FF4}
{0x1FF6 0x1FFC} 0x2126 {0x212A 0x212B} 0x212E
{0x2180 0x2182} {0x3041 0x3094} {0x30A1 0x30FA} {0x3105 0x312C}
{0xAC00 0xD7A3}
}
set Ideographic {
{0x4E00 0x9FA5} 0x3007 {0x3021 0x3029}
}
set CombiningChar {
{0x0300 0x0345} {0x0360 0x0361} {0x0483 0x0486} {0x0591 0x05A1}
{0x05A3 0x05B9} {0x05BB 0x05BD} 0x05BF {0x05C1 0x05C2}
0x05C4 {0x064B 0x0652} 0x0670 {0x06D6 0x06DC} {0x06DD 0x06DF}
{0x06E0 0x06E4} {0x06E7 0x06E8} {0x06EA 0x06ED}
{0x0901 0x0903} 0x093C {0x093E 0x094C} 0x094D {0x0951 0x0954}
{0x0962 0x0963} {0x0981 0x0983} 0x09BC 0x09BE 0x09BF
{0x09C0 0x09C4} {0x09C7 0x09C8} {0x09CB 0x09CD} 0x09D7
{0x09E2 0x09E3} 0x0A02 0x0A3C 0x0A3E 0x0A3F {0x0A40 0x0A42}
{0x0A47 0x0A48} {0x0A4B 0x0A4D} {0x0A70 0x0A71}
{0x0A81 0x0A83} 0x0ABC {0x0ABE 0x0AC5} {0x0AC7 0x0AC9}
{0x0ACB 0x0ACD} {0x0B01 0x0B03} 0x0B3C {0x0B3E 0x0B43}
{0x0B47 0x0B48} {0x0B4B 0x0B4D} {0x0B56 0x0B57} {0x0B82 0x0B83}
{0x0BBE 0x0BC2} {0x0BC6 0x0BC8} {0x0BCA 0x0BCD} 0x0BD7
{0x0C01 0x0C03} {0x0C3E 0x0C44} {0x0C46 0x0C48} {0x0C4A 0x0C4D}
{0x0C55 0x0C56} {0x0C82 0x0C83} {0x0CBE 0x0CC4}
{0x0CC6 0x0CC8} {0x0CCA 0x0CCD} {0x0CD5 0x0CD6} {0x0D02 0x0D03}
{0x0D3E 0x0D43} {0x0D46 0x0D48} {0x0D4A 0x0D4D} 0x0D57
0x0E31 {0x0E34 0x0E3A} {0x0E47 0x0E4E} 0x0EB1 {0x0EB4 0x0EB9}
{0x0EBB 0x0EBC} {0x0EC8 0x0ECD} {0x0F18 0x0F19} 0x0F35
0x0F37 0x0F39 0x0F3E 0x0F3F {0x0F71 0x0F84} {0x0F86 0x0F8B}
{0x0F90 0x0F95} 0x0F97 {0x0F99 0x0FAD} {0x0FB1 0x0FB7}
0x0FB9 {0x20D0 0x20DC} 0x20E1 {0x302A 0x302F} 0x3099 0x309A
}
set Digit {
{0x0030 0x0039} {0x0660 0x0669} {0x06F0 0x06F9} {0x0966 0x096F}
{0x09E6 0x09EF} {0x0A66 0x0A6F} {0x0AE6 0x0AEF}
{0x0B66 0x0B6F} {0x0BE7 0x0BEF} {0x0C66 0x0C6F} {0x0CE6 0x0CEF}
{0x0D66 0x0D6F} {0x0E50 0x0E59} {0x0ED0 0x0ED9}
{0x0F20 0x0F29}
}
set Extender {
0x00B7 0x02D0 0x02D1 0x0387 0x0640 0x0E46 0x0EC6 0x3005
{0x3031 0x3035} {0x309D 0x309E} {0x30FC 0x30FE}
}
proc sortCmd {a b} {
if {[lindex $a 0] > [lindex $b 0]} {
return 1
} else {
return -1
}
}
# if {$tcl_version < 8.4} {
# set nameStartChars [lsort -command sortCmd \
# [concat $BaseChar $Ideographic 0x005F 0x003A]]
# } else {
# set nameStartChars [lsort -integer -index 0 \
# [concat $BaseChar $Ideographic 0x005F 0x003A]]
# }
set nameStartChars [lsort -command sortCmd \
[concat $BaseChar $Ideographic 0x005F 0x003A]]
# Append stop char needed by the test code to work properly.
lappend nameStartChars 0x10000
test dom-3.8 {isName} {longRunning && need_i18n} {
set ind 0
set nr 0
while {$nr < 65536} {
set range [lindex $nameStartChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isName [subst \\u[format "%04x" $nr]]] != 0} {
error "wrong 'isName' result for name start char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isName [subst \\u[format "%04x" $nr]]] != 1} {
error "wrong 'isName' result for name start char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
set nameChars [lsort -command sortCmd \
[concat $BaseChar $Ideographic $Digit 0x002E 0x002D 0x005F 0x003A \
$CombiningChar $Extender]]
# Append stop char needed by the test code to work properly.
lappend nameChars 0x10000
test dom-3.9 {isName} {longRunning && need_i18n} {
set ind 0
set nr 0
while {$nr < 65536} {
set range [lindex $nameChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isName a[subst \\u[format "%04x" $nr]]] != 0} {
error "wrong 'isName' result for name char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isName a[subst \\u[format "%04x" $nr]]] != 1} {
error "wrong 'isName' result for name char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
test dom-3.10 {isNCName} {
dom isNCName ":foo"
} {0}
test dom-3.11 {isNCName} {
dom isNCName "_foo"
} {1}
test dom-3.12 {isNCName} {
dom isNCName "foo:bar:baz"
} {0}
test dom-3.13 {isNCName} {
dom isNCName "-foo"
} {0}
test dom-3.14 {isNCName} {
dom isNCName ".foo"
} {0}
test dom-3.15 {isNCName} {
catch {dom isNCName}
} {1}
test dom-3.16 {isNCName} {
catch {dom isNCName foo bar}
} {1}
test dom-3.17 {isQName} {
dom isQName ":foo"
} {0}
test dom-3.18 {isQName} {
dom isQName "_foo"
} {1}
test dom-3.19 {isQName} {
dom isQName "foo:bar:baz"
} {0}
test dom-3.20 {isQName} {
dom isQName "-foo"
} {0}
test dom-3.21 {isQName} {
dom isQName ".foo"
} {0}
test dom-3.22 {isQName} {
dom isQName "foo:bar"
} {1}
test dom-3.23 {isQName} {
catch {dom isQName}
} {1}
test dom-3.24 {isQName} {
catch {dom isQName foo bar}
} {1}
test dom-3.25 {isQName} {
dom isQName "foo bar"
} {0}
test dom-3.26 {isQName} {
dom isQName "woozbiz:"
} {0}
test dom-3.26.1 {isQName} {
dom isQName foo:1
} {0}
test dom-3.26.2 {isQName} {
dom isQName 1:foo
} {0}
set XMLChars {
0x9 0xA 0xD {0x20 0xD7FF} {0xE000 0xFFFD} {0x10000 0x10FFFF}
}
test dom-3.27 {isCharData} {longRunning && need_i18n} {
set ind 0
set nr 1
while {$nr < 65536} {
set range [lindex $XMLChars $ind]
incr ind
if {[llength $range] == 2} {
foreach {min max} $range break
} else {
set min $range
set max $range
}
while {$nr < $min} {
if {[dom isCharData "a[subst \\u[format "%04x" $nr]]b"] != 0} {
error "wrong 'isCharData' result for char #x[format "%04x" $nr] - should be illegal"
}
incr nr
}
if {$nr == 0x10000} {break}
while {$nr <= $max} {
if {[dom isCharData "a[subst \\u[format "%04x" $nr]]b"] != 1} {
error "wrong 'isCharData' result for char #x[format "%04x" $nr] - should be legal"
}
incr nr
}
}
set nr
} {65536}
test dom-3.28 {isPIName} {
dom isPIName "target"
} {1}
test dom-3.29 {isPIName} {
dom isPIName "foo:target"
} {1}
test dom-3.30 {isPIName} {
dom isPIName "Xml"
} {0}
test dom-3.31 {isComment} {
dom isComment "some comment"
} {1}
test dom-3.32 {isComment} {
dom isComment "some invalid -- comment"
} {0}
test dom-3.33 {isComment} {
dom isComment "some invalid comment-"
} {0}
test dom-3.34 {isCDATA} {
dom isCDATA "<valid>some ]] CDATA </valid>"
} {1}
test dom-3.35 {isCDATA} {
dom isCDATA "<invalid>some ]]> CDATA </invalid>"
} {0}
test dom-3.36 {isCDATA} {
dom isCDATA "invalid: ]]>"
} {0}
test dom-3.37 {isCDATA} {
dom isCDATA "valid: ]]> "
} {0}
test dom-3.38 {isCDATA} {need_i18n} {
dom isCDATA "\ud7fa\ud7fb\ud7fc\ud7fd\ud7fe\ud7ff]]>"
} {0}
test dom-3.39 {isPIValue} {
dom isPIValue "some processing instruction data"
} {1}
test dom-3.40 {isPIValue} {
dom isPIValue "some invalid ?> processing instruction data"
} {0}
test dom-3.41 {isPIValue} {
dom isPIValue "some invalid processing instruction data?>"
} {0}
test dom-4.1 {-useForeignDTD 0} {
set doc [dom parse -useForeignDTD 0 {<root/>}]
$doc delete
} {}
test dom-4.2 {-useForeignDTD 1 with document with internal subset} {need_uri} {
set baseURI file://[file join [pwd] [file dir [info script]] dom.test]
set ::tDOM::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tDOM::extRefHandler {
<!DOCTYPE root [
<!ATTLIST root fixed CDATA #FIXED "toThat">
]>
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
test dom-4.3 {-useForeignDTD 1 with document with internal subset} {need_uri} {
set baseURI file://[file join [pwd] [file dir [info script]] dom.test]
set ::tDOM::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tDOM::extRefHandler {
<!DOCTYPE root [
<!ATTLIST root fixed2 CDATA #FIXED "toThat">
]>
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
lappend result [$root @fixed2]
$doc delete
set result
} {toThis toThat}
test dom-4.4 {-useForeignDTD 1 with document without document declaration} {need_uri} {
set baseURI file://[file join [pwd] [file dir [info script]] dom.test]
set ::tDOM::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tDOM::extRefHandler <root/>]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThis}
test dom-4.5 {-useForeignDTD 1 does not overwrite a given external subset} {need_uri} {
set baseURI file://[file join [pwd] [file dir [info script]] dom.test]
set ::tDOM::useForeignDTD "data/domCmd1.dtd"
set doc [dom parse \
-useForeignDTD 1 \
-baseurl $baseURI \
-externalentitycommand ::tDOM::extRefHandler {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
test dom-4.6 {-useForeignDTD with nonboolean arg} {need_uri} {
set result [catch {set doc [dom parse -useForeignDTD foo <root/>]} errMsg]
lappend result $errMsg
} {1 {expected boolean value but got "foo"}}
test dom-5.1 {document with external subset} {need_uri} {
set baseURI file://[file join [pwd] [file dir [info script]] dom.test]
set doc [dom parse \
-baseurl $baseURI \
-externalentitycommand ::tDOM::extRefHandler {
<!DOCTYPE root SYSTEM "data/domCmd2.dtd">
<root/>}]
set root [$doc documentElement]
set result [$root @fixed]
$doc delete
set result
} {toThat}
proc dom-5.2 {myparm base systemId publicId} {
set ::dom-5_2 $myparm
return [list string dummy ""]
}
test dom-5.2 {-externalentitycommand} {
set ::dom-5_2 ""
set doc [dom parse \
-baseurl "dummy" \
-externalentitycommand [list dom-5.2 thisDoc] {
<!DOCTYPE root SYSTEM "">
<root/>}]
$doc delete
set ::dom-5_2
} {thisDoc}
proc dom-5.3 {base systemId publicId} {
switch $publicId {
"e1" {
# Not well-formed
set data "<e,1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.3 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.3 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e1.xml" at line 1 character 2
"<e, <--Error-- 1/>", referenced at line 4 character 21}]
proc dom-5.4 {base systemId publicId} {
switch $publicId {
"e1" {
set data "<e1>&e2;</e1>"
}
"e2" {
set data "<e,2/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.4 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.4 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e2.xml" at line 1 character 2
"<e, <--Error-- 2/>", referenced in entity "e1.xml" at line 1 character 4, referenced at line 5 character 21}]
proc dom-5.5 {base systemId publicId} {
switch $publicId {
"e1" {
set data "<e1>&e2;</e1>"
}
"e2" {
set data "<e2>&e3;</e2>"
}
"e3" {
# Not well-formed
set data "<e,3/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-5.5 {-externalentitycommand - nested external entities} -body {
set result [catch {
dom parse -externalentitycommand dom-5.5 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
<!ENTITY e3 PUBLIC "e3" "e3.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -result [list 1 {error "not well-formed (invalid token)" in entity "e3.xml" at line 1 character 2
"<e, <--Error-- 3/>", referenced in entity "e2.xml" at line 1 character 4, referenced in entity "e1.xml" at line 1 character 4, referenced at line 6 character 21}]
proc dom-5.6 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.6 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e,1/>" e1.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.6 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e1.xml" at line 1 character 2, referenced at line 4 character 21}]
proc dom-5.7 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
"e2" {
set data [open $::e2]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.7 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e1>&e2;</e1>" e1.xml]
set e2 [makeFile "<e,2/>" e2.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.7 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
removeFile e2.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e2.xml" at line 1 character 2, referenced in entity "e1.xml" at line 1 character 4, referenced at line 5 character 21}]
proc dom-5.8 {base systemId publicId} {
switch $publicId {
"e1" {
set data [open $::e1]
}
"e2" {
set data [open $::e2]
}
"e3" {
set data [open $::e3]
}
default {
error "unknown public ID"
}
}
lappend ::openChannels $data
return [list "channel" $base $data]
}
test dom-5.8 {-externalentitycommand - nested external entities} -setup {
set e1 [makeFile "<e1>&e2;</e1>" e1.xml]
set e2 [makeFile "<e2>&e3;</e2>" e2.xml]
set e3 [makeFile "<e,3/>" e3.xml]
set openChannels [list]
} -body {
set result [catch {
dom parse -externalentitycommand dom-5.8 \
{<!DOCTYPE doc [
<!ENTITY e1 PUBLIC "e1" "e1.xml">
<!ENTITY e2 PUBLIC "e2" "e2.xml">
<!ENTITY e3 PUBLIC "e3" "e3.xml">
]>
<doc>&e1;</doc>}
} msg]
list $result $msg
} -cleanup {
foreach channel $openChannels {close $channel}
removeFile e1.xml
removeFile e2.xml
removeFile e3.xml
} -result [list 1 {error "not well-formed (invalid token)" in entity "e3.xml" at line 1 character 2, referenced in entity "e2.xml" at line 1 character 4, referenced in entity "e1.xml" at line 1 character 4, referenced at line 6 character 21}]
test dom-5.9 {Wrong option after -externalentitycommand} -body {
set result [catch {dom parse -externalentitycommand ::tDOM::extRefHandler \
-useForeignDTD foo}]
} -result 1
test dom-6.1 {use in slave interpreter} {
set slave [interp create]
load {} tdom $slave
interp eval $slave {
dom parse <root>foo</root> doc
$doc documentElement root
}
interp delete $slave
} {}
test dom-6.2 {use in slave interpreter} {
set slave [interp create]
load {} tdom $slave
interp eval $slave {
set doc [dom parse <root>foo</root>]
set root [$doc documentElement]
}
interp delete $slave
} {}
test dom-7.1 {setNameCheck} {
set result [dom setNameCheck]
lappend result [dom setNameCheck 0]
lappend result [dom setNameCheck]
# set back to default
lappend result [dom setNameCheck 1]
set result
} {1 0 0 1}
set doc [dom createDocument root]
# ensure, we've the default
dom setNameCheck 1
test dom-7.2 {setNameCheck} {
set result [catch {$doc createElement "invalid name"} errMsg]
lappend result $errMsg
} {1 {Invalid tag name 'invalid name'}}
test dom-7.3 {setNameCheck} {
catch {$doc createElement "valid:name"}
} {0}
test dom-7.4 {setNameCheck} {
catch {$doc createElement "valid::name"}
} {0}
test dom-7.5 {setNameCheck} {
dom setNameCheck 0
set result [catch {$doc createElement "invalid name"} errMsg]
# set back to default
dom setNameCheck 1
set result
} {0}
test dom-7.6 {setNameCheck} {
set result [catch {$doc createElementNS "dummyns" "invalid name"} errMsg]
lappend result $errMsg
} {1 {Invalid full qualified tag name 'invalid name'}}
test dom-7.7 {setNameCheck} {
catch {$doc createElementNS "dummyns" "valid:name"}
} {0}
test dom-7.8 {setNameCheck} {
set result [catch {$doc createElementNS "dummyns" "invalid::name"} errMsg]
lappend result $errMsg
} {1 {Invalid full qualified tag name 'invalid::name'}}
test dom-7.9 {setNameCheck} {
dom setNameCheck 0
set result [catch {$doc createElementNS "dummyns" "invalid name"} errMsg]
# set back to default
dom setNameCheck 1
set result
} {0}
test dom-7.10 {setTextCheck} {
set result [catch {$doc createComment "valid comment"}]
lappend result [catch {$doc createComment "invalid -- comment"}]
dom setTextCheck 0
lappend result [catch {$doc createComment "invalid -- comment"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.11 {setTextCheck} {
set result [catch {$doc createCDATASection "<valid/>"}]
lappend result [catch {$doc createCDATASection "<invalid>]]></invalid"}]
dom setTextCheck 0
lappend result [catch {$doc createCDATASection "<invalid>]]></invalid"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.12 {setTextCheck} {
set result [catch {$doc createTextNode "data"}]
lappend result [catch {$doc createTextNode "not XML \u0002 Char data"}]
dom setTextCheck 0
lappend result [catch {$doc createTextNode "not XML \u0002 Char data"}]
dom setTextCheck 1
set result
} {0 1 0}
test dom-7.13 {setNameCheck} {
set result [catch {$doc createProcessingInstruction "target" "data"}]
lappend result [catch {$doc createProcessingInstruction "tar get" "data"}]
lappend result [catch {$doc createProcessingInstruction "xMl" "data"}]
dom setNameCheck 0
lappend result [catch {$doc createProcessingInstruction "tar get" "data"}]
lappend result [catch {$doc createProcessingInstruction "xMl" "data"}]
dom setNameCheck 1
set result
} {0 1 1 0 0}
set root [$doc documentElement]
test dom-7.14 {setNameCheck} {
set result [catch {$root appendFromList {"a b" {} {}}} errMsg]
lappend result $errMsg
dom setNameCheck 0
lappend result [catch {$root appendFromList {"a b" {} {}}}]
dom setNameCheck 1
set result
} {1 {Invalid tag name 'a b'} 0}
test dom-7.15 {setNameCheck} {
set result [catch {$root appendFromList {a {att1 "att1 value" "att 2" "att2 value"} {}}} errMsg]
lappend result $errMsg
dom setNameCheck 0
lappend result [catch {$root appendFromList {a {att1 "att1 value" "att 2" "att2 value"} {}}}]
dom setNameCheck 1
set result
} {1 {Invalid attribute name 'att 2'} 0}
test dom-7.16 {setTextCheck} {
set result [catch {$root appendFromList {a {att1 "att1 value" "att2" "att2 value \u0002"} {}}} errMsg]
lappend result $errMsg
dom setTextCheck 0
lappend result [catch {$root appendFromList {a {att1 "att1 value" "att2" "att2 value \u0002"} {}}}]
dom setTextCheck 1
set result
} [list 1 "Invalid attribute value 'att2 value \u0002'" 0]
test dom-7.17 {setTextCheck} {
set result [catch {$root appendFromList {\#text "foo \u0002"}} errMsg]
lappend result $errMsg
dom setTextCheck 0
lappend result [catch {$root appendFromList {\#text "foo \u0002"}}]
dom setTextCheck 1
set result
} [list 1 "Invalid text value 'foo \u0002'" 0]
$doc delete
test dom-7.18 {setTextCheck and appendFromScript} {
set doc [dom createDocumentNode]
dom setTextCheck 0
namespace eval nodeCmds {
dom createNodeCmd elementNode doc
dom createNodeCmd textNode t
}
$doc appendFromScript {
nodeCmds::doc {
nodeCmds::t "foo\u0003bar"
}
}
dom setTextCheck 1
set result [$doc asXML -indent none]
$doc delete
set result
} "<doc>foo\u0003bar</doc>"
test dom-7.19 {setTextCheck and appendFromScript - setTextCheck state at create time is crucial} {
set doc [dom createDocumentNode]
namespace eval nodeCmds {
dom createNodeCmd elementNode doc
dom createNodeCmd textNode t
}
dom setTextCheck 0
set result [catch {$doc appendFromScript {
nodeCmds::doc {
nodeCmds::t "foo\u0003bar"
}
}} errMsg]
dom setTextCheck 1
$doc delete
lappend result $errMsg
} [list 1 "Invalid text value 'foo\u0003bar'"]
test dom-8.1 {createDocumentNode} {
set result [catch {dom createDocumentNode foo bar}]
} {1}
test dom-8.2 {createDocumentNode} {
set docNode [dom createDocumentNode]
set result [$docNode asXML -indent none]
$docNode delete
set result
} {}
test dom-8.3 {createDocumentNode} {
dom createDocumentNode docNode
set result [$docNode asXML -indent none]
$docNode delete
set result
} {}
test dom-8.4 {createDocumentNode} {
set docNode [dom createDocumentNode]
set result [$docNode nodeType]
lappend result [$docNode documentElement]
$docNode delete
set result
} {DOCUMENT_NODE {}}
test dom-8.5 {createDocumentNode} {
set docNode [dom createDocumentNode]
set newNode [$docNode createComment "Comment before the document node"]
$docNode appendChild $newNode
set result [[$docNode documentElement] nodeType]
set newNode [$docNode createElement firstChild]
$docNode appendChild $newNode
lappend result [[$docNode documentElement] nodeName]
set newNode [$docNode createElement secondChild]
$docNode appendChild $newNode
lappend result [[$docNode documentElement] nodeName]
$docNode delete
set result
} {COMMENT_NODE firstChild firstChild}
test dom-8.6 {createDocumentNode} {
set docNode [dom createDocumentNode]
set doc [dom parse {<root><child1/><child2/>some text<child3/></root>}]
set root [$doc documentElement]
set listRep [$root asList]
$doc delete
$docNode appendFromList $listRep
set result [$docNode asXML -indent none]
$docNode delete
set result
} {<root><child1/><child2/>some text<child3/></root>}
test dom-8.7 {createDocumentNode} {
dom createDocumentNode docNode
dom createDocumentNode docNode
$docNode delete
set result ""
} ""
test dom-8.8 {createDocumentNode} {
dom createDocumentNode -jsonType ARRAY docNode
set result [$docNode jsonType]
$docNode delete
set result
} ARRAY
test dom-8.9 {createDocumentNode} {
set docNode [dom createDocumentNode -jsonType NUMBER]
set result [$docNode jsonType]
$docNode delete
set result
} NUMBER
test dom-8.10 {createDocumentNode} {
catch {dom createDocumentNode -foo NULL docNode} errMsg
set errMsg
} {bad option "-foo": must be -jsonType}
test dom-8.10 {createDocumentNode} {
catch {dom createDocumentNode -foo NULL docNode} errMsg
set errMsg
} {bad option "-foo": must be -jsonType}
test dom-8.11 {createDocumentNode} {
catch {dom createDocumentNode -jsonType FOO docNode} errMsg
set errMsg
} {bad jsonType "FOO": must be NONE, ARRAY, OBJECT, NULL, TRUE, FALSE, STRING, or NUMBER}
test dom-9.1 {setObjectCommands} {
dom setObjectCommands
} {automatic}
test dom-9.2 {setObjectCommands} {
dom setObjectCommands automatic
} {automatic}
test dom-9.3 {setObjectCommands} {
set result [catch {dom setObjectCommands foobar} errMsg]
lappend result $errMsg
} {1 {bad mode value "foobar": must be automatic, command, or token}}
test dom-9.4 {setObjectCommands} {
set nrOfCmds [llength [info commands]]
dom setObjectCommands automatic
set docNode [dom createDocumentNode]
set result [expr {$nrOfCmds + 1 == [llength [info commands]]}]
$docNode delete
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
dom setObjectCommands token
set docNode [dom createDocumentNode]
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
lappend result [domDoc $docNode hasChildNodes]
domDoc $docNode delete
lappend result [expr {$nrOfCmds == [llength [info commands]]}]
# switch back to default
dom setObjectCommands automatic
set result
} {1 1 1 0 1}
test dom-9.5 {setObjectCommands} {
dom setObjectCommands token
set nrOfCmds [llength [info commands]]
set doc [dom parse <root><child1/><child2/></root>]
set root [domDoc $doc documentElement]
set result [expr {$nrOfCmds == [llength [info commands]]}]
dom setObjectCommands command
set docCmd [domNode $root ownerDocument]
lappend result [expr {$nrOfCmds + 1 == [llength [info commands]]}]
$docCmd delete
dom setObjectCommands automatic
set result
} {1 1}
test dom-9.6 {node token with result var argument} {
dom setObjectCommands token
set doc [dom parse <root><child1/><child2/></root>]
domDoc $doc documentElement var
domNode $var firstChild var
domNode $var nextSibling var
domDoc $doc delete
dom setObjectCommands automatic
} {automatic}
catch {namespace delete nodeCmds}
namespace eval nodeCmds {
dom createNodeCmd elementNode e1
dom createNodeCmd elementNode e2
dom createNodeCmd commentNode c
dom createNodeCmd textNode t
dom createNodeCmd cdataNode cdata
dom createNodeCmd piNode pi
dom createNodeCmd parserNode parser
dom createNodeCmd -tagName foo elementNode bar
}
test dom-10.1 {createNodeCmd} {
llength [info commands nodeCmds::*]
} {8}
namespace eval nodeCmds {
rename e1 {}
rename e2 {}
rename c {}
rename t {}
rename cdata {}
rename pi {}
rename parser {}
rename bar {}
}
test dom-10.2 {createNodeCmd} {
llength [info commands nodeCmds::*]
} {0}
namespace eval nodeCmds {
dom createNodeCmd elementNode e1
dom createNodeCmd textNode t
}
test dom-10.3 {node creating command called outside domNode context} {
set result [catch {nodeCmds::t "some text"} errMsg]
lappend result $errMsg
} {1 {called outside domNode context}}
test dom-10.4 {node creating command called outside domNode context} {
dom createDocument docRoot doc
$doc documentElement root
$root appendFromScript {
nodeCmds::t "Some text"
}
set result [list [$doc asXML -indent none]]
$doc delete
lappend result [catch {nodeCmds::t "Some text"} errMsg]
lappend result $errMsg
} {{<docRoot>Some text</docRoot>} 1 {called outside domNode context}}
test dom-10.5 {node creating command called outside domNode context} {
dom createDocument docRoot doc
$doc documentElement root
$root appendFromScript {
nodeCmds::e1 {
nodeCmds::t "Some text"
}
}
set result [list [$doc asXML -indent none]]
$doc delete
lappend result [catch {
nodeCmds::e1 {
nodeCmds::t "Some text"
}} errMsg]
lappend result $errMsg
} {{<docRoot><e1>Some text</e1></docRoot>} 1 {called outside domNode context}}
namespace eval nodeCmds {
dom createNodeCmd -tagName foo elementNode bar
}
test dom-10.6 {createNodeCmd - option -tagName} {
set doc [dom createDocumentNode]
$doc appendFromScript {
nodeCmds::bar {}
}
set result [$doc asXML -indent none]
$doc delete
set result
} {<foo/>}
namespace delete nodeCmds
test dom-11.1 {featureinfo - expatversion} -body {
dom featureinfo expatversion
} -match regexp -result {expat_.*}
test dom-11.2 {featureinfo - invalid arg} -body {
catch {dom featureinfo foo} errMsg
} -result 1
test dom-11.3 {featureinfo - expatmajorversion} -body {
dom featureinfo expatmajorversion
} -match regexp -result {(1|2)}
test dom-11.4 {featureinfo - dtd} -body {
dom featureinfo dtd
} -match regexp -result {(0|1)}
test dom-11.5 {featureinfo - jsonmaxnesting} {
dom featureinfo jsonmaxnesting
} 2000
proc ::dom::domParseFeedback {} {
return -code break
}
test dom-12.1 {-feedbackAfter -- cmd returns TCL_BREAK} -body {
dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}
} -result ""
proc ::dom::domParseFeedback {} {
error "Error in feedback cmd."
}
test dom-12.2 {-feedbackAfter -- cmd returns TCL_ERROR} -body {
set result [catch {
dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}
} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
proc ::dom::domParseFeedback {} {
# Update progess dialog, check for cancel etc.
return
}
test dom-12.3 {-feedbackAfter} -body {
set doc [dom parse -feedbackAfter 1 {<doc><e1/><e1/><e1/></doc>}]
$doc selectNodes count(//*)
} -result 4
test dom-12.4 {-feedbackAfter and -channel} -setup {
set xmlFile [makeFile {<doc><e1/><e1/><e1/></doc>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -feedbackAfter 1]
close $fd
$doc selectNodes count(//*)
} -cleanup {
removeFile dom.xml
} -result 4
proc extRefResolver-12.5 {base systemId publicId} {
switch $publicId {
"a" {
set data "<e1/>"
}
"b" {
set data "<e1/><e1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
test dom-12.5 {-feedbackAfter and external entities} -body {
set doc [dom parse -externalentitycommand extRefResolver-12.5 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}]
$doc selectNodes count(//*)
} -result 4
set cancel 0
proc extRefResolver-12.6 {base systemId publicId} {
global cancel
switch $publicId {
"a" {
set cancel 1
set data "<e1/><e1/>"
}
"b" {
set data "<e1/>"
}
default {
error "unknown public ID"
}
}
return [list "string" $base $data]
}
proc ::dom::domParseFeedback {} {
global cancel
if {$cancel} {
return -code break
}
}
test dom-12.6 {-feedbackAfter and external entities, with cancel} -body {
dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}
} -result ""
proc ::dom::domParseFeedback {} {
global cancel
if {$cancel} {
error "Error in feedback cmd."
}
}
test dom-12.7 {-feedbackAfter and external entities, with error} -body {
set result [catch {dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
test dom-12.8 {-feedbackAfter without -feedbackcmd} -setup {
catch {rename ::dom::domParseFeedback ""}
} -body {
set result [catch {dom parse -feedbackAfter 100 <doc/>} msg]
list $result $msg
} -result {1 {If -feedbackAfter is used, -feedbackcmd must also be used.}}
proc feedbackcmd-12.9 {} {
return -code break
}
test dom-12.9 {-feedbackAfter with -feedbackcmd -- cmd returns TCL_BREAK} -body {
dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.9 \
{<doc><e1/><e1/><e1/></doc>}
} -result ""
proc feedbackcmd-12.10 {} {
error "Error in feedback cmd."
}
test dom-12.10 {-feedbackAfter with -feedbackcmd -- cmd returns TCL_ERROR} -body {
set result [catch {
dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.10 \
{<doc><e1/><e1/><e1/></doc>}
} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
proc feedbackcmd-12.11 {} {
# Update progess dialog, check for cancel etc.
return
}
test dom-12.11 {-feedbackAfter with -feedbackcmd} -body {
set doc [dom parse -feedbackAfter 1 -feedbackcmd feedbackcmd-12.11 \
{<doc><e1/><e1/><e1/></doc>}]
$doc selectNodes count(//*)
} -result 4
test dom-12.12 {-feedbackAfter with -feedbackcmd and -channel} -setup {
set xmlFile [makeFile {<doc><e1/><e1/><e1/></doc>} dom.xml]
} -body {
set fd [open $xmlFile]
set doc [dom parse -channel $fd -feedbackAfter 1 \
-feedbackcmd feedbackcmd-12.11]
close $fd
$doc selectNodes count(//*)
} -cleanup {
removeFile dom.xml
} -result 4
test dom-12.13 {-feedbackAfter with -feedbackcmd and external entities} -body {
set doc [dom parse -externalentitycommand extRefResolver-12.5 \
-feedbackcmd feedbackcmd-12.11 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}]
$doc selectNodes count(//*)
} -result 4
set cancel 0
proc feedbackcmd-12.14 {} {
global cancel
if {$cancel} {
return -code break
}
}
test dom-12.14 {-feedbackAfter with -feedbackcmd and external entities, with cancel} -body {
dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackcmd feedbackcmd-12.14 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}
} -result ""
set cancel 0
proc feedbackcmd-12.15 {} {
global cancel
if {$cancel} {
error "Error in feedback cmd."
}
}
test dom-12.15 {-feedbackAfter with -feedbackcmd and external entities, with error} -body {
set result [catch {dom parse -externalentitycommand extRefResolver-12.6 \
-feedbackcmd feedbackcmd-12.15 \
-feedbackAfter 1 {
<!DOCTYPE doc [
<!ENTITY a PUBLIC "a" "a.xml">
<!ENTITY b PUBLIC "b" "b.xml">
]>
<doc>&a;&b;</doc>}} msg]
list $result $msg
} -result [list 1 "Error in feedback cmd."]
# cleanup
::tcltest::cleanupTests
return
|