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

Overview
Comment:Changed the "tcl" schema constraint command: it just evaluates the given arguments without appending the schema command to the argument list. Added new "self" schema constraint command, which returns the schema command.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: 7ecc6a8e29f80b6dd8f57c6cab86c21d463e6e69283bf00204cb85bf2d4aee5f
User & Date: rolf 2020-02-27 16:53:07
Context
2020-03-03
22:00
Added a test. check-in: b9dfbb4aa1 user: rolf tags: schema
2020-02-27
16:53
Changed the "tcl" schema constraint command: it just evaluates the given arguments without appending the schema command to the argument list. Added new "self" schema constraint command, which returns the schema command. check-in: 7ecc6a8e29 user: rolf tags: schema
15:11
Fixed build breaking typo in last commit. check-in: 2de9f383a8 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

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
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
597
598
599
600
601
602
603
604
605
606
607
608
609

610
611





612
613
614
615
616
617
618
...
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
...
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
....
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
....
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
....
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
<html>
<head>
<link rel="stylesheet" href="manpage.css"><title>tDOM manual: schema</title><meta name="xsl-processor" content="Jochen Loewer (loewerj@hotmail.com), Rolf Ade (rolf@pointsman.de) 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="#SECTid0x564e46da0910">NAME</a> · <a href="#SECTid0x564e46d0dab0">SYNOPSIS</a> · <a href="#SECTid0x564e46d97810">DESCRIPTION </a> · <a href="#SECTid0x564e46dfc020">Schema definition scripts</a> · <a href="#SECTid0x564e46e0a5c0">Quantity specifier</a> · <a href="#SECTid0x564e46e0c410">Text constraint scripts</a> · <a href="#SECTid0x564e46e1a490">Local key constraints</a> · <a href="#SECTid0x564e46e1c2a0">Exampels</a> · <a href="#SECTid0x564e46e1e220">KEYWORDS</a>
</div><hr class="navsep">
</div><div class="body">
  <h2><a name="SECTid0x564e46da0910">NAME</a></h2><p class="namesection">
<b class="names">tdom::schema - </b><br>Create a schema validation command</p>

  <h2><a name="SECTid0x564e46d0dab0">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="SECTid0x564e46d97810">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 data or to post-validate a tDOM DOM tree (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="SECTid0x564e46dfc020">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 qualify the content as valid. It is a
    validation error if there is additional (not matched) content.</p><p>The schema definition commands are:</p><dl class="commandlist">
      
................................................................................
        element will be in that namespace.</dd>
      

      
        <dt>
<b class="method">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
        the schema command appended to the argument list. This
        validation command is only allowed in strict sequential
        context (not in choice, mixed and interleave). If the return
        code is something else than 0 (TCL_OK) then this is a
        validation error.</dd>

      






      
        <dt>
<b class="method">associate</b> <i class="m">data</i>
</dt>
        <dd>This command is only allowed top-level inside the
        definition scripts of the element, elementtype, pattern or
        interleave content particle. Associate the as argument given
................................................................................
        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="SECTid0x564e46e0a5c0">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.</dd>
................................................................................
        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="SECTid0x564e46e0c410">Text constraint scripts</a></h2><p>Text - parsed character data, as XML calles it - must sometimes
    be of a certain kind, must comply to some rules etc to be valid.
    The text constraint script arguments to the text, attribute,
    nsattribute and deftext commands allow the following text
    constraint commands to check text for certain properties.</p><p>The text constraint commands are:</p><dl class="commandlist">
      
        <dt>
<b class="cmd">integer</b> <i class="m">?(xsd|tcl)?</i>
................................................................................
        <dd>This text constraint match if the text value is a
        xsd:unsignedLong. This is an integer between 0 and
        18446744073709551615, both included, optionally preceded by a
        + sign and leading zeros.</dd>
      
    </dl>

  <h2><a name="SECTid0x564e46e1a490">Local key constraints</a></h2><p>Document wide uniqueness and foreign key constraints are
    available with the text constraint commands id and idref.
    Keyspaces allow for sub-tree local uniqueness and foreign key
    constraints.</p><dl class="commandlist">
        
            <dt>
<b class="cmd">keyspace</b> <i class="m">&lt;names list&gt;</i> <i class="m">&lt;constraint script&gt;</i>
</dt>
................................................................................
            active always matches. If the keyspace is active then
            reports error if there is still no key as the value at the
            end of the keyspace <i class="m">&lt;name&gt;</i>. Otherwise it
            matches.</dd>
        
    </dl>

  <h2><a name="SECTid0x564e46e1c2a0">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.
................................................................................
    foreach e {name email} {
        defelement $e {text}
    }
}
      
    </pre>

