tDOM

Check-in [dc36b35000]
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:Merge from schema.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | localkey
Files: files | file ages | folders
SHA3-256: dc36b35000fdc3d28f52c37ba82054934b936fa1e153926d60e3681ad81ff746
User & Date: rolf 2019-05-14 20:04:30
Context
2019-05-15
00:16
Enhanced the unique schema contraint: the fields argument is now expected to be a proper tcl list with their elements as the field XPath expressions. check-in: abc0715900 user: rolf tags: localkey
2019-05-14
20:04
Merge from schema. check-in: dc36b35000 user: rolf tags: localkey
20:02
Enhanced the text constraint commands id/idref: Beside the one doc wide ID space there are now additional other named doc wide ID/IDREF spaces possible. Each of them work along the unnamed doc wide ID space. check-in: 6b550b98f8 user: rolf tags: schema
2019-05-11
01:41
Save work. check-in: 3ce85f17a5 user: rolf tags: localkey
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

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
490
491

492
493
494
495
496
497
498
499
500
501



502
503
504
505
506
507
508
...
552
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
....
1553
1554
1555
1556
1557
1558
1559


























































1560
1561
1562
1563
1564
1565
1566
....
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
....
2134
2135
2136
2137
2138
2139
2140




2141
2142
2143
2144
2145
2146
2147
2148
2149












2150
2151
2152
2153
2154
2155
2156
....
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
....
4587
4588
4589
4590
4591
4592
4593

























4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604



4605
4606
4607
4608
4609

4610
4611














4612
4613
4614
4615
4616
4617
4618
....
4626
4627
4628
4629
4630
4631
4632



















4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643



4644
4645
4646
4647
4648

4649
4650














4651
4652
4653
4654
4655
4656
4657
    sdata->patternList = (SchemaCP **) MALLOC (
        sizeof (SchemaCP*) * ANON_PATTERN_ARRAY_SIZE_INIT);
    sdata->patternListSize = ANON_PATTERN_ARRAY_SIZE_INIT;
    sdata->quants = (SchemaQuant *) MALLOC (
        sizeof (SchemaQuant) * QUANTS_ARRAY_SIZE_INIT);
    sdata->quantsSize = QUANTS_ARRAY_SIZE_INIT;
    /* evalStub initialization */
    sdata->evalStub = (Tcl_Obj **) (MALLOC (sizeof (Tcl_Obj*) * 4));
    sdata->evalStub[0] = Tcl_NewStringObj("::namespace", 11);
    Tcl_IncrRefCount (sdata->evalStub[0]);
    sdata->evalStub[1] = Tcl_NewStringObj("eval", 4);
    Tcl_IncrRefCount (sdata->evalStub[1]);
    sdata->evalStub[2] = Tcl_NewStringObj("::tdom::schema", 14);
    Tcl_IncrRefCount (sdata->evalStub[2]);
    /* textStub initialization */
    sdata->textStub = (Tcl_Obj **) (MALLOC (sizeof (Tcl_Obj*) * 4));
    sdata->textStub[0] = Tcl_NewStringObj("::namespace", 11);
    Tcl_IncrRefCount (sdata->textStub[0]);
    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
    )
{
    SchemaData *sdata = (SchemaData *) clientData;
    unsigned int i;
    SchemaValidationStack *down;




    /* Protect the clientData to be freed inside (even nested)
     * Tcl_Eval*() calls to avoid invalid mem access and postpone the
     * cleanup until the Tcl_Eval*() calls are finished (done in
     * schemaInstanceCmd(). */
    if (sdata->currentEvals) {
        sdata->cleanupAfterEval = 1;
................................................................................
    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
    )
{
    unsigned int i;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *entryPtr;

    SchemaCP *this, *previous, *current;

    for (i = from; i < sdata->numPatternList; i++) {
        this = sdata->patternList[i];
        hashTable = NULL;
        if (this->type == SCHEMA_CTYPE_NAME) {
            hashTable = &sdata->element;
................................................................................
                return 0;
            }
        }
        return -1;
    }
    return 0;
}



























































int
probeElementEnd (
    Tcl_Interp *interp,
    SchemaData *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");
................................................................................
}

