tDOM

Check-in [4879bb492b]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Merged from schema.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | localkey
Files: files | file ages | folders
SHA3-256: 4879bb492bf44eb5005083e321b65e4a21462a9b73ce1ee966f26354e2cf957d
User & Date: rolf 2019-05-09 19:16:27
Context
2019-05-10
00:40
Merge from schema. check-in: 508a776b44 user: rolf tags: localkey
2019-05-09
19:16
Merged from schema. check-in: 4879bb492b user: rolf tags: localkey
18:34
Test added. check-in: 968b411fd1 user: rolf tags: schema
14:27
wip check-in: b0e429ebf8 user: rolf tags: localkey
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to doc/schema.html.

     1      1   <html>
     2      2   <head>
     3      3   <link rel="stylesheet" href="manpage.css"><title>tDOM manual: schema</title><meta name="xsl-processor" content="Jochen Loewer ([email protected]), Rolf Ade ([email protected]) et. al."><meta name="generator" content="$RCSfile: tmml-html.xsl,v $ $Revision: 1.11 $"><meta charset="utf-8">
     4      4   </head><body>
     5      5   <div class="header">
     6      6   <div class="navbar" align="center">
     7         -<a href="#SECTid0x5588b7db8b30">NAME</a> · <a href="#SECTid0x5588b7db9160">SYNOPSIS</a> · <a href="#SECTid0x5588b7db35d0">DESCRIPTION </a> · <a href="#SECTid0x5588b7e11e10">Schema definition scripts</a> · <a href="#SECTid0x5588b7e1a140">Quantity specifier</a> · <a href="#SECTid0x5588b7e1bfd0">Text constraint scripts</a> · <a href="#SECTid0x5588b7e23fe0">Exampels</a>
            7  +<a href="#SECTid0x5563b3e4fb10">NAME</a> · <a href="#SECTid0x5563b3e50170">SYNOPSIS</a> · <a href="#SECTid0x5563b3e4a5f0">DESCRIPTION </a> · <a href="#SECTid0x5563b3ea8fc0">Schema definition scripts</a> · <a href="#SECTid0x5563b3eb12f0">Quantity specifier</a> · <a href="#SECTid0x5563b3eb3180">Text constraint scripts</a> · <a href="#SECTid0x5563b3ebb590">Exampels</a>
     8      8   </div><hr class="navsep">
     9      9   </div><div class="body">
    10         -  <h2><a name="SECTid0x5588b7db8b30">NAME</a></h2><p class="namesection">
           10  +  <h2><a name="SECTid0x5563b3e4fb10">NAME</a></h2><p class="namesection">
    11     11   <b class="names">tdom::schema - </b><br>Create a schema validation command</p>
    12     12   
    13         -  <h2><a name="SECTid0x5588b7db9160">SYNOPSIS</a></h2><pre class="syntax">package require tdom
           13  +  <h2><a name="SECTid0x5563b3e50170">SYNOPSIS</a></h2><pre class="syntax">package require tdom
    14     14   
    15     15   <b class="cmd">tdom::schema</b> <i class="m">?create?</i> <i class="m">cmdName</i>
    16     16       </pre>
    17     17   
    18         -  <h2><a name="SECTid0x5588b7db35d0">DESCRIPTION </a></h2><p>This command creates validation commands with a simple API. The
           18  +  <h2><a name="SECTid0x5563b3e4a5f0">DESCRIPTION </a></h2><p>This command creates validation commands with a simple API. The
    19     19       validation commands have methods to define a schema and are able
    20     20       to validate XML or DOM trees (and to some degree other kind of
    21     21       hierarchical data) against this schema.</p><p>Additionally, a validation command may be used as argument to
    22     22       the <i class="m">-validateCmd</i> option of the <i class="m">dom parse</i> and the
    23     23       <i class="m">expat</i> commands to enable validation additional to what they
    24     24       otherwise do.</p><p>The valid methods of the created commands are:</p><dl class="commandlist">
    25     25         