<h2><a name="SECTid0x564e46e1e220">KEYWORDS</a></h2><p class="keywords">
<a class="keyword" href="keyword-index.html#KW-Validation">Validation</a>, <a class="keyword" href="keyword-index.html#KW-Postvalidation">Postvalidation</a>, <a class="keyword" href="keyword-index.html#KW-DOM">DOM</a>, <a class="keyword" href="keyword-index.html#KW-SAX">SAX</a>
</p>
</div><hr class="navsep"><div class="navbar" align="center">
<a class="navaid" href="index.html">Contents</a> · <a class="navaid" href="category-index.html">Index</a> · <a class="navaid" href="keyword-index.html">Keywords</a> · <a class="navaid" href="http://tdom.org">Repository</a>
</div>
</body>
</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
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
597
598
599
600
601
602
603
604

605
606
607

608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
...
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
...
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
....
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
....
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
....
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
<html>
<head>
<link rel="stylesheet" href="manpage.css"><title>tDOM manual: schema</title><meta name="xsl-processor" content="Jochen Loewer (loewerj@hotmail.com), Rolf Ade (rolf@pointsman.de) 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="#SECTid0x564487ad5910">NAME</a> · <a href="#SECTid0x564487a430c0">SYNOPSIS</a> · <a href="#SECTid0x564487acc7b0">DESCRIPTION </a> · <a href="#SECTid0x564487b31040">Schema definition scripts</a> · <a href="#SECTid0x564487b3f9a0">Quantity specifier</a> · <a href="#SECTid0x564487b417f0">Text constraint scripts</a> · <a href="#SECTid0x564487b4f870">Local key constraints</a> · <a href="#SECTid0x564487b51680">Exampels</a> · <a href="#SECTid0x564487b53600">KEYWORDS</a>
</div><hr class="navsep">
</div><div class="body">
  <h2><a name="SECTid0x564487ad5910">NAME</a></h2><p class="namesection">
