Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Changes In Branch parser-defaultcurrent Excluding Merge-Ins
This is equivalent to a diff from ac03b8c44e to d501542ab8
2015-04-01
| ||
22:12 | Added new expat parser cmd method currentmarkup. check-in: 2b183ffd3f user: rolf tags: trunk | |
21:46 | Added lokal clean-up to every test (as it should be) and removed general clean-up, which was interfered by other test helper procs. Closed-Leaf check-in: d501542ab8 user: rolf tags: parser-defaultcurrent | |
21:35 | Corrected typo. check-in: 6f3daefad3 user: rolf tags: parser-defaultcurrent | |
18:12 | Plugged memory leaks in case of defective XPath expressions. check-in: 6cae756100 user: rolf tags: trunk | |
00:44 | Merged from trunk. check-in: 9a616f0d21 user: rolf tags: parser-defaultcurrent | |
2015-03-26
| ||
11:29 | Enforce value range for -indentAttrs value. check-in: ac03b8c44e user: rolf tags: trunk | |
01:23 | Added option -indentAttrs to the domDoc/domNode method asXML. check-in: 3245a04ed5 user: rolf tags: trunk | |
Changes to doc/expat.xml.
583 583 <desc><p>Return the current configuration value option for the 584 584 parser.</p> 585 585 <p>If the -handlerset option is used, the configuration for the 586 586 named handler set is returned.</p> 587 587 </desc> 588 588 </commanddef> 589 589 590 + <commanddef> 591 + <command><cmd>parser</cmd> <method>currentmarkup</method></command> 592 + 593 + <desc><p>Returns the current markup as found in the XML, if 594 + called from within one of its markup event handler script 595 + (-elementstartcommand, -elementendcommand, -commentcommand 596 + and -processinginstructioncommand). Otherwise it return the 597 + empty string.</p></desc> 598 + </commanddef> 599 + 590 600 <commanddef> 591 601 <command><cmd>parser</cmd> <method>free</method></command> 592 602 593 603 <desc><p>Deletes the parser and the parser command. A parser cannot 594 604 be freed from within one of its handler callbacks (neither directly nor 595 605 indirectly) and will raise a tcl error in this case.</p></desc> 596 606 </commanddef>
Changes to generic/tclexpat.c.
549 549 } 550 550 551 551 /* 552 552 * Set handlers for the parser to routines in this module. 553 553 */ 554 554 555 555 XML_SetElementHandler(expat->parser, 556 - (XML_StartElementHandler) TclGenExpatElementStartHandler, 557 - (XML_EndElementHandler) TclGenExpatElementEndHandler); 556 + TclGenExpatElementStartHandler, 557 + TclGenExpatElementEndHandler); 558 558 XML_SetNamespaceDeclHandler(expat->parser, 559 - (XML_StartNamespaceDeclHandler) TclGenExpatStartNamespaceDeclHandler, 560 - (XML_EndNamespaceDeclHandler) TclGenExpatEndNamespaceDeclHandler); 559 + TclGenExpatStartNamespaceDeclHandler, 560 + TclGenExpatEndNamespaceDeclHandler); 561 561 XML_SetCharacterDataHandler(expat->parser, 562 - (XML_CharacterDataHandler) TclGenExpatCharacterDataHandler); 562 + TclGenExpatCharacterDataHandler); 563 563 XML_SetProcessingInstructionHandler(expat->parser, 564 - (XML_ProcessingInstructionHandler) TclGenExpatProcessingInstructionHandler); 565 - XML_SetDefaultHandlerExpand(expat->parser, 566 - (XML_DefaultHandler) TclGenExpatDefaultHandler); 567 - 564 + TclGenExpatProcessingInstructionHandler); 565 + XML_SetDefaultHandlerExpand(expat->parser, TclGenExpatDefaultHandler); 568 566 XML_SetNotationDeclHandler(expat->parser, 569 - (XML_NotationDeclHandler) TclGenExpatNotationDeclHandler); 567 + TclGenExpatNotationDeclHandler); 570 568 XML_SetExternalEntityRefHandler(expat->parser, 571 - (XML_ExternalEntityRefHandler) TclGenExpatExternalEntityRefHandler); 569 + TclGenExpatExternalEntityRefHandler); 572 570 XML_SetUnknownEncodingHandler(expat->parser, 573 - (XML_UnknownEncodingHandler) TclGenExpatUnknownEncodingHandler, 571 + TclGenExpatUnknownEncodingHandler, 574 572 (void *) expat); 575 - 576 - 577 573 XML_SetCommentHandler(expat->parser, TclGenExpatCommentHandler); 578 - 579 - XML_SetNotStandaloneHandler(expat->parser, TclGenExpatNotStandaloneHandler); 580 - 581 - XML_SetCdataSectionHandler(expat->parser, TclGenExpatStartCdataSectionHandler, 574 + XML_SetNotStandaloneHandler(expat->parser, 575 + TclGenExpatNotStandaloneHandler); 576 + XML_SetCdataSectionHandler(expat->parser, 577 + TclGenExpatStartCdataSectionHandler, 582 578 TclGenExpatEndCdataSectionHandler); 583 - 584 579 XML_SetElementDeclHandler(expat->parser, TclGenExpatElementDeclHandler); 585 - 586 580 XML_SetAttlistDeclHandler(expat->parser, TclGenExpatAttlistDeclHandler); 587 - 588 581 XML_SetDoctypeDeclHandler(expat->parser, 589 582 TclGenExpatStartDoctypeDeclHandler, 590 583 TclGenExpatEndDoctypeDeclHandler); 591 - 592 584 XML_SetXmlDeclHandler (expat->parser, TclGenExpatXmlDeclHandler); 593 - 594 585 XML_SetEntityDeclHandler (expat->parser, 595 586 TclGenExpatEntityDeclHandler); 596 587 if (expat->noexpand) { 597 - XML_SetDefaultHandlerExpand(expat->parser, NULL); 598 588 XML_SetDefaultHandler(expat->parser, 599 - (XML_DefaultHandler) TclGenExpatDefaultHandler); 589 + TclGenExpatDefaultHandler); 600 590 } else { 601 - XML_SetDefaultHandler(expat->parser, NULL); 602 591 XML_SetDefaultHandlerExpand(expat->parser, 603 - (XML_DefaultHandler) TclGenExpatDefaultHandler); 592 + TclGenExpatDefaultHandler); 604 593 } 605 594 606 595 XML_SetUserData(expat->parser, (void *) expat); 607 596 608 597 return TCL_OK; 609 598 } 610 599 ................................................................................ 644 633 XML_ParserFree(expat->parser); 645 634 expat->parser = NULL; 646 635 } 647 636 648 637 /* 649 638 *---------------------------------------------------------------------------- 650 639 * 640 + * CurrentmarkupCommand -- 641 + * 642 + * Set as defaultHandler prior to XML_Currentmarkup() call. 643 + * 644 + * Results: 645 + * None. 646 + * 647 + * Side effects: 648 + * Stores the markup context in expapt->currentmarkup. 649 + * 650 + *---------------------------------------------------------------------------- 651 + */ 652 +static void 653 +CurrentmarkupCommand(userData, s, len) 654 + void *userData; 655 + CONST char *s; 656 + int len; 657 +{ 658 + TclGenExpatInfo *expat = (TclGenExpatInfo *) userData; 659 + 660 + if (expat->status != TCL_OK) { 661 + return; 662 + } 663 + 664 + if (expat->cdata) { 665 + /* TclGenExpatCharacterDataHandler() was called and 666 + * initialized expat->cdata, but expat->cdata isn't reset by 667 + * TclExpatDispatchPCDATA(), so we're called from 668 + * -characterdatacommand and return the empty string by 669 + * definition. */ 670 + expat->currentmarkup = NULL; 671 + expat->currentmarkuplen = 0; 672 + return; 673 + } 674 + expat->currentmarkup = s; 675 + expat->currentmarkuplen = len; 676 + return; 677 +} 678 + 679 + 680 + 681 +/* 682 + *---------------------------------------------------------------------------- 683 + * 651 684 * TclExpatInstanceCmd -- 652 685 * 653 686 * Implements instance command for expat class objects. 654 687 * 655 688 * Results: 656 689 * Depends on the method. 657 690 * ................................................................................ 669 702 Tcl_Obj *CONST objv[]; 670 703 { 671 704 TclGenExpatInfo *expat = (TclGenExpatInfo *) clientData; 672 705 char *data; 673 706 int len = 0, optionIndex, result = TCL_OK; 674 707 675 708 static CONST84 char *options[] = { 676 - "configure", "cget", "free", "get", 709 + "configure", "cget", "currentmarkup", "free", "get", 677 710 "parse", "parsechannel", "parsefile", "reset", NULL 678 711 }; 679 712 enum options { 680 - EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_FREE, EXPAT_GET, 713 + EXPAT_CONFIGURE, EXPAT_CGET, EXPAT_CURRENTMARKUP, EXPAT_FREE, EXPAT_GET, 681 714 EXPAT_PARSE, EXPAT_PARSECHANNEL, EXPAT_PARSEFILE, EXPAT_RESET 682 715 }; 683 716 684 717 685 718 if (objc < 2) { 686 719 Tcl_SetResult (interp, 687 720 "wrong # args: should be \"parserCmd method ?arg ...?\"", ................................................................................ 706 739 break; 707 740 708 741 case EXPAT_CGET: 709 742 710 743 CheckArgs (3,5,2, "?-handlerset handlersetname? switch"); 711 744 result = TclExpatCget(interp, expat, objc - 2, objv + 2); 712 745 break; 746 + 747 + case EXPAT_CURRENTMARKUP: 748 + 749 + CheckArgs (2,2,1, ""); 750 + if (expat->parsingState < 2) { 751 + Tcl_ResetResult(expat->interp); 752 + break; 753 + } 754 + 755 + XML_SetDefaultHandlerExpand(expat->parser, 756 + CurrentmarkupCommand); 757 + XML_DefaultCurrent(expat->parser); 758 + if (expat->currentmarkuplen) { 759 + Tcl_SetObjResult(expat->interp, 760 + Tcl_NewStringObj(expat->currentmarkup, 761 + expat->currentmarkuplen)); 762 + } else { 763 + Tcl_ResetResult(expat->interp); 764 + } 765 + expat->currentmarkup = NULL; 766 + expat->currentmarkuplen = 0; 767 + if (expat->noexpand) { 768 + XML_SetDefaultHandler(expat->parser, 769 + TclGenExpatDefaultHandler); 770 + } else { 771 + XML_SetDefaultHandlerExpand(expat->parser, 772 + TclGenExpatDefaultHandler); 773 + } 774 + result = TCL_OK; 775 + break; 713 776 714 777 case EXPAT_FREE: 715 778 716 779 CheckArgs (2,2,1,""); 717 780 718 781 if (expat->parsingState > 1) { 719 782 Tcl_SetResult (interp, "parser freeing not allowed from within " ................................................................................ 1175 1238 Tcl_IncrRefCount(activeTclHandlerSet->elementstartcommand); 1176 1239 rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1177 1240 if (rc && cmdInfo.isNativeObjectProc) { 1178 1241 activeTclHandlerSet->elementstartObjProc = cmdInfo.objProc; 1179 1242 activeTclHandlerSet->elementstartclientData 1180 1243 = cmdInfo.objClientData; 1181 1244 } else { 1182 - /* hmoreau 22 May 2003 */ 1183 1245 activeTclHandlerSet->elementstartObjProc = NULL; 1184 1246 } 1185 1247 break; 1186 1248 1187 1249 case EXPAT_ELEMENTENDCMD: /* -elementendcommand */ 1188 1250 1189 1251 CheckDefaultTclHandlerSet; ................................................................................ 1194 1256 activeTclHandlerSet->elementendcommand = objPtr[1]; 1195 1257 Tcl_IncrRefCount(activeTclHandlerSet->elementendcommand); 1196 1258 rc = Tcl_GetCommandInfo(interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1197 1259 if (rc && cmdInfo.isNativeObjectProc) { 1198 1260 activeTclHandlerSet->elementendObjProc = cmdInfo.objProc; 1199 1261 activeTclHandlerSet->elementendclientData = cmdInfo.objClientData; 1200 1262 } else { 1201 - /* hmoreau 22 May 2003 */ 1202 1263 activeTclHandlerSet->elementendObjProc = NULL; 1203 1264 } 1204 1265 break; 1205 1266 1206 1267 case EXPAT_STARTNAMESPACEDECLCMD: /* -startnamespacedeclcommand */ 1207 1268 1208 1269 CheckDefaultTclHandlerSet; ................................................................................ 1237 1298 activeTclHandlerSet->datacommand = objPtr[1]; 1238 1299 Tcl_IncrRefCount(activeTclHandlerSet->datacommand); 1239 1300 rc = Tcl_GetCommandInfo (interp, Tcl_GetString(objPtr[1]), &cmdInfo); 1240 1301 if (rc && cmdInfo.isNativeObjectProc) { 1241 1302 activeTclHandlerSet->datacommandObjProc = cmdInfo.objProc; 1242 1303 activeTclHandlerSet->datacommandclientData = cmdInfo.objClientData; 1243 1304 } else { 1244 - /* hmoreau 22 May 2003 */ 1245 1305 activeTclHandlerSet->datacommandObjProc = NULL; 1246 1306 } 1247 1307 break; 1248 1308 1249 1309 case EXPAT_PICMD: /* -processinginstructioncommand */ 1250 1310 1251 1311 CheckDefaultTclHandlerSet; ................................................................................ 1504 1564 break; 1505 1565 1506 1566 case EXPAT_NOEXPAND: 1507 1567 if (Tcl_GetBooleanFromObj (interp, objv[1], &bool) != TCL_OK) { 1508 1568 return TCL_ERROR; 1509 1569 } 1510 1570 if (bool) { 1511 - XML_SetDefaultHandlerExpand(expat->parser, NULL); 1512 - XML_SetDefaultHandler(expat->parser, 1513 - (XML_DefaultHandler) TclGenExpatDefaultHandler); 1514 - } 1515 - else { 1516 - XML_SetDefaultHandler(expat->parser, NULL); 1517 - XML_SetDefaultHandlerExpand(expat->parser, 1518 - (XML_DefaultHandler) TclGenExpatDefaultHandler); 1571 + XML_SetDefaultHandler( expat->parser, 1572 + TclGenExpatDefaultHandler); 1573 + } else { 1574 + XML_SetDefaultHandlerExpand( expat->parser, 1575 + TclGenExpatDefaultHandler); 1519 1576 } 1520 1577 expat->noexpand = bool; 1521 1578 break; 1522 1579 1523 1580 } 1524 1581 1525 1582 objPtr += 2; ................................................................................ 2733 2790 activeCHandlerSet->datacommand (activeCHandlerSet->userData, 2734 2791 s, len); 2735 2792 } 2736 2793 } 2737 2794 activeCHandlerSet = activeCHandlerSet->nextHandlerSet; 2738 2795 } 2739 2796 Tcl_DecrRefCount (expat->cdata); 2740 - expat->cdata = 0; 2797 + expat->cdata = NULL; 2741 2798 return; 2742 2799 } 2743 2800 2744 2801 2745 2802 /* 2746 2803 *---------------------------------------------------------------------------- 2747 2804 *
Changes to generic/tclexpat.h.
130 130 int parsingState; /* 0 == freshly (re-)initialized 131 131 1 == initParserProcs called 132 132 2 == parsing an input chunk */ 133 133 XML_Char nsSeparator; 134 134 int paramentityparsing; 135 135 int noexpand; 136 136 int useForeignDTD; 137 - 137 + CONST char *currentmarkup; /* Used to transfer data for method */ 138 + int currentmarkuplen; /* currentmarkup */ 139 + 138 140 TclHandlerSet *firstTclHandlerSet; 139 141 CHandlerSet *firstCHandlerSet; 140 142 } TclGenExpatInfo; 141 143 142 144 /*-------------------------------------------------------------------------- 143 145 | Function prototypes 144 146 |
Changes to tests/parser.test.
9 9 # parser-5.*: parse input from channel 10 10 # parser-6.*: reuse parser 11 11 # parser-7.*: parser reset 12 12 # parser-8.*: parser free 13 13 # parser-9.*: parser parse 14 14 # parser-10.*: return code 'return' from callback 15 15 # parser-11.*: parser input from filename 16 +# parser-12.*: parser currentmarkup 16 17 # 17 18 # Copyright (c) 1999-2000 Zveno Pty Ltd. 18 -# Copyright (c) 2002-2005 Rolf Ade 19 +# Copyright (c) 2002-2015 Rolf Ade 19 20 # 20 21 # $Id$ 21 22 22 23 source [file join [file dir [info script]] loadtdom.tcl] 23 24 24 25 proc parray arrayName { 25 26 upvar #0 $arrayName arr ................................................................................ 502 503 503 504 proc elementstart {args} { 504 505 global parser 505 506 506 507 $parser parse {<root>foo bar</root>} 507 508 } 508 509 509 -test parser-9.1 {try to use the parser form within one of its callbacks} { 510 +test parser-9.1 {try to use the parser from within one of its callbacks} { 510 511 set parser [expat -elementstartcommand elementstart] 511 512 set result [catch {$parser parse <root>foo</root>} errMsg] 512 513 lappend result $errMsg 513 514 $parser free 514 515 set result 515 516 } {1 {Parser already in use.}} 516 517 ................................................................................ 520 521 $parser parse {<root>foo bar</root>} 521 522 } 522 523 523 524 proc elementstart {args} { 524 525 calledFromElementstart 525 526 } 526 527 527 -test parser-9.2 {try to use the parser form within one of its callbacks} { 528 +test parser-9.2 {try to use the parser from within one of its callbacks} { 528 529 set parser [expat -elementstartcommand elementstart] 529 530 set result [catch {$parser parse <root>foo</root>} errMsg] 530 531 lappend result $errMsg 531 532 $parser free 532 533 set result 533 534 } {1 {Parser already in use.}} 534 535 ................................................................................ 578 579 set parser [::xml::parser parser-11.1 -elementstartcommand Count] 579 580 set file [file join [pwd] [file dir [info script]] data/books.xml] 580 581 $parser parsefile $file 581 582 set ::count 582 583 } {42} 583 584 584 585 586 +proc elementstart-12.1 {parser args} { 587 + global result 588 + append result [$parser currentmarkup] 589 +} 590 + 591 +proc elementend-12.1 {parser args} { 592 + global result 593 + append result [$parser currentmarkup] 594 +} 595 + 596 +test parser-12.1 {currentmarkup method} { 597 + catch {unset result} 598 + set result "" 599 + set p [expat parser-12.1 -noexpand] 600 + $p configure \ 601 + -elementstartcommand [list elementstart-12.1 $p] \ 602 + -elementendcommand [list elementend-12.1 $p] 603 + $p parse {<root rootatt="rootatt">text<a 604 + a_att1="a_att1" 605 + a_att2 = "a_att2"/><b>more text</b></root>} 606 + $p free 607 + set result 608 +} {<root rootatt="rootatt"><a 609 + a_att1="a_att1" 610 + a_att2 = "a_att2"/><b></b></root>} 611 + 612 +proc characterdata-12.2 {parser data} { 613 + global result 614 + append result [$parser currentmarkup] 615 +} 616 +test parser-12.2 {currentmarkup method} { 617 + catch {unset result} 618 + set result "" 619 + set p [expat parser-12.2] 620 + $p configure \ 621 + -characterdatacommand [list characterdata-12.2 $p] 622 + $p parse {<root rootatt="rootatt">text<a 623 + a_att1="a_att1" 624 + a_att2 = "a_att2"/><b>more text</b></root>} 625 + $p free 626 + set result 627 +} {} 628 + 629 +test parser-12.3 {currentmarkup method} { 630 + set p [expat parser-12.3] 631 + set result [$p currentmarkup] 632 + $p free 633 + set result 634 +} {} 635 + 636 +proc elementstart-12.4 {parser handlerset args} { 637 + global result 638 + append result "$handlerset: [$parser currentmarkup]\n" 639 +} 640 +proc elementend-12.4 {parser handlerset args} { 641 + global result 642 + append result "$handlerset: [$parser currentmarkup]\n" 643 +} 644 +test parser-12.4 {currentmarkup method - multiple handler set} { 645 + catch {unset result} 646 + set result "" 647 + set p [expat parser-12.4] 648 + $p configure \ 649 + -elementstartcommand [list elementstart-12.4 $p default] \ 650 + -elementendcommand [list elementend-12.4 $p default] \ 651 + -handlerset "additional" \ 652 + -elementstartcommand [list elementstart-12.4 $p "additional"] \ 653 + -elementendcommand [list elementend-12.4 $p "additional"] 654 + $p parse {<root rootatt="rootatt">text<a 655 + a_att1="a_att1" 656 + a_att2 = "a_att2"/><b>more text</b></root>} 657 + $p free 658 + set result 659 +} {default: <root rootatt="rootatt"> 660 +additional: <root rootatt="rootatt"> 661 +default: <a 662 + a_att1="a_att1" 663 + a_att2 = "a_att2"/> 664 +additional: <a 665 + a_att1="a_att1" 666 + a_att2 = "a_att2"/> 667 +default: 668 +additional: 669 +default: <b> 670 +additional: <b> 671 +default: </b> 672 +additional: </b> 673 +default: </root> 674 +additional: </root> 675 +} 676 + 677 +proc elementstart-12.5 {parser args} { 678 + global result 679 + append result "[$parser currentmarkup]" 680 +} 681 +test parser-12.5 {currentmarkup method - empty element shortcut -elementstartcommand} { 682 + catch {unset result} 683 + set result "" 684 + set p [expat parser-12.5] 685 + $p configure \ 686 + -elementstartcommand [list elementstart-12.5 $p] 687 + $p parse {<root><elem/></root>} 688 + $p free 689 + set result 690 +} {<root><elem/>} 691 + 692 +proc elementend-12.6 {parser args} { 693 + global result 694 + if {[$parser currentmarkup] eq ""} { 695 + append result "<elementend called, but currentmarkup return empty string>" 696 + } 697 + append result "[$parser currentmarkup]" 698 +} 699 +test parser-12.6 {currentmarkup method - empty element shortcut -elementendcommand} { 700 + catch {unset result} 701 + set result "" 702 + set p [expat parser-12.6] 703 + $p configure \ 704 + -elementendcommand [list elementend-12.6 $p] 705 + $p parse {<root><elem/></root>} 706 + $p free 707 + set result 708 +} {<elementend called, but currentmarkup return empty string></root>} 709 + 585 710 foreach parser [info commands xmlparser*] { 586 711 $parser free 587 712 } 588 713 foreach parser [info commands parser-*] { 589 714 $parser free 590 715 } 716 + 717 +proc elementdeclcommand-12.7 {parser args} { 718 + global result 719 + append result "elementdeclcommand: [$parser currentmarkup]" 720 +} 721 + 722 +proc entitydeclcommand-12.7 {parser args} { 723 + global result 724 + append result "entitydeclcommand: [$parser currentmarkup]" 725 +} 726 + 727 +test parser-12.7 {currentmarkup method - not for doctype markup handler} { 728 + catch {unset result} 729 + set result "" 730 + set p [expat parser-12.7] 731 + $p configure \ 732 + -elementdeclcommand [list elementdeclcommand-12.7 $p] \ 733 + -entitydeclcommand [list entitydeclcommand-12.7 $p] 734 + $p parse {<!DOCTYPE test [ 735 +<!ELEMENT test (#PCDATA) > 736 +<!ENTITY % xx '%zz;'> 737 +<!ENTITY % zz '<!ENTITY tricky "error-prone" >' > 738 +%xx; 739 +]> 740 +<test>This sample shows a &tricky; method.</test>} 741 + $p free 742 + set result 743 +} {elementdeclcommand: entitydeclcommand: entitydeclcommand: } 744 + 745 +proc pi-12.8 {parser args} { 746 + global result 747 + append result "pi: [$parser currentmarkup]" 748 +} 749 +test parser-12.8 {currentmarkup method - processing instruction} { 750 + catch {unset result} 751 + set result "" 752 + set p [expat parser-12.8] 753 + $p configure \ 754 + -processinginstructioncommand [list pi-12.8 $p] 755 + $p parse {<doc><?xml-stylesheet type="text/xsl" href="style.xsl"?></doc>} 756 + $p free 757 + set result 758 +} {pi: <?xml-stylesheet type="text/xsl" href="style.xsl"?>} 759 + 760 +proc comment-12.9 {parser args} { 761 + global result 762 + append result "comment: [$parser currentmarkup]" 763 +} 764 +test parser-12.9 {currentmarkup method - comment} { 765 + catch {unset result} 766 + set result "" 767 + set p [expat parser-12.9] 768 + $p configure \ 769 + -commentcommand [list comment-12.9 $p] 770 + $p parse {<doc><!-- A comment --></doc>} 771 + $p free 772 + set result 773 +} {comment: <!-- A comment -->} 774 + 591 775 592 776 # cleanup 593 777 ::tcltest::cleanupTests 594 778 return
Changes to tests/pi.test.
14 14 proc PI {target data args} { 15 15 lappend ::result $target $data 16 16 } 17 17 18 18 test pi-1.1 {PI} { 19 19 set ::result {} 20 20 21 - catch {rename xml::pi-1.1 {}} 22 21 set parser [xml::parser pi-1.1 \ 23 22 -processinginstructioncommand PI] 24 23 $parser parse {<?xml version="1.0"?> 25 24 <!DOCTYPE Test> 26 25 <Test><?Test This is a processing instruction?></Test> 27 26 } 27 + $parser free 28 28 set ::result 29 29 } {Test {This is a processing instruction}} 30 30 31 31 test pi-1.2 {PI: missing trailing ?} { 32 32 set ::result {} 33 33 34 - catch {rename xml::pi-1.2 {}} 35 34 set parser [xml::parser pi-1.2 \ 36 35 -processinginstructioncommand PI] 37 36 set returncode [catch {$parser parse {<?xml version="1.0"?> 38 37 <!DOCTYPE Test> 39 38 <Test><?Test This is a syntax error></Test> 40 39 }} msg] 41 - 40 + $parser free 42 41 list $returncode [regexp {error "unclosed token" at.+} $msg] 43 42 } {1 1} 44 43 45 44 test pi-2.1 {PI with special characters} { 46 45 set ::result {} 47 46 48 - catch {rename xml::pi-2.1 {}} 49 47 set parser [xml::parser pi-2.1 \ 50 48 -processinginstructioncommand PI] 51 49 $parser parse {<?xml version="1.0"?> 52 50 <!DOCTYPE Test> 53 51 <Test><?Test [if !VMLRender]?></Test> 54 52 } 53 + $parser free 55 54 set ::result 56 55 } {Test {[if !VMLRender]}} 57 56 58 -foreach parser [info commands pi-*] { 59 - $parser free 60 -} 61 - 62 57 # cleanup 63 58 ::tcltest::cleanupTests 64 59 return