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 '&#37;zz;'>
          737  +<!ENTITY % zz '&#60;!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