tDOM

Check-in [a886296dc3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Added text constraint commands id and idref.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: a886296dc300101afa09bd16b66ddf233b4500d801c64140099380bdfd04bfaa
User & Date: rolf 2019-05-02 16:53:23
Context
2019-05-06
23:18
Added text constrain cmd base64. check-in: 68cd47d57c user: rolf tags: schema
2019-05-04
12:35
Started work on subtree local unique/key/keyref. check-in: 97b292828f user: rolf tags: localkey
2019-05-02
16:53
Added text constraint commands id and idref. check-in: a886296dc3 user: rolf tags: schema
12:14
Added new text constraint command split, which splits the text to check into a list and cecks the elements of that list against the given constraints. check-in: 77cf4c7090 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to apps/toschema.tcl.

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
                set cmd "attribute $attname"
            }
            if {$isRequired && $default != ""} {
                puts "[indent]$cmd ? {[list "fixed" $default]}"
                continue
            }
            switch $type {
                "ID" -
                "IDREF" -
                "IDREFS" -
                "ENTITY" -
                "ENTITIES" -
                "NOTATION" {
                    # All above to be done
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                "NMTOKEN" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken\}"
                }









                "NMTOKENS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtokens\}"
                }
                "CDATA" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                default {






<
<
<









>
>
>
>
>
>
>
>
>







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
                set cmd "attribute $attname"
            }
            if {$isRequired && $default != ""} {
                puts "[indent]$cmd ? {[list "fixed" $default]}"
                continue
            }
            switch $type {



                "ENTITY" -
                "ENTITIES" -
                "NOTATION" {
                    # All above to be done
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                "NMTOKEN" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken\}"
                }
                "ID" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtoken;id\}"
                }
                "IDREF" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{idref\}"
                }
                "IDREFS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{split \{idref\}\}"
                }
                "NMTOKENS" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}] \{nmtokens\}"
                }
                "CDATA" {
                    puts "[indent]$cmd [expr {$isRequired ? "" : "?"}]"
                }
                default {

Changes to doc/schema.html.

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
...
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
...
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
...
502
503
504
505
506
507
508














509
510
511
512
513
514
515
516
517
518
<html>
<head>
<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">
</head><body>
<div class="header">
<div class="navbar" align="center">
<a href="#SECTid0x55d81f852b30">NAME</a> · <a href="#SECTid0x55d81f853160">SYNOPSIS</a> · <a href="#SECTid0x55d81f84d5d0">DESCRIPTION </a> · <a href="#SECTid0x55d81f8ab7e0">Schema definition scripts</a> · <a href="#SECTid0x55d81f8b3b10">Quantity specifier</a> · <a href="#SECTid0x55d81f8b59a0">Text constraint scripts</a> · <a href="#SECTid0x55d81f8bcfc0">Exampels</a>
</div><hr class="navsep">
</div><div class="body">
  <h2><a name="SECTid0x55d81f852b30">NAME</a></h2><p class="namesection">
<b class="names">tdom::schema - </b><br>Create a schema validation command</p>

  <h2><a name="SECTid0x55d81f853160">SYNOPSIS</a></h2><pre class="syntax">package require tdom

<b class="cmd">tdom::schema</b> <i class="m">?create?</i> <i class="m">cmdName</i>
    </pre>

  <h2><a name="SECTid0x55d81f84d5d0">DESCRIPTION </a></h2><p>This command creates validation commands with a simple API. The
    validation commands have methods to define a schema and are able
    to validate XML or DOM trees (and to some degree other kind of
    hierarchical data) against this schema.</p><p>Additionally, a validation command may be used as argument to
    the <i class="m">-validateCmd</i> option of the <i class="m">dom parse</i> and the
    <i class="m">expat</i> commands to enable validation additional to what they
    otherwise do.</p><p>The valid methods of the created commands are:</p><dl class="commandlist">
      
................................................................................
        <dt><b class="method">reset</b></dt>
        <dd>This method resets the validation command into state
        READY (while preserving the defined grammer).</dd>
      

    </dl>

  <h2><a name="SECTid0x55d81f8ab7e0">Schema definition scripts</a></h2><p>Schema definition scripts are ordinary Tcl scripts that are
    evaluatend in the namespace tdom::schema. The below listed schema
    definition commands in this tcl namespace allow to define a wide
    variety of document structures. Every schema definition command
    establish a validation constraint on the content which has to
    match or must be optional to render the content as valid. It is a
    validation error if the element in the XML source has additional
    (not matched) content.</p><p>The schema definition commands are:</p><dl class="commandlist">
................................................................................
        call. This is meant as toplevel command of a <i>schemacmd
        define</i> script. This command is not allowed nested in an
        other definition script command and will raise error, if you
        call it there.</dd>
      
    </dl>

  <h2><a name="SECTid0x55d81f8b3b10">Quantity specifier</a></h2><p>Serveral schema definition commands expects a quantifier as
    one of their arguments, which specifies how often the content
    particle specified by the command is expected. The valid values
    for a <i class="m">quant</i> argument are:</p><dl class="optlist">
      
        <dt><b>!</b></dt>
        <dd>The content particle must occur exactly once in valid
        documents. This is the default, if a quantifier is
................................................................................
        n to m times (both inclusive) in a row in valid documents. The
        quantifier must be a tcl list with two elements. Both elements
        must be integers, with n &gt;= 0 and n &lt; m.</dd>
      
    </dl><p>If an optional quantifier is not given then it defaults to * in
    case of the mixed command and to ! for all other commands.</p>

  <h2><a name="SECTid0x55d81f8b59a0">Text constraint scripts</a></h2><p></p><p>The text constraint commands are:</p><dl class="commandlist">
      
        <dt><b class="cmd">isint</b></dt>
        <dd></dd>
      

      
        <dt>
<b class="cmd">fixed</b> <i class="m">value</i>
</dt>
        <dd></dd>

      
      
      
        <dt>
<b class="cmd">tcl</b> <i class="m">tclcmd</i> <i class="m">?arg arg ...?</i>
</dt>
        <dd>Evaluates the tcl script <i class="m">tclcmd arg arg ... </i> and
................................................................................
            as last argument. This call must return a valid tcl list,
            which elements are tested..</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <i class="m">whitespace</i>.</p>
</dd>
      














    </dl>
  
  <h2><a name="SECTid0x55d81f8bcfc0">Exampels</a></h2><p>The XML Schema Part 0: Primer Second Edition
    (<a href="https://www.w3.org/TR/xmlschema-0/">https://www.w3.org/TR/xmlschema-0/</a>) starts with this
    example schema:</p><pre class="example">
&lt;xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"&gt;

  &lt;xsd:annotation&gt;
    &lt;xsd:documentation xml:lang="en"&gt;
     Purchase order schema for Example.com.





|


|


|




|







 







|







 







|







 







|









|
>







 







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


|







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
...
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
...
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
...
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
<html>
<head>
<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">
</head><body>
<div class="header">
<div class="navbar" align="center">
<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>
</div><hr class="navsep">
</div><div class="body">
  <h2><a name="SECTid0x5588b7db8b30">NAME</a></h2><p class="namesection">
<b class="names">tdom::schema - </b><br>Create a schema validation command</p>

  <h2><a name="SECTid0x5588b7db9160">SYNOPSIS</a></h2><pre class="syntax">package require tdom

<b class="cmd">tdom::schema</b> <i class="m">?create?</i> <i class="m">cmdName</i>
    </pre>

  <h2><a name="SECTid0x5588b7db35d0">DESCRIPTION </a></h2><p>This command creates validation commands with a simple API. The
    validation commands have methods to define a schema and are able
    to validate XML or DOM trees (and to some degree other kind of
    hierarchical data) against this schema.</p><p>Additionally, a validation command may be used as argument to
    the <i class="m">-validateCmd</i> option of the <i class="m">dom parse</i> and the
    <i class="m">expat</i> commands to enable validation additional to what they
    otherwise do.</p><p>The valid methods of the created commands are:</p><dl class="commandlist">
      
................................................................................
        <dt><b class="method">reset</b></dt>
        <dd>This method resets the validation command into state
        READY (while preserving the defined grammer).</dd>
      

    </dl>

  <h2><a name="SECTid0x5588b7e11e10">Schema definition scripts</a></h2><p>Schema definition scripts are ordinary Tcl scripts that are
    evaluatend in the namespace tdom::schema. The below listed schema
    definition commands in this tcl namespace allow to define a wide
    variety of document structures. Every schema definition command
    establish a validation constraint on the content which has to
    match or must be optional to render the content as valid. It is a
    validation error if the element in the XML source has additional
    (not matched) content.</p><p>The schema definition commands are:</p><dl class="commandlist">
................................................................................
        call. This is meant as toplevel command of a <i>schemacmd
        define</i> script. This command is not allowed nested in an
        other definition script command and will raise error, if you
        call it there.</dd>
      
    </dl>

  <h2><a name="SECTid0x5588b7e1a140">Quantity specifier</a></h2><p>Serveral schema definition commands expects a quantifier as
    one of their arguments, which specifies how often the content
    particle specified by the command is expected. The valid values
    for a <i class="m">quant</i> argument are:</p><dl class="optlist">
      
        <dt><b>!</b></dt>
        <dd>The content particle must occur exactly once in valid
        documents. This is the default, if a quantifier is
................................................................................
        n to m times (both inclusive) in a row in valid documents. The
        quantifier must be a tcl list with two elements. Both elements
        must be integers, with n &gt;= 0 and n &lt; m.</dd>
      
    </dl><p>If an optional quantifier is not given then it defaults to * in
    case of the mixed command and to ! for all other commands.</p>

  <h2><a name="SECTid0x5588b7e1bfd0">Text constraint scripts</a></h2><p></p><p>The text constraint commands are:</p><dl class="commandlist">
      
        <dt><b class="cmd">isint</b></dt>
        <dd></dd>
      

      
        <dt>
<b class="cmd">fixed</b> <i class="m">value</i>
</dt>
        <dd>The text constraint only matches if the text value is
        string equal to the given value.</dd>
      
      
      
        <dt>
<b class="cmd">tcl</b> <i class="m">tclcmd</i> <i class="m">?arg arg ...?</i>
</dt>
        <dd>Evaluates the tcl script <i class="m">tclcmd arg arg ... </i> and
................................................................................
            as last argument. This call must return a valid tcl list,
            which elements are tested..</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <i class="m">whitespace</i>.</p>
</dd>
      
      
        <dt><b class="cmd">id</b></dt>
        <dd>This text constraint command marks the text as a
        document wide ID (to be referenced by an idref). Every ID
        value within a document must be unique. It isn't an error if
        the ID isn't actually referenced within the document.</dd>
      
      
        <dt><b class="cmd">idref</b></dt>
        <dd>This text constraint command expects the text to be a
        reference to an ID within the document. The referenced ID may
        be later in the document, that the reference. Several
        references within the document to one ID are possible.</dd>
      
    </dl>
  
  <h2><a name="SECTid0x5588b7e23fe0">Exampels</a></h2><p>The XML Schema Part 0: Primer Second Edition
    (<a href="https://www.w3.org/TR/xmlschema-0/">https://www.w3.org/TR/xmlschema-0/</a>) starts with this
    example schema:</p><pre class="example">
&lt;xsd:schema xmlns:xsd="http://www.w3.org/2001/XMLSchema"&gt;

  &lt;xsd:annotation&gt;
    &lt;xsd:documentation xml:lang="en"&gt;
     Purchase order schema for Example.com.

Changes to doc/schema.n.

414
415
416
417
418
419
420
421

422
423
424
425
426
427
428
...
522
523
524
525
526
527
528












529
530
531
532
533
534
535
.PP
The text constraint commands are:
.TP
\&\fB\fBisint\fP
\&\fR
.TP
\&\fB\fBfixed\fP \fIvalue\fB
\&\fR

.TP
\&\fB\fBtcl\fP \fItclcmd\fB \fI?arg arg ...?\fB
\&\fREvaluates the tcl script \fItclcmd arg arg ... \fR and
the text to validate appended to the argument list. The return
value of the tcl command is interpreted as a boolean.
.TP
\&\fB\fBenumeration\fP \fIlist\fB
................................................................................
level, appended with every given arg and the text to split
as last argument. This call must return a valid tcl list,
which elements are tested..
.PP
The default in case no split type argument is given is
\&\fIwhitespace\fR.
.RE












.SH Exampels
.PP
.UR "https://www.w3.org/TR/xmlschema-0/"
<URL: https://www.w3.org/TR/xmlschema-0/>
.UE
The XML Schema Part 0: Primer Second Edition
() starts with this






|
>







 







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







414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
...
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
.PP
The text constraint commands are:
.TP
\&\fB\fBisint\fP
\&\fR
.TP
\&\fB\fBfixed\fP \fIvalue\fB
\&\fRThe text constraint only matches if the text value is
string equal to the given value.
.TP
\&\fB\fBtcl\fP \fItclcmd\fB \fI?arg arg ...?\fB
\&\fREvaluates the tcl script \fItclcmd arg arg ... \fR and
the text to validate appended to the argument list. The return
value of the tcl command is interpreted as a boolean.
.TP
\&\fB\fBenumeration\fP \fIlist\fB
................................................................................
level, appended with every given arg and the text to split
as last argument. This call must return a valid tcl list,
which elements are tested..
.PP
The default in case no split type argument is given is
\&\fIwhitespace\fR.
.RE
.TP
\&\fB\fBid\fP
\&\fRThis text constraint command marks the text as a
document wide ID (to be referenced by an idref). Every ID
value within a document must be unique. It isn't an error if
the ID isn't actually referenced within the document.
.TP
\&\fB\fBidref\fP
\&\fRThis text constraint command expects the text to be a
reference to an ID within the document. The referenced ID may
be later in the document, that the reference. Several
references within the document to one ID are possible.
.SH Exampels
.PP
.UR "https://www.w3.org/TR/xmlschema-0/"
<URL: https://www.w3.org/TR/xmlschema-0/>
.UE
The XML Schema Part 0: Primer Second Edition
() starts with this

Changes to doc/schema.xml.

353
354
355
356
357
358
359
360

361
362
363
364
365
366
367
...
461
462
463
464
465
466
467














468
469
470
471
472
473
474
      <commanddef>
        <command><cmd>isint</cmd></command>
        <desc></desc>
      </commanddef>

      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc></desc>

      </commanddef>
      
      <commanddef>
        <command><cmd>tcl</cmd> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the tcl script <m>tclcmd arg arg ... </m> and
        the text to validate appended to the argument list. The return
        value of the tcl command is interpreted as a boolean.</desc>
................................................................................
            level, appended with every given arg and the text to split
            as last argument. This call must return a valid tcl list,
            which elements are tested..</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <m>whitespace</m>.</p></desc>
      </commanddef>














    </commandlist>
  </section>
  
  <section>
    <title>Exampels</title>

    <p>The XML Schema Part 0: Primer Second Edition






|
>







 







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







353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
...
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
      <commanddef>
        <command><cmd>isint</cmd></command>
        <desc></desc>
      </commanddef>

      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc>The text constraint only matches if the text value is
        string equal to the given value.</desc>
      </commanddef>
      
      <commanddef>
        <command><cmd>tcl</cmd> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the tcl script <m>tclcmd arg arg ... </m> and
        the text to validate appended to the argument list. The return
        value of the tcl command is interpreted as a boolean.</desc>
................................................................................
            level, appended with every given arg and the text to split
            as last argument. This call must return a valid tcl list,
            which elements are tested..</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <m>whitespace</m>.</p></desc>
      </commanddef>
      <commanddef>
        <command><cmd>id</cmd></command>
        <desc>This text constraint command marks the text as a
        document wide ID (to be referenced by an idref). Every ID
        value within a document must be unique. It isn't an error if
        the ID isn't actually referenced within the document.</desc>
      </commanddef>
      <commanddef>
        <command><cmd>idref</cmd></command>
        <desc>This text constraint command expects the text to be a
        reference to an ID within the document. The referenced ID may
        be later in the document, that the reference. Several
        references within the document to one ID are possible.</desc>
      </commanddef>
    </commandlist>
  </section>
  
  <section>
    <title>Exampels</title>

    <p>The XML Schema Part 0: Primer Second Edition

Changes to generic/schema.c.

453
454
455
456
457
458
459


460
461
462
463
464
465
466
...
511
512
513
514
515
516
517

518
519
520
521
522
523
524
....
1544
1545
1546
1547
1548
1549
1550
1551

















1552
1553
1554
1555
1556
1557
1558
1559
....
2072
2073
2074
2075
2076
2077
2078






2079
2080
2081
2082
2083
2084
2085
....
4308
4309
4310
4311
4312
4313
4314





















































































4315
4316
4317
4318
4319
4320
4321
....
4396
4397
4398
4399
4400
4401
4402




4403
4404
4405
4406
    sdata->textStub[1] = Tcl_NewStringObj("eval", 4);
    Tcl_IncrRefCount (sdata->textStub[1]);
    sdata->textStub[2] = Tcl_NewStringObj("::tdom::schema::text", 20);
    Tcl_IncrRefCount (sdata->textStub[2]);

    sdata->cdata = TMALLOC (Tcl_DString);
    Tcl_DStringInit (sdata->cdata);


    return sdata;
}

static void schemaInstanceDelete (
    ClientData clientData
    )
{
................................................................................
    Tcl_DecrRefCount (sdata->textStub[2]);
    FREE (sdata->textStub);
    Tcl_DStringFree (sdata->cdata);
    FREE (sdata->cdata);
    if (sdata->reportCmd) {
        Tcl_DecrRefCount (sdata->reportCmd);
    }

    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from
................................................................................
        popStack (sdata);
        rc = checkElementEnd (interp, sdata);
    }

    if (rc) {
        popStack (sdata);
        if (sdata->stack == NULL) {
            /* End of the first pattern (the tree root) without error.

















               We have successfully ended validation */
            sdata->validationState = VALIDATION_FINISHED;
        }
        DBG(
            fprintf(stderr, "probeElementEnd: _CAN_ end here.\n");
            serializeStack (sdata);
            );
        return TCL_OK;
................................................................................
    SchemaData *sdata
    )
{
    while (sdata->stack) popStack (sdata);
    sdata->validationState = VALIDATION_READY;
    sdata->skipDeep = 0;
    sdata->evalError = 0;






}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
................................................................................
        }
        tcdata->sdata = sdata;
        tcdata->cp = cp;
        sc->constraintData = tcdata;
    }
    return TCL_OK;
}






















































