................................................................................
   165    165           <dt><b class="method">reset</b></dt>
   166    166           <dd>This method resets the validation command into state
   167    167           READY (while preserving the defined grammer).</dd>
   168    168         
   169    169   
   170    170       </dl>
   171    171   
   172         -  <h2><a name="SECTid0x5588b7e11e10">Schema definition scripts</a></h2><p>Schema definition scripts are ordinary Tcl scripts that are
          172  +  <h2><a name="SECTid0x5563b3ea8fc0">Schema definition scripts</a></h2><p>Schema definition scripts are ordinary Tcl scripts that are
   173    173       evaluatend in the namespace tdom::schema. The below listed schema
   174    174       definition commands in this tcl namespace allow to define a wide
   175    175       variety of document structures. Every schema definition command
   176    176       establish a validation constraint on the content which has to
   177    177       match or must be optional to render the content as valid. It is a
   178    178       validation error if the element in the XML source has additional
   179    179       (not matched) content.</p><p>The schema definition commands are:</p><dl class="commandlist">
................................................................................
   315    315           call. This is meant as toplevel command of a <i>schemacmd
   316    316           define</i> script. This command is not allowed nested in an
   317    317           other definition script command and will raise error, if you
   318    318           call it there.</dd>
   319    319         
   320    320       </dl>
   321    321   
   322         -  <h2><a name="SECTid0x5588b7e1a140">Quantity specifier</a></h2><p>Serveral schema definition commands expects a quantifier as
          322  +  <h2><a name="SECTid0x5563b3eb12f0">Quantity specifier</a></h2><p>Serveral schema definition commands expects a quantifier as
   323    323       one of their arguments, which specifies how often the content
   324    324       particle specified by the command is expected. The valid values
   325    325       for a <i class="m">quant</i> argument are:</p><dl class="optlist">
   326    326         
   327    327           <dt><b>!</b></dt>
   328    328           <dd>The content particle must occur exactly once in valid
   329    329           documents. This is the default, if a quantifier is
................................................................................
   360    360           n to m times (both inclusive) in a row in valid documents. The
   361    361           quantifier must be a tcl list with two elements. Both elements
   362    362           must be integers, with n &gt;= 0 and n &lt; m.</dd>
   363    363         
   364    364       </dl><p>If an optional quantifier is not given then it defaults to * in
   365    365       case of the mixed command and to ! for all other commands.</p>
   366    366   
   367         -  <h2><a name="SECTid0x5588b7e1bfd0">Text constraint scripts</a></h2><p></p><p>The text constraint commands are:</p><dl class="commandlist">
          367  +  <h2><a name="SECTid0x5563b3eb3180">Text constraint scripts</a></h2><p></p><p>The text constraint commands are:</p><dl class="commandlist">
   368    368         
   369    369           <dt><b class="cmd">isint</b></dt>
   370    370           <dd></dd>
   371    371         
   372    372   
   373    373         
   374    374           <dt>