void
schemaReset (
    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,
................................................................................
        if (objc != 2-i && objc != 3-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "?prefixUriList?");
            return TCL_ERROR;
        }
        if (!i) {objc--; objv++;}
        result = tcldom_prefixNSlist (&sdata->prefixns, interp, objc, objv,
                                      "prefixns");
        if (sdata->prefix.numBuckets) {
            Tcl_DeleteHashTable (&sdata->prefix);
            Tcl_InitHashTable (&sdata->prefix, TCL_STRING_KEYS);
        }
        if (result == TCL_OK && sdata->prefixns) {
            j = 0;
            while (sdata->prefixns[j]) {
                h1 = Tcl_CreateHashEntry (&sdata->prefix,
................................................................................
        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,
................................................................................
    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;
}

static int
base64Impl (
    Tcl_Interp *interp,
    void *constraintData,






|







|






<




>










>
>
>







 







>
>
>
>
>
>
>
>












>







 







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







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<







 







>
>
>
>









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







 







|







 







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











>
>
>



|

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







 







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











>
>
>



|

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







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
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
...
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
....
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
....
1665
1666
1667
1668
1669
1670
1671
1672













1673
1674
1675
1676
1677
1678
1679
....
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
....
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
....
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
....
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
    sdata->patternList = (SchemaCP **) MALLOC (
        sizeof (SchemaCP*) * ANON_PATTERN_ARRAY_SIZE_INIT);
    sdata->patternListSize = ANON_PATTERN_ARRAY_SIZE_INIT;
    sdata->quants = (SchemaQuant *) MALLOC (
        sizeof (SchemaQuant) * QUANTS_ARRAY_SIZE_INIT);
    sdata->quantsSize = QUANTS_ARRAY_SIZE_INIT;
    /* evalStub initialization */
    sdata->evalStub = (Tcl_Obj **) MALLOC (sizeof (Tcl_Obj*) * 4);
    sdata->evalStub[0] = Tcl_NewStringObj("::namespace", 11);
    Tcl_IncrRefCount (sdata->evalStub[0]);
    sdata->evalStub[1] = Tcl_NewStringObj("eval", 4);
    Tcl_IncrRefCount (sdata->evalStub[1]);
    sdata->evalStub[2] = Tcl_NewStringObj("::tdom::schema", 14);
    Tcl_IncrRefCount (sdata->evalStub[2]);
    /* textStub initialization */
    sdata->textStub = (Tcl_Obj **) MALLOC (sizeof (Tcl_Obj*) * 4);
    sdata->textStub[0] = Tcl_NewStringObj("::namespace", 11);
    Tcl_IncrRefCount (sdata->textStub[0]);
    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;
    Tcl_InitHashTable (&sdata->idTables, TCL_STRING_KEYS);
    return sdata;
}

static void schemaInstanceDelete (
    ClientData clientData
    )
{
    SchemaData *sdata = (SchemaData *) clientData;
    unsigned int i;
    SchemaValidationStack *down;
    Tcl_HashEntry *h;
    Tcl_HashSearch search;
    SchemaDocKey *dk;

    /* Protect the clientData to be freed inside (even nested)
     * Tcl_Eval*() calls to avoid invalid mem access and postpone the
     * cleanup until the Tcl_Eval*() calls are finished (done in
     * schemaInstanceCmd(). */
    if (sdata->currentEvals) {
        sdata->cleanupAfterEval = 1;
................................................................................
    FREE (sdata->textStub);
    Tcl_DStringFree (sdata->cdata);
    FREE (sdata->cdata);
    if (sdata->reportCmd) {
        Tcl_DecrRefCount (sdata->reportCmd);
    }
    Tcl_DeleteHashTable (&sdata->ids);
    for (h = Tcl_FirstHashEntry (&sdata->idTables, &search);
         h != NULL;
         h = Tcl_NextHashEntry (&search)) {
        dk = Tcl_GetHashValue (h);
        Tcl_DeleteHashTable (&dk->ids);
        FREE (dk);
    }
    Tcl_DeleteHashTable (&sdata->idTables);
    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from
    )
{
    unsigned int i;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *entryPtr;

    SchemaCP *this, *previous, *current;

    for (i = from; i < sdata->numPatternList; i++) {
        this = sdata->patternList[i];
        hashTable = NULL;
        if (this->type == SCHEMA_CTYPE_NAME) {
            hashTable = &sdata->element;
................................................................................
                return 0;
            }
        }
        return -1;
    }
    return 0;
}

static int
checkDocKeys (
    Tcl_Interp *interp,
    SchemaData *sdata
    ) 
{
    Tcl_HashEntry *h, *h1;
    Tcl_HashSearch search, search1;
    int haveErrMsg = 0;
    SchemaDocKey *dk;

    if (sdata->unknownIDrefs) {
        haveErrMsg = 1;
        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);
            }
        }
    }
    if (sdata->idTables.numEntries) {
        for (h = Tcl_FirstHashEntry (&sdata->idTables, &search);
             h != NULL;
             h = Tcl_NextHashEntry (&search)) {
            dk = Tcl_GetHashValue (h);
            if (dk->unknownIDrefs) {
                if (haveErrMsg) {
                    Tcl_AppendResult (interp, "\n", NULL);
                } else {
                    haveErrMsg = 1;
                }
                Tcl_AppendResult (interp,
                                  "References to unknown IDs in ID space '",
                                  Tcl_GetHashKey (&sdata->idTables, h),
                                  "':", NULL);
                for (h1 = Tcl_FirstHashEntry (&dk->ids, &search1);
                     h1 != NULL;
                     h1 = Tcl_NextHashEntry (&search1)) {
                    if (Tcl_GetHashValue (h1) == 0) {
                        Tcl_AppendResult (interp, " '",
                                          Tcl_GetHashKey (&dk->ids, h1),
                                          "'", NULL);
                    }
                }
            }
        }
    }
    if (haveErrMsg) {
        sdata->validationState = VALIDATION_ERROR;
        return 0;
    }
    return 1;
}