void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          oneOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::allOf",
                          allOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::strip",
                          stripTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::split",
                          splitTCObjCmd, NULL, NULL);




}


#endif  /* #ifndef TDOM_NO_SCHEMA */






>
>







 







>







 







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|







 







>
>
>
>
>
>







 







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







 







>
>
>
>




453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
...
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
....
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
....
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
....
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
....
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
    sdata->textStub[1] = Tcl_NewStringObj("eval", 4);
    Tcl_IncrRefCount (sdata->textStub[1]);
    sdata->textStub[2] = Tcl_NewStringObj("::tdom::schema::text", 20);
    Tcl_IncrRefCount (sdata->textStub[2]);

    sdata->cdata = TMALLOC (Tcl_DString);
    Tcl_DStringInit (sdata->cdata);
    Tcl_InitHashTable (&sdata->ids, TCL_STRING_KEYS);
    sdata->unknownIDrefs = 0;
    return sdata;
}

static void schemaInstanceDelete (
    ClientData clientData
    )
{
................................................................................
    Tcl_DecrRefCount (sdata->textStub[2]);
    FREE (sdata->textStub);
    Tcl_DStringFree (sdata->cdata);
    FREE (sdata->cdata);
    if (sdata->reportCmd) {
        Tcl_DecrRefCount (sdata->reportCmd);
    }
    Tcl_DeleteHashTable (&sdata->ids);
    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from
................................................................................
        popStack (sdata);
        rc = checkElementEnd (interp, sdata);
    }

    if (rc) {
        popStack (sdata);
        if (sdata->stack == NULL) {
            /* End of the first pattern (the tree root) without error. */
            /* Check for unknown ID references */
            if (sdata->unknownIDrefs) {
                Tcl_HashEntry *h;
                Tcl_HashSearch search;
                SetResult ("References to unknown IDs:");
                for (h = Tcl_FirstHashEntry (&sdata->ids, &search);
                     h != NULL;
                     h = Tcl_NextHashEntry (&search)) {
                    if (Tcl_GetHashValue (h) == 0) {
                        Tcl_AppendResult (interp, " '",
                                          Tcl_GetHashKey (&sdata->ids, h),
                                          "'", NULL);
                    }
                }
                sdata->validationState = VALIDATION_ERROR;
                return TCL_ERROR;
            }
            /*  We have successfully ended validation */
            sdata->validationState = VALIDATION_FINISHED;
        }
        DBG(
            fprintf(stderr, "probeElementEnd: _CAN_ end here.\n");
            serializeStack (sdata);
            );
        return TCL_OK;
................................................................................
    SchemaData *sdata
    )
{
    while (sdata->stack) popStack (sdata);
    sdata->validationState = VALIDATION_READY;
    sdata->skipDeep = 0;
    sdata->evalError = 0;
    Tcl_DStringSetLength (sdata->cdata, 0);
    if (sdata->ids.numEntries) {
        Tcl_DeleteHashTable (&sdata->ids);
        Tcl_InitHashTable (&sdata->ids, TCL_STRING_KEYS);
        sdata->unknownIDrefs = 0;
    }
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
................................................................................
        }
        tcdata->sdata = sdata;
        tcdata->cp = cp;
        sc->constraintData = tcdata;
    }
    return TCL_OK;
}