................................................................................
   517    517         
   518    518           <dt><b class="cmd">idref</b></dt>
   519    519           <dd>This text constraint command expects the text to be a
   520    520           reference to an ID within the document. The referenced ID may
   521    521           be later in the document, that the reference. Several
   522    522           references within the document to one ID are possible.</dd>
   523    523         
          524  +      
          525  +        <dt><b class="cmd">base64</b></dt>
          526  +        <dd>This text constraint match if text is valid according to
          527  +        RFC 4648RFC 4648.</dd>
          528  +      
   524    529       </dl>
   525    530     
   526         -  <h2><a name="SECTid0x5588b7e23fe0">Exampels</a></h2><p>The XML Schema Part 0: Primer Second Edition
          531  +  <h2><a name="SECTid0x5563b3ebb590">Exampels</a></h2><p>The XML Schema Part 0: Primer Second Edition
   527    532       (<a href="https://www.w3.org/TR/xmlschema-0/">https://www.w3.org/TR/xmlschema-0/</a>) starts with this
   528    533       example schema:</p><pre class="example">
   529    534   &lt;xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"&gt;
   530    535   
   531    536     &lt;xsd:annotation&gt;
   532    537       &lt;xsd:documentation xml:lang="en"&gt;
   533    538        Purchase order schema for Example.com.

Changes to doc/schema.n.

   535    535   the ID isn't actually referenced within the document.
   536    536   .TP
   537    537   \&\fB\fBidref\fP
   538    538   \&\fRThis text constraint command expects the text to be a
   539    539   reference to an ID within the document. The referenced ID may
   540    540   be later in the document, that the reference. Several
   541    541   references within the document to one ID are possible.
          542  +.TP
          543  +\&\fB\fBbase64\fP
          544  +\&\fRThis text constraint match if text is valid according to
          545  +RFC 4648RFC 4648.
   542    546   .SH Exampels
   543    547   .PP
   544    548   .UR "https://www.w3.org/TR/xmlschema-0/"
   545    549   <URL: https://www.w3.org/TR/xmlschema-0/>
   546    550   .UE
   547    551   The XML Schema Part 0: Primer Second Edition
   548    552   () starts with this

Changes to doc/schema.xml.

   476    476         <commanddef>
   477    477           <command><cmd>idref</cmd></command>
   478    478           <desc>This text constraint command expects the text to be a
   479    479           reference to an ID within the document. The referenced ID may
   480    480           be later in the document, that the reference. Several
   481    481           references within the document to one ID are possible.</desc>
   482    482         </commanddef>
          483  +      <commanddef>
          484  +        <command><cmd>base64</cmd></command>
          485  +        <desc>This text constraint match if text is valid according to
          486  +        RFC 4648RFC 4648.</desc>
          487  +      </commanddef>
   483    488       </commandlist>
   484    489     </section>
   485    490     
   486    491     <section>
   487    492       <title>Exampels</title>
   488    493   
   489    494       <p>The XML Schema Part 0: Primer Second Edition

Changes to generic/schema.c.

  4521   4521       CHECK_TOPLEVEL
  4522   4522       checkNrArgs (1,1,"no argument expected");
  4523   4523       ADD_CONSTRAINT (sdata, sc)
  4524   4524       sc->constraint = idrefImpl;
  4525   4525       sc->constraintData = (void *)sdata;
  4526   4526       return TCL_OK;
  4527   4527   }
         4528  +
         4529  +static int
         4530  +base64Impl (
         4531  +    Tcl_Interp *interp,
         4532  +    void *constraintData,
         4533  +    char *text
         4534  +    )
         4535  +{
         4536  +    int chars = 0, equals = 0;
         4537  +    
         4538  +    while (*text != '\0') {
         4539  +        if (SPACE(*text)) {
         4540  +            text++;
         4541  +            continue;
         4542  +        }
         4543  +        if (   (*text >= 'A' && *text <= 'Z')
         4544  +            || (*text >= 'a' && *text <= 'z')
         4545  +            || (*text >= '0' && *text <= '9')
         4546  +            || (*text = '+')
         4547  +            || (*text = '/')) {
         4548  +            chars++;
         4549  +            text++;
         4550  +            continue;
         4551  +        }
         4552  +        if (equals < 2 && *text == '=') {
         4553  +            equals++;
         4554  +            text++;
         4555  +            continue;
         4556  +        }
         4557  +        break;
         4558  +    }
         4559  +    if (*text) {
         4560  +        return 0;
         4561  +    }
         4562  +    if ((chars + equals) % 4 != 0) {
         4563  +        return 0;
         4564  +    }
         4565  +    return 1;
         4566  +}
         4567  +
         4568  +static int
         4569  +base64TCObjCmd (
         4570  +    ClientData clientData,
         4571  +    Tcl_Interp *interp,
         4572  +    int objc,
         4573  +    Tcl_Obj *const objv[]
         4574  +    )
         4575  +{
         4576  +    SchemaData *sdata = GETASI;
         4577  +    SchemaConstraint *sc;
         4578  +
         4579  +    CHECK_TI
         4580  +    CHECK_TOPLEVEL
         4581  +    checkNrArgs (1,1,"No arguments expected");
         4582  +    ADD_CONSTRAINT (sdata, sc)
         4583  +    sc->constraint = base64Impl;
         4584  +    return TCL_OK;
         4585  +}
  4528   4586   
  4529   4587   void
  4530   4588   tDOM_SchemaInit (
  4531   4589       Tcl_Interp *interp
  4532   4590       )
  4533   4591   {
  4534   4592       /* Inline definition commands. */
................................................................................
  4617   4675                             stripTCObjCmd, NULL, NULL);
  4618   4676       Tcl_CreateObjCommand (interp,"tdom::schema::text::split",
  4619   4677                             splitTCObjCmd, NULL, NULL);
  4620   4678       Tcl_CreateObjCommand (interp,"tdom::schema::text::id",
  4621   4679                             idTCObjCmd, NULL, NULL);
  4622   4680       Tcl_CreateObjCommand (interp,"tdom::schema::text::idref",
  4623   4681                             idrefTCObjCmd, NULL, NULL);
         4682  +    Tcl_CreateObjCommand (interp,"tdom::schema::text::base64",
         4683  +                          base64TCObjCmd, NULL, NULL);
  4624   4684   }
  4625   4685   
  4626   4686   
  4627   4687   #endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to generic/schema.h.

   101    101       struct SchemaValidationStack *next;
   102    102       struct SchemaValidationStack *down;
   103    103       int               activeChild;
   104    104       int               hasMatched;
   105    105       int              *interleaveState;
   106    106   } SchemaValidationStack;
   107    107   
   108         -typedef keyConstraint *key;
   109         -
   110    108   typedef enum {
   111    109       VALIDATION_READY,
   112    110       VALIDATION_STARTED,
   113    111       VALIDATION_ERROR,
   114    112       VALIDATION_FINISHED
   115    113   } ValidationState;
   116    114   