<b class="names">tdom::schema - </b><br>Create a schema validation command</p>

  <h2><a name="SECTid0x564487a430c0">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="SECTid0x564487acc7b0">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 data or to post-validate a tDOM DOM tree (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="SECTid0x564487b31040">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 qualify the content as valid. It is a
    validation error if there is additional (not matched) content.</p><p>The schema definition commands are:</p><dl class="commandlist">
      
................................................................................
        element will be in that namespace.</dd>
      

      
        <dt>
<b class="method">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>. This

        validation command is only allowed in strict sequential
        context (not in choice, mixed and interleave). If the return
        code is something else than 0 (TCL_OK) then this is an

        error (which isn't catched and reported by reportcmd).</dd>
      

      
        <dt><b class="method">self</b></dt>
        <dd>Returns the schema command.</dd>
      
      
      
        <dt>
<b class="method">associate</b> <i class="m">data</i>
</dt>
        <dd>This command is only allowed top-level inside the
        definition scripts of the element, elementtype, pattern or
        interleave content particle. Associate the as argument given
................................................................................
        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="SECTid0x564487b3f9a0">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.</dd>
................................................................................
        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="SECTid0x564487b417f0">Text constraint scripts</a></h2><p>Text - parsed character data, as XML calles it - must sometimes
    be of a certain kind, must comply to some rules etc to be valid.
    The text constraint script arguments to the text, attribute,
    nsattribute and deftext commands allow the following text
    constraint commands to check text for certain properties.</p><p>The text constraint commands are:</p><dl class="commandlist">
      
        <dt>
<b class="cmd">integer</b> <i class="m">?(xsd|tcl)?</i>
................................................................................
        <dd>This text constraint match if the text value is a
        xsd:unsignedLong. This is an integer between 0 and
        18446744073709551615, both included, optionally preceded by a
        + sign and leading zeros.</dd>
      
    </dl>

  <h2><a name="SECTid0x564487b4f870">Local key constraints</a></h2><p>Document wide uniqueness and foreign key constraints are
    available with the text constraint commands id and idref.
    Keyspaces allow for sub-tree local uniqueness and foreign key
    constraints.</p><dl class="commandlist">
        
            <dt>
<b class="cmd">keyspace</b> <i class="m">&lt;names list&gt;</i> <i class="m">&lt;constraint script&gt;</i>
</dt>
................................................................................
            active always matches. If the keyspace is active then
            reports error if there is still no key as the value at the
            end of the keyspace <i class="m">&lt;name&gt;</i>. Otherwise it
            matches.</dd>
        
    </dl>

  <h2><a name="SECTid0x564487b51680">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.
................................................................................
    foreach e {name email} {
        defelement $e {text}
    }
}
      
    </pre>

<h2><a name="SECTid0x564487b53600">KEYWORDS</a></h2><p class="keywords">
<a class="keyword" href="keyword-index.html#KW-Validation">Validation</a>, <a class="keyword" href="keyword-index.html#KW-Postvalidation">Postvalidation</a>, <a class="keyword" href="keyword-index.html#KW-DOM">DOM</a>, <a class="keyword" href="keyword-index.html#KW-SAX">SAX</a>
</p>
</div><hr class="navsep"><div class="navbar" align="center">
<a class="navaid" href="index.html">Contents</a> · <a class="navaid" href="category-index.html">Index</a> · <a class="navaid" href="keyword-index.html">Keywords</a> · <a class="navaid" href="http://tdom.org">Repository</a>
</div>
</body>
</html>

Changes to doc/schema.n.

635
636
637
638
639
640
641
642
643
644
645
646

647


648
649
650
651
652
653
654
\&\fB\fBnamespace\fP \fIuri\fB \fI<definition script>\fB
\&\fREvaluates the \fIdefinition script\fR with context
namespace \fIuri\fR. Every element or ref command name will
be looked up in the namespace \fIuri\fR and local defined
element will be in that namespace.
.TP
\&\fB\fBtcl\fP \fItclcmd\fB \fI?arg arg ...?\fB
\&\fREvaluates the Tcl script \fItclcmd arg arg ... \fR and
the schema command appended to the argument list. This
validation command is only allowed in strict sequential
context (not in choice, mixed and interleave). If the return
code is something else than 0 (TCL_OK) then this is a

validation error.


.TP
\&\fB\fBassociate\fP \fIdata\fB
\&\fRThis command is only allowed top-level inside the
definition scripts of the element, elementtype, pattern or
interleave content particle. Associate the as argument given
\&\fIdata\fR with the currently defined content particle and
may be requested in scripts evaluated while validating the







|
<


|
>
|
>
>







635
636
637
638
639
640
641
642

643
644
645
646
647
648
649
650
651
652
653
654
655
656
\&\fB\fBnamespace\fP \fIuri\fB \fI<definition script>\fB
\&\fREvaluates the \fIdefinition script\fR with context
namespace \fIuri\fR. Every element or ref command name will
be looked up in the namespace \fIuri\fR and local defined
element will be in that namespace.
.TP
\&\fB\fBtcl\fP \fItclcmd\fB \fI?arg arg ...?\fB
\&\fREvaluates the Tcl script \fItclcmd arg arg ... \fR. This

validation command is only allowed in strict sequential
context (not in choice, mixed and interleave). If the return
code is something else than 0 (TCL_OK) then this is an
error (which isn't catched and reported by reportcmd).
.TP
\&\fB\fBself\fP
\&\fRReturns the schema command.
.TP
\&\fB\fBassociate\fP \fIdata\fB
\&\fRThis command is only allowed top-level inside the
definition scripts of the element, elementtype, pattern or
interleave content particle. Associate the as argument given
\&\fIdata\fR with the currently defined content particle and
may be requested in scripts evaluated while validating the

Changes to doc/schema.xml.

553
554
555
556
557
558
559
560
561
562
563
564

565




566
567
568
569
570
571
572
573
574
        namespace <m>uri</m>. Every element or ref command name will
        be looked up in the namespace <m>uri</m> and local defined
        element will be in that namespace.</desc>
      </commanddef>

      <commanddef>
        <command><method>tcl</method> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the Tcl script <m>tclcmd arg arg ... </m> and
        the schema command appended to the argument list. This
        validation command is only allowed in strict sequential
        context (not in choice, mixed and interleave). If the return
        code is something else than 0 (TCL_OK) then this is a

        validation error.</desc>




      </commanddef>

      <commanddef>
        <command><method>associate</method> <m>data</m></command>
        <desc>This command is only allowed top-level inside the
        definition scripts of the element, elementtype, pattern or
        interleave content particle. Associate the as argument given
        <m>data</m> with the currently defined content particle and
        may be requested in scripts evaluated while validating the







|
<


|
>
|
>
>
>
>

|







553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
        namespace <m>uri</m>. Every element or ref command name will
        be looked up in the namespace <m>uri</m> and local defined
        element will be in that namespace.</desc>
      </commanddef>

      <commanddef>
        <command><method>tcl</method> <m>tclcmd</m> <m>?arg arg ...?</m></command>
        <desc>Evaluates the Tcl script <m>tclcmd arg arg ... </m>. This

        validation command is only allowed in strict sequential
        context (not in choice, mixed and interleave). If the return
        code is something else than 0 (TCL_OK) then this is an
        error (which isn't catched and reported by reportcmd).</desc>
      </commanddef>

      <commanddef>
        <command><method>self</method></command>
        <desc>Returns the schema command.</desc>
      </commanddef>
      
      <commanddef>
        <command><method>associate</method> <m>data</m></command>
        <desc>This command is only allowed top-level inside the
        definition scripts of the element, elementtype, pattern or
        interleave content particle. Associate the as argument given
        <m>data</m> with the currently defined content particle and
        may be requested in scripts evaluated while validating the

Changes to generic/schema.c.

511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
....
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
....
5364
5365
5366
5367
5368
5369
5370
5371
5372
5373
5374

5375
5376
5377
5378
5379
5380
5381




















5382
5383
5384
5385
5386
5387
5388
....
7478
7479
7480
7481
7482
7483
7484
7485
7486
7487


7488
7489
7490
7491
7492
7493
7494
    SchemaConstraint *sc;

    switch (pattern->type) {
    case SCHEMA_CTYPE_ANY:
        /* do nothing */
        break;
    case SCHEMA_CTYPE_VIRTUAL:
        for (i = 0; i < pattern->nc - 1; i++) {
            Tcl_DecrRefCount ((Tcl_Obj *)pattern->content[i]);
        }
        FREE (pattern->content);
        break;
    case SCHEMA_CTYPE_TEXT:
        for (i = 0; i < pattern->nc; i++) {
            sc = (SchemaConstraint *) pattern->content[i];
................................................................................
    int ac
    )
{
    int rc;
    SchemaCP *cp;

    cp = sdata->stack->pattern->content[ac];
    cp->content[cp->nc-1] = (SchemaCP *) sdata->self;
    sdata->currentEvals++;
    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);
    sdata->currentEvals--;
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
................................................................................
                   "allowed in sequential context (defelement, "
                   "element, group or defpattern)");
        return TCL_ERROR;
    }

    pattern = initSchemaCP (SCHEMA_CTYPE_VIRTUAL, NULL, NULL);
    REMEMBER_PATTERN (pattern)
    /* We alloc for one arugment more: the always appended schema
     * cmd. */
    pattern->content = MALLOC (sizeof (Tcl_Obj*) * (objc));
    for (i = 1; i < objc; i++) {

        pattern->content[i-1] = (SchemaCP *) objv[i];
        Tcl_IncrRefCount (objv[i]);
    }
    pattern->nc = objc;
    addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    return TCL_OK;
}





















static int
domuniquePatternObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
................................................................................
    Tcl_CreateObjCommand (interp, "tdom::schema::nsattribute",
                          AttributePatternObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::namespace",
                          NamespacePatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text",
                          TextPatternObjCmd, NULL, NULL);

    /* The 'virtual' "tcl" definition command */
    Tcl_CreateObjCommand (interp, "tdom::schema::tcl",
                          VirtualPatternObjCmd, NULL, NULL);



    /* XPath contraints for DOM validation */
    Tcl_CreateObjCommand (interp,"tdom::schema::domunique",
                          domuniquePatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::domxpathboolean",
                          domxpathbooleanPatternObjCmd, NULL, NULL);








|







 







<







 







<
<
|
<
>
|
|

|



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







 







|


>
>







511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
....
1170
1171
1172
1173
1174
1175
1176

1177
1178
1179
1180
1181
1182
1183
....
5363
5364
5365
5366
5367
5368
5369


5370

5371
5372
5373
5374
5375
5376
5377
5378
5379
5380
5381
5382
5383
5384
5385
5386
5387
5388
5389
5390
5391
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
....
7495
7496
7497
7498
7499
7500
7501
7502
7503
7504
7505
7506
7507
7508
7509
7510
7511
7512
7513
    SchemaConstraint *sc;

    switch (pattern->type) {
    case SCHEMA_CTYPE_ANY:
        /* do nothing */
        break;
    case SCHEMA_CTYPE_VIRTUAL:
        for (i = 0; i < pattern->nc; i++) {
            Tcl_DecrRefCount ((Tcl_Obj *)pattern->content[i]);
        }
        FREE (pattern->content);
        break;
    case SCHEMA_CTYPE_TEXT:
        for (i = 0; i < pattern->nc; i++) {
            sc = (SchemaConstraint *) pattern->content[i];
................................................................................
    int ac
    )
{
    int rc;
    SchemaCP *cp;

    cp = sdata->stack->pattern->content[ac];

    sdata->currentEvals++;
    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);
    sdata->currentEvals--;
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
................................................................................
                   "allowed in sequential context (defelement, "
                   "element, group or defpattern)");
        return TCL_ERROR;
    }

    pattern = initSchemaCP (SCHEMA_CTYPE_VIRTUAL, NULL, NULL);
    REMEMBER_PATTERN (pattern)


    pattern->content = MALLOC (sizeof (Tcl_Obj*) * (objc-1));

    for (i = 0; i < objc-1; i++) {
        pattern->content[i] = (SchemaCP *) objv[i+1];
        Tcl_IncrRefCount (objv[i+1]);
    }
    pattern->nc = objc-1;
    addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    return TCL_OK;
}

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

    CHECK_SI
    CHECK_TOPLEVEL
    if (objc != 1) {
        SetResult ("No argument expected");
        return TCL_ERROR;
    }
    Tcl_SetObjResult (interp, Tcl_DuplicateObj (sdata->self));
    return TCL_OK;
}