static int
idImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaData *sdata = (SchemaData *) constraintData;
    int hnew;
    Tcl_HashEntry *h;

    h = Tcl_CreateHashEntry (&sdata->ids, text, &hnew);
    if (hnew) {
        Tcl_SetHashValue (h, 1);
        return 1;
    }
    if (Tcl_GetHashValue (h) == 0) {
        Tcl_SetHashValue (h, 1);
        sdata->unknownIDrefs--;
        return 1;
    } else {
        /* Duplicate ID value */
        return 0;
    }
}

static int
idTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaConstraint *sc;

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,1,"no argument expected");
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = idImpl;
    sc->constraintData = (void *)sdata;
    return TCL_OK;
}

static int
idrefImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaData *sdata = (SchemaData *) constraintData;
    int hnew;
    Tcl_HashEntry *h;

    h = Tcl_CreateHashEntry (&sdata->ids, text, &hnew);
    if (hnew) {
        Tcl_SetHashValue (h, 0);
        sdata->unknownIDrefs++;
    }
    return 1;
}

static int
idrefTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaConstraint *sc;

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,1,"no argument expected");
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = idrefImpl;
    sc->constraintData = (void *)sdata;
    return TCL_OK;
}

void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          oneOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::allOf",
                          allOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::strip",
                          stripTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::split",
                          splitTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::id",
                          idTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::idref",
                          idrefTCObjCmd, NULL, NULL);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to generic/schema.h.