int
probeElementEnd (
    Tcl_Interp *interp,
    SchemaData *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 (!checkDocKeys (interp, sdata)) {













                return TCL_ERROR;
            }
            /*  We have successfully ended validation */
            sdata->validationState = VALIDATION_FINISHED;
        }
        DBG(
            fprintf(stderr, "probeElementEnd: _CAN_ end here.\n");
................................................................................
}

void
schemaReset (
    SchemaData *sdata
    )
{
    Tcl_HashEntry *h;
    Tcl_HashSearch search;
    SchemaDocKey *dk;
    
    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;
    }
    if (sdata->idTables.numEntries) {
        for (h = Tcl_FirstHashEntry (&sdata->idTables, &search);
             h != NULL;
             h = Tcl_NextHashEntry (&search)) {
            dk = Tcl_GetHashValue (h);
            if (&dk->ids.numEntries) {
                Tcl_DeleteHashTable (&dk->ids);
                Tcl_InitHashTable (&dk->ids, TCL_STRING_KEYS);
                dk->unknownIDrefs = 0;
            }
        }
    }
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
................................................................................
        if (objc != 2-i && objc != 3-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "?prefixUriList?");
            return TCL_ERROR;
        }
        if (!i) {objc--; objv++;}
        result = tcldom_prefixNSlist (&sdata->prefixns, interp, objc, objv,
                                      "prefixns");
        if (sdata->prefix.numEntries) {
            Tcl_DeleteHashTable (&sdata->prefix);
            Tcl_InitHashTable (&sdata->prefix, TCL_STRING_KEYS);
        }
        if (result == TCL_OK && sdata->prefixns) {
            j = 0;
            while (sdata->prefixns[j]) {
                h1 = Tcl_CreateHashEntry (&sdata->prefix,
................................................................................
        sdata->unknownIDrefs--;
        return 1;
    } else {
        /* Duplicate ID value */
        return 0;
    }
}

static int
docidImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaDocKey *dk = (SchemaDocKey *) constraintData;
    int hnew;
    Tcl_HashEntry *h;

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

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

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,2,"?key_space?");
    ADD_CONSTRAINT (sdata, sc)
    if (objc == 1) {
        sc->constraint = idImpl;
        sc->constraintData = (void *)sdata;
    } else {
        h = Tcl_CreateHashEntry (&sdata->idTables, Tcl_GetString (objv[1]),
                                 &hnew);
        if (hnew) {
            dk = TMALLOC (SchemaDocKey);
            Tcl_InitHashTable (&dk->ids, TCL_STRING_KEYS);
            dk->unknownIDrefs = 0;
            Tcl_SetHashValue (h, dk);
        } else {
            dk = Tcl_GetHashValue (h);
        }
        sc->constraint = docidImpl;
        sc->constraintData = (void *)dk;
    }
    return TCL_OK;
}

static int
idrefImpl (
    Tcl_Interp *interp,
    void *constraintData,
................................................................................
    h = Tcl_CreateHashEntry (&sdata->ids, text, &hnew);
    if (hnew) {
        Tcl_SetHashValue (h, 0);
        sdata->unknownIDrefs++;
    }
    return 1;
}