static int
domuniquePatternObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
................................................................................
    Tcl_CreateObjCommand (interp, "tdom::schema::nsattribute",
                          AttributePatternObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::namespace",
                          NamespacePatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text",
                          TextPatternObjCmd, NULL, NULL);

    /* The 'virtual' "tcl" and the "self" definition command */
    Tcl_CreateObjCommand (interp, "tdom::schema::tcl",
                          VirtualPatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::self",
                          SelfObjCmd, NULL, NULL);

    /* XPath contraints for DOM validation */
    Tcl_CreateObjCommand (interp,"tdom::schema::domunique",
                          domuniquePatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::domxpathboolean",
                          domxpathbooleanPatternObjCmd, NULL, NULL);

Changes to tests/schema.test.

1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
....
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
....
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
....
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
....
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
....
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
....
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
....
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
....
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
....
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
....
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
....
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
    lappend result $errMsg
}

test schema-4.4 {event on itself in called script} {
    tdom::schema s
    s defelement doc {
        element a ?
        tcl schema-4.4
        element b ?
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/></doc>
        <doc><a/><b/></doc>
................................................................................
    $scmd event start foo
}

test schema-4.5 {event on itself in called script} {
    tdom::schema s
    s defelement doc {
        element a ?
        tcl schema-4.5
        element b ?
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/></doc>
        <doc><a/><b/></doc>
................................................................................

proc schema-4.10 {scmd} {
    error "Error raised in schema-4.10"
}
test schema-4.10 {event - tcl error in called script} {
    tdom::schema s
    s defelement doc {
        tcl schema-4.10
        element a
    }
    s event start doc 
    set result [catch {s event start a} errMsg]
    lappend result $errMsg
    s delete
    set result
................................................................................
}
test schema-8.7 {Delete schema cmd in script called by validation} {
    set result ""
    lappend result [info commands s]
    tdom::schema s
    lappend result [info commands s]
    s defelement doc {
        tcl schema-8.7
    }
    lappend result [catch {s validate <doc/>} errMsg]
    lappend result $errMsg
    lappend result [info commands s]
    lappend result [catch {s delete}]
} {{} s {in schema-8.7} 1 {error "this is deliberate" at line 1 character 6} {} 1}

................................................................................
    lappend result ${from_schema-14.44}
} {1 b}

test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b
            tcl append ::schema-15.1
        }
    }
    set ::schema-15.1 ""
    set result [s validate {<a><b/></a>} msg]
    s delete
    lappend result $msg ${::schema-15.1}
    set result