Changes to generic/tcldom.c.

  3944   3944       return TCL_OK;
  3945   3945   }
  3946   3946   
  3947   3947   /*----------------------------------------------------------------------------
  3948   3948   |   selectNodesNamespaces
  3949   3949   |
  3950   3950   \---------------------------------------------------------------------------*/
  3951         -static int selectNodesNamespaces (
  3952         -    domDocument *doc,
         3951  +int tcldom_prefixNSlist (
         3952  +    char      ***prefixnsPtr,
  3953   3953       Tcl_Interp  *interp,
  3954   3954       int          objc,
  3955         -    Tcl_Obj     *const objv[] 
         3955  +    Tcl_Obj     *const objv[],
         3956  +    const char  *methodName
  3956   3957       )
  3957   3958   {
         3959  +    char   **prefixns = *prefixnsPtr;
  3958   3960       int      len, i, result;
  3959   3961       Tcl_Obj *objPtr, *listPtr;
  3960   3962   
  3961   3963       CheckArgs (2,3,2, "?prefixUriList?");
  3962         -    if (objc == 3) {
  3963         -        result = Tcl_ListObjLength (interp, objv[2], &len);
  3964         -        if (result != TCL_OK || (len % 2) != 0) {
  3965         -            SetResult ("The optional argument to the selectNodesNamespaces"
  3966         -                       " method must be a 'prefix namespace' pairs list");
  3967         -            return TCL_ERROR;
  3968         -        }
  3969         -        i = 0;
  3970         -        if (doc->prefixNSMappings) {
  3971         -            while (doc->prefixNSMappings[i]) {
  3972         -                FREE (doc->prefixNSMappings[i]);
  3973         -                i++;
  3974         -            }
  3975         -        }
  3976         -        if (i < len + 1) {
  3977         -            if (doc->prefixNSMappings) FREE (doc->prefixNSMappings);
  3978         -            doc->prefixNSMappings = MALLOC (sizeof (char*)*(len+1));
  3979         -        }
  3980         -        for (i = 0; i < len; i++) {
  3981         -            Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
  3982         -            doc->prefixNSMappings[i] = tdomstrdup (Tcl_GetString (objPtr));
  3983         -        }
  3984         -        doc->prefixNSMappings[len] = NULL;
  3985         -        Tcl_SetObjResult (interp, objv[2]);
  3986         -    } else {
         3964  +    i = 0;
         3965  +    if (objc == 2) {
         3966  +        if (!prefixns) return TCL_OK;
  3987   3967           listPtr = Tcl_NewListObj (0, NULL);
  3988   3968           i = 0;
  3989         -        if (doc->prefixNSMappings) {
  3990         -            while (doc->prefixNSMappings[i]) {
  3991         -                objPtr = Tcl_NewStringObj (doc->prefixNSMappings[i], -1);
  3992         -                Tcl_ListObjAppendElement (interp, listPtr, objPtr);
  3993         -                i++;
  3994         -            }
         3969  +        while (prefixns[i]) {
         3970  +            Tcl_ListObjAppendElement (
         3971  +                interp, listPtr, Tcl_NewStringObj (prefixns[i], -1)
         3972  +                );
         3973  +            i++;
  3995   3974           }
  3996   3975           Tcl_SetObjResult (interp, listPtr);
         3976  +        return TCL_OK;
  3997   3977       }
         3978  +    result = Tcl_ListObjLength (interp, objv[2], &len);
         3979  +    if (result != TCL_OK || (len % 2) != 0) {
         3980  +        SetResult3 ("The optional argument to the ", methodName, 
         3981  +                   " method must be a 'prefix namespace' pairs list");
         3982  +        return TCL_ERROR;
         3983  +    }
         3984  +    if (prefixns) {
         3985  +        while (prefixns[i]) {
         3986  +            FREE (prefixns[i]);
         3987  +            i++;
         3988  +        }
         3989  +    }
         3990  +    if (len == 0) {
         3991  +        FREE (prefixns);
         3992  +        *prefixnsPtr = NULL;
         3993  +        return TCL_OK;
         3994  +    }
         3995  +    if (i < len + 1) {
         3996  +        if (prefixns) FREE (prefixns);
         3997  +        prefixns = MALLOC (sizeof (char*) * (len+1));
         3998  +        *prefixnsPtr = prefixns;
         3999  +    }
         4000  +    for (i = 0; i < len; i++) {
         4001  +        Tcl_ListObjIndex (interp, objv[2], i, &objPtr);
         4002  +        prefixns[i] = tdomstrdup (Tcl_GetString (objPtr));
         4003  +    }
         4004  +    prefixns[len] = NULL;
         4005  +    Tcl_SetObjResult (interp, objv[2]);
  3998   4006       return TCL_OK;
  3999   4007   }
  4000   4008   
  4001   4009   /*----------------------------------------------------------------------------
  4002   4010   |   renameNodes
  4003   4011   |
  4004   4012   \---------------------------------------------------------------------------*/
................................................................................
  5923   5931               SetResult("DOCUMENT_NODE");
  5924   5932               return TCL_OK;
  5925   5933   
  5926   5934           case m_cdataSectionElements:
  5927   5935               return cdataSectionElements (doc, interp, objc, objv);
  5928   5936   
  5929   5937           case m_selectNodesNamespaces:
  5930         -            return selectNodesNamespaces (doc, interp, objc, objv);
  5931         -
         5938  +            return tcldom_prefixNSlist (&(doc->prefixNSMappings), interp, objc,
         5939  +                                        objv, "selectNodesNamespaces");
         5940  +            
  5932   5941           case m_renameNode:
  5933   5942               return renameNodes (doc, interp, objc, objv);
  5934   5943               
  5935   5944           case m_deleteXPathCache:
  5936   5945               return deleteXPathCache (doc, interp, objc, objv);
  5937   5946   
  5938   5947           case m_appendChild:

Changes to generic/tcldom.h.

    51     51                         int isFQName);
    52     52   void tcldom_createNodeObj(Tcl_Interp * interp, domNode *node,
    53     53                             char *objCmdName);
    54     54   
    55     55   domNode * tcldom_getNodeFromObj(Tcl_Interp  *interp, Tcl_Obj *nodeObj);
    56     56   domDocument * tcldom_getDocumentFromName(Tcl_Interp  *interp, char *docName,
    57     57                                            char **errMsg);
           58  +int tcldom_prefixNSlist (char ***prefixnsPtr, Tcl_Interp *interp, int objc,
           59  +                         Tcl_Obj *const objv[], const char *methodName);
    58     60   
    59     61   void tcldom_initialize(void);
    60     62   
    61     63   Tcl_ObjCmdProc tcldom_DomObjCmd;
    62     64   Tcl_ObjCmdProc tcldom_DocObjCmd;
    63     65   Tcl_ObjCmdProc tcldom_NodeObjCmd;
    64     66   Tcl_ObjCmdProc TclExpatObjCmd;

Changes to tests/dom.test.

   176    176       dom createDocument test doc
   177    177       set result [catch {set doc foo} errMsg]
   178    178       lappend result $errMsg
   179    179       $doc delete
   180    180       unset doc
   181    181       set result
   182    182   } {1 {can't set "doc": var is read-only}}
          183  +
          184  +test dom-1.25 {Doc var} {
          185  +    dom parse <test/> doc
          186  +    dom parse <test/> doc
          187  +    unset doc
          188  +} {}
          189  +
          190  +test dom-1.26 {Doc var} {
          191  +    dom parse <test/> doc
          192  +    set result [catch {$doc documentElement doc}]
          193  +    unset doc
          194  +    set result
          195  +} {1}
   183    196   
   184    197   test dom-2.1 {Don't quash white space at start or end of non white space content} {
   185    198       set doc [dom parse {<root>
   186    199       some content
   187    200       </root>}]
   188    201       set root [$doc documentElement]
   189    202       $root text

Changes to tests/loadtdom.tcl.

    10     10       # We still support 8.4 to some degree
    11     11       package require Tcl 8.4
    12     12   } else {
    13     13       package require Tcl 8.4-
    14     14   }
    15     15   package require tcltest 2.2
    16     16   namespace import ::tcltest::*
           17  +catch {tcltest::loadTestedCommands}
           18  +
    17     19   if {[catch {package require -exact tdom 0.9.2}]} {
    18     20       if {[catch {load [file join [file dir [info script]] ../unix/libtdom0.9.2.so]}]} {
    19     21           error "Unable to load the appropriate tDOM version!"
    20     22       }
    21     23   }
    22     24   if {[info commands ::tdom::xmlReadFile] == ""} {
    23     25       # tcldomsh without the script library. Source the lib.
    24     26       source [file join [file dir [info script]] ../lib tdom.tcl]
    25     27   }

Changes to tests/schema.test.

  3415   3415           {<doc><idref idref="abc"/><idref idref="123"/></doc>}
  3416   3416       } {
  3417   3417           lappend result [s validate $xml]
  3418   3418       }
  3419   3419       s delete
  3420   3420       set result
  3421   3421   } {1 1 0 1 1 1 1 0 0 0}
         3422  +
         3423  +test schema-14.27 {base64} {
         3424  +    tdom::schema s
         3425  +    s define {
         3426  +        defelement doc {
         3427  +            text base64
         3428  +        }
         3429  +    }
         3430  +    set result [list]
         3431  +    foreach xml {
         3432  +        <doc/>
         3433  +        {<doc>ZVL1</doc>}        
         3434  +        {<doc>zvL1</doc>}        
         3435  +        {<doc>zvü1</doc>}        
         3436  +        {<doc>0a BED   E+9</doc>}        
         3437  +        {<doc>ub1sU3==</doc>}        
         3438  +        {<doc>abc</doc>}        
         3439  +        {<doc>===</doc>}        
         3440  +    } {
         3441  +        lappend result [s validate $xml]
         3442  +    }
         3443  +    s delete
         3444  +    set result
         3445  +} {1 1 1 0 1 1 0 0}
  3422   3446   
  3423   3447   test schema-15.1 {constraint cmd tcl} {
  3424   3448       tdom::schema s
  3425   3449       s define {
  3426   3450           defelement a {
  3427   3451               tcl append ::schema-15.1
  3428   3452               element b
................................................................................
  4002   4026   
  4003   4027   test schema-17.2 {info} {
  4004   4028       tdom::schema s
  4005   4029       s define {
  4006   4030           defelement b {
  4007   4031               element b1
  4008   4032               element b2
         4033  +        }
         4034  +        defelement a {
         4035  +            element a1
         4036  +            element a2
         4037  +        }
         4038  +    }
         4039  +    set result [lsort [s info defelements]]
         4040  +    s delete
         4041  +    set result
         4042  +} {a b}
         4043  +
         4044  +test schema-17.3 {info} {
         4045  +    tdom::schema s
         4046  +    s define {
         4047  +        defelement b {
         4048  +            element b1 1 text
         4049  +            element a
         4050  +            element b2
  4009   4051           }
  4010   4052           defelement a {
  4011   4053               element a1
  4012   4054               element a2
  4013   4055           }
  4014   4056       }
  4015   4057       set result [lsort [s info defelements]]