static int
docidrefImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaDocKey *dk = (SchemaDocKey *) constraintData;
    int hnew;
    Tcl_HashEntry *h;

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

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

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,2,"?key_space?");
    ADD_CONSTRAINT (sdata, sc)
    if (objc == 1) {
        sc->constraint = idrefImpl;
        sc->constraintData = (void *)sdata;
    } else {
        h = Tcl_CreateHashEntry (&sdata->idTables, Tcl_GetString (objv[1]),
                                 &hnew);
        if (hnew) {
            dk = TMALLOC (SchemaDocKey);
            Tcl_InitHashTable (&dk->ids, TCL_STRING_KEYS);
            dk->unknownIDrefs = 0;
            Tcl_SetHashValue (h, dk);
        } else {
            dk = Tcl_GetHashValue (h);
        }
        sc->constraint = docidrefImpl;
        sc->constraintData = (void *)dk;
    }
    return TCL_OK;
}

static int
base64Impl (
    Tcl_Interp *interp,
    void *constraintData,

Changes to generic/schema.h.

133
134
135
136
137
138
139






140
141
142
143
144
145
146
...
175
176
177
178
179
180
181

182
183
184
185
186
187
188
    VALIDATION_READY,
    VALIDATION_STARTED,
    VALIDATION_ERROR,
    VALIDATION_FINISHED
} ValidationState;

typedef struct 






{
    Tcl_Obj *self;
    char *start;
    char *startNamespace;
    Tcl_HashTable element;
    Tcl_HashTable namespace;
    Tcl_HashEntry *emptyNamespace;
................................................................................
    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,






>
>
>
>
>
>







 







>







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
...
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
    VALIDATION_READY,
    VALIDATION_STARTED,
    VALIDATION_ERROR,
    VALIDATION_FINISHED
} ValidationState;

typedef struct 
{
    Tcl_HashTable ids;
    int unknownIDrefs;
} SchemaDocKey;
    
typedef struct 
{
    Tcl_Obj *self;
    char *start;
    char *startNamespace;
    Tcl_HashTable element;
    Tcl_HashTable namespace;
    Tcl_HashEntry *emptyNamespace;
................................................................................
    SchemaValidationStack *stack;
    SchemaValidationStack *stackPool;
    ValidationState validationState;
    unsigned int skipDeep;
    Tcl_DString *cdata;
    Tcl_HashTable ids;
    int unknownIDrefs;
    Tcl_HashTable idTables;
} SchemaData;

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

Changes to tests/schema.test.

3807
3808
3809
3810
3811
3812
3813
































































3814
3815
3816
3817
3818
3819
3820
        {<doc>===</doc>}        
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0 1 1 0 0}

































































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






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







3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
3883
3884
        {<doc>===</doc>}        
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0 1 1 0 0}

test schema-14.27 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
                element idrefa *
            }
        }
        defelement id {text id}
        defelement idref {text idref}
        defelement ida {text {id a}}
        defelement idrefa {text {idref a}}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><id>abc</id><ida>abc</ida></doc>
        <doc><idrefa>abc</idrefa></doc>
        <doc><idrefa>abc</idrefa><idref>abc</idref></doc>
        <doc><id>1</id><idrefa>abc</idrefa><idref>abc</idref><idrefa>foo</idrefa><idref>abc</idref></doc>
        <doc><id>abc</id><idref>abc</idref><ida>abc</ida><idrefa>abc</idrefa></doc>
        <doc><idref>abc</idref><id>abc</id><idrefa>abc</idrefa><ida>abc</ida></doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}

test schema-14.28 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
                element idrefa *
            }
        }
        defelement id {text {id b}}
        defelement idref {text {idref b}}
        defelement ida {text {id a}}
        defelement idrefa {text {idref a}}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><id>abc</id><ida>abc</ida></doc>
        <doc><idrefa>abc</idrefa></doc>
        <doc><idrefa>abc</idrefa><idref>abc</idref></doc>
        <doc><id>1</id><idrefa>abc</idrefa><idref>abc</idref><idrefa>foo</idrefa><idref>abc</idref></doc>
        <doc><id>abc</id><idref>abc</idref><ida>abc</ida><idrefa>abc</idrefa></doc>
        <doc><idref>abc</idref><id>abc</id><idrefa>abc</idrefa><ida>abc</ida></doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}

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