................................................................................
test schema-15.3 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-15.3 astart
            element b ! text
            element c ! text
            tcl schema-15.3 aend
        }
    }
    set schema-15.3 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg {*}${schema-15.3}
    set result
................................................................................
    tdom::schema s
    s define {
        defelement doc {
            ref docContent
        }
        defpattern docContent {
            element a
            tcl schema-15.4 "in docContent"
            text
            element b
        }
    }
    set schema-15.4 ""
    set result [s validate {<doc><a/>foo<b/></doc>}]
    s delete
................................................................................
test schema-17.9 {info expected from scripted constrain} {
    tdom::schema s
    s define {
        defpattern some {
            element a ?
            group ? {
                element b ?
                tcl schema-17.9
            }
            element c
        }
        defelement doc {
            ref some ?
            element may ?
            element must
................................................................................
    set defs {
        {
            group + {
                element c ?
                element a ?
                element b ?
            }
            tcl schema-17.14
            element d
        }
    }
    set result [list]
    foreach def $defs {
        tdom::schema s
        s reportcmd schema-17.14
................................................................................
test schema-17.15 {info inside} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-17.15 astart
            element b ! text
            element c ! text
            tcl schema-17.15 aend
        }
    }
    set result {}
    s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
    s delete
    set result
} {astart {a doc} aend {a doc} astart {a doc} aend {a doc}}
................................................................................
test schema-17.19 {info stack associated} {
    tdom::schema s
    s defelement doc {
        element a +
    }
    s defelement a {
        associate "fo bar baz"
        tcl schema-17.19
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><a/></doc>
    } {
        lappend result [s validate $xml]
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 s INVALID_KEYREF 1 s INVALID_KEYREF 1}

proc log19.4 {msg scmd} {
    lappend ::result $msg
}
proc report19.4 {scmd errortype} {
    lappend ::result $errortype
}
test schema-19.4 {keyspace w/ recover} {
    tdom::schema s







|







 







|







 







|







 







|







 







|

|







 







|


|







 







|







 







|







 







|







 







|


|







 







|







 







|







1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
....
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
....
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
....
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
....
5392
5393
5394
5395
5396
5397
5398
5399
5400
5401
5402
5403
5404
5405
5406
5407
5408
....
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
....
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
....
6213
6214
6215
6216
6217
6218
6219
6220
6221
6222
6223
6224
6225
6226
6227
....
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
....
6398
6399
6400
6401
6402
6403
6404
6405
6406
6407
6408
6409
6410
6411
6412
6413
6414
6415
....
6629
6630
6631
6632
6633
6634
6635
6636
6637
6638
6639
6640
6641
6642
6643
....
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
    lappend result $errMsg
}

test schema-4.4 {event on itself in called script} {
    tdom::schema s
    s defelement doc {
        element a ?
        tcl schema-4.4 [self]
        element b ?
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/></doc>
        <doc><a/><b/></doc>
................................................................................
    $scmd event start foo
}

test schema-4.5 {event on itself in called script} {
    tdom::schema s
    s defelement doc {
        element a ?
        tcl schema-4.5 [self]
        element b ?
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/></doc>
        <doc><a/><b/></doc>
................................................................................

proc schema-4.10 {scmd} {
    error "Error raised in schema-4.10"
}
test schema-4.10 {event - tcl error in called script} {
    tdom::schema s
    s defelement doc {
        tcl schema-4.10 [self]
        element a
    }
    s event start doc 
    set result [catch {s event start a} errMsg]
    lappend result $errMsg
    s delete
    set result
................................................................................
}
test schema-8.7 {Delete schema cmd in script called by validation} {
    set result ""
    lappend result [info commands s]
    tdom::schema s
    lappend result [info commands s]
    s defelement doc {
        tcl schema-8.7 [self]
    }
    lappend result [catch {s validate <doc/>} errMsg]
    lappend result $errMsg
    lappend result [info commands s]
    lappend result [catch {s delete}]
} {{} s {in schema-8.7} 1 {error "this is deliberate" at line 1 character 6} {} 1}

................................................................................
    lappend result ${from_schema-14.44}
} {1 b}

test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1 [self]
            element b
            tcl append ::schema-15.1 [self]
        }
    }
    set ::schema-15.1 ""
    set result [s validate {<a><b/></a>} msg]
    s delete
    lappend result $msg ${::schema-15.1}
    set result
................................................................................
test schema-15.3 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-15.3 astart [self]
            element b ! text
            element c ! text
            tcl schema-15.3 aend [self]
        }
    }
    set schema-15.3 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg {*}${schema-15.3}
    set result