139
140
141
142
143
144
145


146
147
148
149
150
151
152
    unsigned int numReqAttr;
    unsigned int attrSize;
    SchemaValidationStack *stack;
    SchemaValidationStack *stackPool;
    ValidationState validationState;
    unsigned int skipDeep;
    Tcl_DString *cdata;


} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,






>
>







139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    unsigned int numReqAttr;
    unsigned int attrSize;
    SchemaValidationStack *stack;
    SchemaValidationStack *stackPool;
    ValidationState validationState;
    unsigned int skipDeep;
    Tcl_DString *cdata;
    Tcl_HashTable ids;
    int unknownIDrefs;
} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,

Changes to tests/schema.test.

3353
3354
3355
3356
3357
3358
3359






























































3360
3361
3362
3363
3364
3365
3366
    } {
        incr schema-14.24a
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0}































































test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b






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







3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
    } {
        incr schema-14.24a
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0}

test schema-14.25 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
            }
        }
        defelement id {text id}
        defelement idref {text idref}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><id>abc</id></doc>
        <doc><idref>abc</idref></doc>
        <doc><id>abc</id><idref>abc</idref></doc>
        <doc><idref>abc</idref><id>abc</id></doc>
        <doc><idref>abc</idref><idref>abc</idref><id>abc</id></doc>
        <doc><id>abc</id><idref>abc</idref><idref>abc</idref></doc>
        {<doc><id>abc</id><idref>abc</idref><idref>ab c</idref></doc>}
        <doc><id>abc</id><idref>abc</idref><id>abc</id></doc>
        <doc><idref>abc</idref><idref>123</idref></doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 1 1 1 1 0 0 0}

test schema-14.26 {attribute id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
            }
        }
        defelement id {attribute id id}
        defelement idref {attribute idref idref}
    }
    set result [list]
    foreach xml {
        <doc/>
        {<doc><id id="abc"/></doc>}
        {<doc><idref idref="abc"/></doc>}
        {<doc><id id="abc"/><idref idref="abc"/></doc>}
        {<doc><idref idref="abc"/><id id="abc"/></doc>}
        {<doc><idref idref="abc"/><idref idref="abc"/><id id="abc"/></doc>}
        {<doc><id id="abc"/><idref idref="abc"/><idref idref="abc"/></doc>}
        {<doc><id id="abc"/><idref idref="abc"/><idref idref="ab c"/></doc>}
        {<doc><id id="abc"/><idref idref="abc"/><id id="abc"/></doc>}
        {<doc><idref idref="abc"/><idref idref="123"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 1 1 1 1 0 0 0}

test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b