................................................................................
    tdom::schema s
    s define {
        defelement doc {
            ref docContent
        }
        defpattern docContent {
            element a
            tcl schema-15.4 "in docContent" [self]
            text
            element b
        }
    }
    set schema-15.4 ""
    set result [s validate {<doc><a/>foo<b/></doc>}]
    s delete
................................................................................
test schema-17.9 {info expected from scripted constrain} {
    tdom::schema s
    s define {
        defpattern some {
            element a ?
            group ? {
                element b ?
                tcl schema-17.9 [self]
            }
            element c
        }
        defelement doc {
            ref some ?
            element may ?
            element must
................................................................................
    set defs {
        {
            group + {
                element c ?
                element a ?
                element b ?
            }
            tcl schema-17.14 [self]
            element d
        }
    }
    set result [list]
    foreach def $defs {
        tdom::schema s
        s reportcmd schema-17.14
................................................................................
test schema-17.15 {info inside} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-17.15 astart [self]
            element b ! text
            element c ! text
            tcl schema-17.15 aend [self]
        }
    }
    set result {}
    s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
    s delete
    set result
} {astart {a doc} aend {a doc} astart {a doc} aend {a doc}}
................................................................................
test schema-17.19 {info stack associated} {
    tdom::schema s
    s defelement doc {
        element a +
    }
    s defelement a {
        associate "fo bar baz"
        tcl schema-17.19 [self]
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><a/></doc>
    } {
        lappend result [s validate $xml]
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 s INVALID_KEYREF 1 s INVALID_KEYREF 1}

proc log19.4 {msg} {
    lappend ::result $msg
}
proc report19.4 {scmd errortype} {
    lappend ::result $errortype
}
test schema-19.4 {keyspace w/ recover} {
    tdom::schema s