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

Overview
Comment:Merged from schema.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | wip
Files: files | file ages | folders
SHA3-256: 3c16fd1ab1c15c932543f576a3bba51b1a9372733a7df6c0af34d9a45a2b63a7
User & Date: rolf 2019-10-23 09:25:48
Context
2019-10-24
22:05
Merged from trunk. check-in: c416325b0b user: rolf tags: wip
2019-10-23
09:25
Merged from schema. check-in: 3c16fd1ab1 user: rolf tags: wip
00:27
Sanitized namespoace handling for 'event start'. Startet attribute input to the 'event start' method. Therefor internal reorganisation, which also makes adding hash tables for larger sets of attribute a bit simpler. check-in: 5f6af15f8d user: rolf tags: schema
2019-10-17
00:41
Recovery is hard. For several reasons. check-in: bd90f4a8d4 user: rolf tags: wip
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
...
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
....
1078
1079
1080
1081
1082
1083
1084

1085
1086

1087
1088
1089
1090
1091
1092
1093
....
1545
1546
1547
1548
1549
1550
1551


































1552
1553
1554
1555
1556
1557
1558
1559
1560

1561
1562
1563
1564
1565
1566
1567
....
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
....
1629
1630
1631
1632
1633
1634
1635

1636
1637

1638
1639
1640
1641
1642
1643
1644
....
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671

1672
1673
1674
1675
1676
1677
1678
....
1686
1687
1688
1689
1690
1691
1692
1693


1694
1695
1696



1697
1698

1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716

1717
1718
1719
1720
1721
1722
1723
....
1785
1786
1787
1788
1789
1790
1791























































1792
1793
1794
1795
1796
1797
1798
....
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
....
3654
3655
3656
3657
3658
3659
3660

3661
3662
3663

















3664
3665
3666





3667

3668
3669
3670
3671
3672
3673
3674
\---------------------------------------------------------------------------*/
#ifndef CONTENT_ARRAY_SIZE_INIT
#  define CONTENT_ARRAY_SIZE_INIT 20
#endif
#ifndef ANON_PATTERN_ARRAY_SIZE_INIT
#  define ANON_PATTERN_ARRAY_SIZE_INIT 256
#endif
#ifndef QUANTS_ARRAY_SIZE_INIT
#  define QUANTS_ARRAY_SIZE_INIT 8
#endif
#ifndef STACK_SIZE_INIT
#  define STACK_SIZE_INIT 16
#endif
#ifndef STACK_LIST_SIZE_INIT
#  define STACK_LIST_SIZE_INIT 64
#endif
#ifndef URI_BUFFER_LEN_INIT
#  define URI_BUFFER_LEN_INIT 128
#endif
#ifndef ATTR_ARRAY_INIT
#  define ATTR_ARRAY_INIT 4
#endif

................................................................................
        return TCL_ERROR;                                               \
    }

#define CHECK_RECURSIVE_CALL                                            \
    if (clientData != NULL) {                                           \
        savedsdata = GETASI;                                            \
        if (savedsdata == sdata) {                                      \
            SetResult ("This recursive call is not allowed"); \
            return TCL_ERROR;                                           \
        }                                                               \
    }
      
#define CHECK_EVAL                                                      \
    if (sdata->currentEvals) {                                          \
        SetResult ("Method not allowed in nested schema define script"); \
        return TCL_ERROR;                                               \
    }
    
#define REMEMBER_PATTERN(pattern)                                       \
    if (sdata->numPatternList == sdata->patternListSize) {              \
        sdata->patternList = (SchemaCP **) REALLOC (                    \
            sdata->patternList,                                         \
................................................................................
    Tcl_InitHashTable (&sdata->namespace, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->textDef, TCL_STRING_KEYS);
    sdata->emptyNamespace = Tcl_CreateHashEntry (
        &sdata->namespace, "", &hnew);
    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_DeleteHashTable (&sdata->pattern);
    Tcl_DeleteHashTable (&sdata->attrNames);
    Tcl_DeleteHashTable (&sdata->textDef);
    for (i = 0; i < sdata->numPatternList; i++) {
        freeSchemaCP (sdata->patternList[i]);
    }
    FREE (sdata->patternList);
    if (sdata->numQuants) {
        FREE (sdata->quants);
    }
    FREE (sdata->quants);
    while (sdata->stack) {
        down = sdata->stack->down;
        if (sdata->stack->interleaveState)
            FREE (sdata->stack->interleaveState);
        FREE (sdata->stack);
        sdata->stack = down;
................................................................................

    cp = sdata->stack->pattern->content[ac];
    savedac = sdata->stack->activeChild;
    savedhm = sdata->stack->hasMatched;
    sdata->stack->activeChild = ac;
    sdata->stack->hasMatched = 1;
    cp->content[cp->nc-1] = (SchemaCP *) sdata->self;

    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);

    sdata->stack->activeChild = savedac;
    sdata->stack->hasMatched = savedhm;    
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;
................................................................................
            Tcl_AppendResult (interp, namespacePtr, ":", NULL);
        }
        Tcl_AppendResult (interp, name, "\" doesn't match", NULL);
    }
    return TCL_ERROR;
}



































int probeAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char **attr
    )
{
    char   **atPtr, *ln, *namespace;
    int i, j, found, nsatt, reqAttr = 0;
    SchemaCP *cp;


    cp = sdata->stack->pattern;
    for (atPtr = (char **) attr; atPtr[0] && atPtr[1]; atPtr += 2) {
        found = 0;
        ln = atPtr[0];
        j = 0;
        while (*ln && *ln != '\xFF') {
................................................................................
            ln++;
            nsatt = 1;
        } else {
            namespace = NULL;
            ln = atPtr[0];
            nsatt = 0;
        }
        for (i = 0; i < cp->numAttr; i++) {
            if (nsatt) {

                if (!cp->attrs[i]->namespace
                    || (strcmp (cp->attrs[i]->namespace, namespace) != 0))
                    continue;
            }

            if (strcmp (ln, cp->attrs[i]->name) == 0) {
                found = 1;
                if (cp->attrs[i]->cp) {
                    if (!checkText (interp, cp->attrs[i]->cp,
                                    (char *) atPtr[1])) {
                        if (!recover (interp, sdata,
                                      S("INVALID_ATTRIBUTE_VALUE"), 0, 0)) {
                            if (nsatt) namespace[j] = '\xFF';
                            SetResult3V ("Attribute value doesn't match for "
                                         "attribute '", atPtr[0], "'");
                            return TCL_ERROR;
                        }
                    }
                }
                if (cp->attrs[i]->required) reqAttr++;
                break;
            }
        }
        if (nsatt) namespace[j] = '\xFF';



        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"), 0, 0)) {
                SetResult3V ("Unknown attribute \"", atPtr[0], "\"");
                return TCL_ERROR;
            }
        }

    }
    if (reqAttr != cp->numReqAttr) {
        /* Lookup the missing attribute(s) */
        if (!sdata->evalError) {
            SetResult ("Missing mandatory attribute(s):");
        }
        for (i = 0; i < cp->numAttr; i++) {
................................................................................
                        namespace[j] = '\0';
                        ln++;
                        nsatt = 1;
                    } else {
                        continue;
                    }
                    if (strcmp (cp->attrs[i]->namespace, namespace) != 0) {

                        continue;
                    }

                }
                if (strcmp (atPtr[0], cp->attrs[i]->name) == 0) {
                    found = 1;
                    break;
                }
            }
            if (!found) {
................................................................................
int probeDomAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,
    domAttrNode *attr
    )
{
    domAttrNode *atPtr;
    int i, found, reqAttr = 0;
    const char *ns, *ln;
    SchemaCP *cp;


    cp = sdata->stack->pattern;
    atPtr = attr;
    while (atPtr) {
        if (atPtr->nodeFlags & IS_NS_NODE) goto nextAttr;
        found = 0;
        if (atPtr->namespace) {
................................................................................
                }
                ln++;
            }
        } else {
            ns = NULL;
            ln = atPtr->nodeName;
        }
        for (i = 0; i < cp->numAttr; i++) {


            if (ns) {
                if (!cp->attrs[i]->namespace) continue;
                if (strcmp (ns, cp->attrs[i]->namespace) != 0) continue;



            } else {
                if (cp->attrs[i]->namespace) continue;

            }
            if (strcmp (ln, cp->attrs[i]->name) == 0) {
                if (cp->attrs[i]->cp) {
                    if (!checkText (interp, cp->attrs[i]->cp,
                                    (char *) atPtr->nodeValue)) {
                        if (!recover (interp, sdata,
                                      S("INVALID_ATTRIBUTE_VALUE"), 0, 0)) {
                            SetResult3V ("Attribute value doesn't match for "
                                         "attribute '", ln, "'");
                            return TCL_ERROR;
                        }
                    }
                }
                found = 1;
                if (cp->attrs[i]->required) reqAttr++;
                break;
            }
        }

        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"), 0, 0)) {
                if (!sdata->evalError) {
                    if (ns) {
                        SetResult ("Unknown attribute \"");
                        Tcl_AppendResult (interp, ns, ":", atPtr->nodeName,
                                          "\"");
................................................................................
        }
        if (!sdata->reportCmd) {
            sdata->validationState = VALIDATION_ERROR;
            return TCL_ERROR;
        }
    }
    return TCL_OK;























































}

static int checkElementEnd (
    Tcl_Interp *interp,
    SchemaData *sdata
    )
{
................................................................................
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0, j;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata = NULL, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *h, *h1;
    SchemaCP      *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
................................................................................
        case k_elementstart:
            if (objc < 4 && objc > 6) {
                Tcl_WrongNumArgs (interp, 3, objv, "<elementname>"
                    "?<attInfo>? ?<namespace>?");
                return TCL_ERROR;
            }
            namespacePtr = NULL;

            if (objc == 6) {
                namespacePtr = getNamespacePtr (sdata,
                                                Tcl_GetString (objv[5]));

















            }
            result = probeElement (interp, sdata, Tcl_GetString (objv[3]),
                                   namespacePtr);





            break;

        case k_elementend:
            if (objc != 3) {
                Tcl_WrongNumArgs (interp, 3, objv, "No arguments expected.");
                return TCL_ERROR;
            }
            result = probeElementEnd (interp, sdata);
            break;







<
<
<
<
<
<
<
<
<







 







|






|







 







<
<
<







 







<
<
<







 







>


>







 







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






|
|

>







 







|
|
>
|
|
<
<
>
|
|
|
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
>
>
>






>







 







>


>







 







|


>







 







|
>
>
|
<
<
>
>
>
|
<
>
|
<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
>







 







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







 







|







 







>



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



>
>
>
>
>

>







51
52
53
54
55
56
57









58
59
60
61
62
63
64
...
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
520
521
522
523
524
525
526



527
528
529
530
531
532
533
...
585
586
587
588
589
590
591



592
593
594
595
596
597
598
....
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
....
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
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
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
....
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
....
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
....
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
....
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710


1711
1712
1713
1714

1715
1716



1717
1718












1719
1720
1721
1722
1723
1724
1725
1726
....
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
....
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
....
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
\---------------------------------------------------------------------------*/
#ifndef CONTENT_ARRAY_SIZE_INIT
#  define CONTENT_ARRAY_SIZE_INIT 20
#endif
#ifndef ANON_PATTERN_ARRAY_SIZE_INIT
#  define ANON_PATTERN_ARRAY_SIZE_INIT 256
#endif









#ifndef URI_BUFFER_LEN_INIT
#  define URI_BUFFER_LEN_INIT 128
#endif
#ifndef ATTR_ARRAY_INIT
#  define ATTR_ARRAY_INIT 4
#endif

................................................................................
        return TCL_ERROR;                                               \
    }

#define CHECK_RECURSIVE_CALL                                            \
    if (clientData != NULL) {                                           \
        savedsdata = GETASI;                                            \
        if (savedsdata == sdata) {                                      \
            SetResult ("This recursive call is not allowed");           \
            return TCL_ERROR;                                           \
        }                                                               \
    }
      
#define CHECK_EVAL                                                      \
    if (sdata->currentEvals) {                                          \
        SetResult ("This method is not allowed in nested evaluation");  \
        return TCL_ERROR;                                               \
    }
    
#define REMEMBER_PATTERN(pattern)                                       \
    if (sdata->numPatternList == sdata->patternListSize) {              \
        sdata->patternList = (SchemaCP **) REALLOC (                    \
            sdata->patternList,                                         \
................................................................................
    Tcl_InitHashTable (&sdata->namespace, TCL_STRING_KEYS);
    Tcl_InitHashTable (&sdata->textDef, TCL_STRING_KEYS);
    sdata->emptyNamespace = Tcl_CreateHashEntry (
        &sdata->namespace, "", &hnew);
    sdata->patternList = (SchemaCP **) MALLOC (
        sizeof (SchemaCP*) * ANON_PATTERN_ARRAY_SIZE_INIT);
    sdata->patternListSize = ANON_PATTERN_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_DeleteHashTable (&sdata->pattern);
    Tcl_DeleteHashTable (&sdata->attrNames);
    Tcl_DeleteHashTable (&sdata->textDef);
    for (i = 0; i < sdata->numPatternList; i++) {
        freeSchemaCP (sdata->patternList[i]);
    }
    FREE (sdata->patternList);



    FREE (sdata->quants);
    while (sdata->stack) {
        down = sdata->stack->down;
        if (sdata->stack->interleaveState)
            FREE (sdata->stack->interleaveState);
        FREE (sdata->stack);
        sdata->stack = down;
................................................................................

    cp = sdata->stack->pattern->content[ac];
    savedac = sdata->stack->activeChild;
    savedhm = sdata->stack->hasMatched;
    sdata->stack->activeChild = ac;
    sdata->stack->hasMatched = 1;
    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--;
    sdata->stack->activeChild = savedac;
    sdata->stack->hasMatched = savedhm;    
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;
................................................................................
            Tcl_AppendResult (interp, namespacePtr, ":", NULL);
        }
        Tcl_AppendResult (interp, name, "\" doesn't match", NULL);
    }
    return TCL_ERROR;
}

int probeAttribute (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char *name,
    const char *ns,
    char *value,
    int *isrequiered
    )
{
    int i;
    SchemaCP *cp;
    
    cp = sdata->stack->pattern;
    *isrequiered = 0;
    for (i = 0; i < cp->numAttr; i++) {
        if (cp->attrs[i]->namespace == ns
            && cp->attrs[i]->name == name) {
            if (cp->attrs[i]->cp) {
                if (!checkText (interp, cp->attrs[i]->cp, value)) {
                    if (!recover (interp, sdata,
                                  S("INVALID_ATTRIBUTE_VALUE"), 0, 0)) {
                        SetResult3V ("Attribute value doesn't match for "
                                    "attribute '", name , "'");
                        return 0;
                    }
                }
            }
            if (cp->attrs[i]->required) *isrequiered = 1;
            return 1;
        }
    }
    return 0;
}
    
int probeAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char **attr
    )
{
    char   **atPtr, *ln, *namespace, *ns;
    int i, j, found, nsatt, req, reqAttr = 0;
    SchemaCP *cp;
    Tcl_HashEntry *h;

    cp = sdata->stack->pattern;
    for (atPtr = (char **) attr; atPtr[0] && atPtr[1]; atPtr += 2) {
        found = 0;
        ln = atPtr[0];
        j = 0;
        while (*ln && *ln != '\xFF') {
................................................................................
            ln++;
            nsatt = 1;
        } else {
            namespace = NULL;
            ln = atPtr[0];
            nsatt = 0;
        }
        h = Tcl_FindHashEntry (&sdata->attrNames, ln);
        if (!h) goto unknowncleanup;
        ln = Tcl_GetHashKey (&sdata->attrNames, h);
        if (namespace) {
            h = Tcl_FindHashEntry (&sdata->namespace, namespace);


            if (!h) goto unknowncleanup;
            ns = Tcl_GetHashKey (&sdata->namespace, h);
        } else {
            ns = NULL;








        }







        found = probeAttribute (interp, sdata, ln, ns, atPtr[1], &req);
        reqAttr += req;
    unknowncleanup:
        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"), 0, 0)) {
                SetResult3V ("Unknown attribute \"", atPtr[0], "\"");
                return TCL_ERROR;
            }
        }
        if (nsatt) namespace[j] = '\xFF';
    }
    if (reqAttr != cp->numReqAttr) {
        /* Lookup the missing attribute(s) */
        if (!sdata->evalError) {
            SetResult ("Missing mandatory attribute(s):");
        }
        for (i = 0; i < cp->numAttr; i++) {
................................................................................
                        namespace[j] = '\0';
                        ln++;
                        nsatt = 1;
                    } else {
                        continue;
                    }
                    if (strcmp (cp->attrs[i]->namespace, namespace) != 0) {
                        if (nsatt) namespace[j] = '\xFF';
                        continue;
                    }
                    if (nsatt) namespace[j] = '\xFF';
                }
                if (strcmp (atPtr[0], cp->attrs[i]->name) == 0) {
                    found = 1;
                    break;
                }
            }
            if (!found) {
................................................................................
int probeDomAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,
    domAttrNode *attr
    )
{
    domAttrNode *atPtr;
    int i, found, req, reqAttr = 0;
    const char *ns, *ln;
    SchemaCP *cp;
    Tcl_HashEntry *h;

    cp = sdata->stack->pattern;
    atPtr = attr;
    while (atPtr) {
        if (atPtr->nodeFlags & IS_NS_NODE) goto nextAttr;
        found = 0;
        if (atPtr->namespace) {
................................................................................
                }
                ln++;
            }
        } else {
            ns = NULL;
            ln = atPtr->nodeName;
        }
        h = Tcl_FindHashEntry (&sdata->attrNames, ln);
        if (!h) goto unknown;
        ln = Tcl_GetHashKey (&sdata->attrNames, h);
        if (ns) {


            h = Tcl_FindHashEntry (&sdata->namespace, ns);
            if (!h) goto unknown;
            ns = Tcl_GetHashKey (&sdata->namespace, h);
        } else {

            ns = NULL;
        }



        found = probeAttribute (interp, sdata, ln, ns, atPtr->nodeValue, &req);
        reqAttr += req;












    unknown:
        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"), 0, 0)) {
                if (!sdata->evalError) {
                    if (ns) {
                        SetResult ("Unknown attribute \"");
                        Tcl_AppendResult (interp, ns, ":", atPtr->nodeName,
                                          "\"");
................................................................................
        }
        if (!sdata->reportCmd) {
            sdata->validationState = VALIDATION_ERROR;
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}
int probeEventAttribute (
    Tcl_Interp *interp,
    SchemaData *sdata,
    Tcl_Obj *attr,
    int len
    )
{
    int i, found, req, reqAttr = 0;
    char *name, *ns;
    SchemaCP *cp;
    Tcl_HashEntry *h;
    Tcl_Obj *attname, *attns, *attvalue;

    cp = sdata->stack->pattern;
    for (i = 0; i < len; i += 2) {
        Tcl_ListObjIndex (interp, attr, i, &attname);
        Tcl_ListObjIndex (interp, attr, i+1, &attvalue);
        if (Tcl_ListObjLength (interp, attname, &len) == TCL_OK) {
            if (len == 2) {
                Tcl_ListObjIndex (interp, attname, 1, &attns);
                Tcl_ListObjIndex (interp, attname, 1, &attname);
            }
        }
        h = Tcl_FindHashEntry (&sdata->attrNames, Tcl_GetString (attname));
        if (!h) goto unknown;
        name = Tcl_GetHashKey (&sdata->attrNames, h);
        if (attns) {
            h = Tcl_FindHashEntry (&sdata->namespace, Tcl_GetString (attns));
            if (!h) goto unknown;
            ns = Tcl_GetHashKey (&sdata->namespace, h);
        }
        found = probeAttribute (interp, sdata, name, ns,
                                Tcl_GetString (attvalue), &req);
        reqAttr += req;
    unknown:
        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"), 0, 0)) {
                if (ns) {
                    SetResult ("Unknown attribute \"");
                    Tcl_AppendResult (interp, ns, ":", ns,
                                      "\"");
                } else {
                    SetResult3 ("Unknown attribute \"", name, "\"");
                }
                sdata->validationState = VALIDATION_ERROR;
                return TCL_ERROR;
            }
        }
    }
    if (reqAttr != cp->numReqAttr) {
        SetResult ("Missing mandatory attribute(s)");
        return TCL_ERROR;
    }
    return TCL_OK;
}

static int checkElementEnd (
    Tcl_Interp *interp,
    SchemaData *sdata
    )
{
................................................................................
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0, j;
    int            savedDefineToplevel, type, len, checkAttr;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata = NULL, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *h, *h1;
    SchemaCP      *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
................................................................................
        case k_elementstart:
            if (objc < 4 && objc > 6) {
                Tcl_WrongNumArgs (interp, 3, objv, "<elementname>"
                    "?<attInfo>? ?<namespace>?");
                return TCL_ERROR;
            }
            namespacePtr = NULL;
            checkAttr = 0;
            if (objc == 6) {
                namespacePtr = getNamespacePtr (sdata,
                                                Tcl_GetString (objv[5]));
            }
            if (objc >= 5) {
                if (Tcl_ListObjLength (interp, objv[4], &len) != TCL_OK) {
                    namespacePtr = getNamespacePtr (sdata,
                                                    Tcl_GetString (objv[4]));
                } else {
                    if (len == 1) {
                        namespacePtr = getNamespacePtr (
                            sdata, Tcl_GetString (objv[4])
                            );
                    } else if (len % 2 != 0) {
                        SetResult ("Invalid attribute information");
                        return TCL_ERROR;
                    } else {
                        checkAttr = 1;
                    }
                }
            }
            result = probeElement (interp, sdata, Tcl_GetString (objv[3]),
                                   namespacePtr);
            if (result == TCL_OK && checkAttr) {
                if (!probeEventAttribute (interp, sdata, objv[4], len)) {
                    return TCL_ERROR;
                }
            }
            break;
            
        case k_elementend:
            if (objc != 3) {
                Tcl_WrongNumArgs (interp, 3, objv, "No arguments expected.");
                return TCL_ERROR;
            }
            result = probeElementEnd (interp, sdata);
            break;

Changes to generic/schema.h.

149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
    Tcl_HashTable attrNames;
    Tcl_HashTable textDef;
    SchemaCP **patternList; 
    unsigned int numPatternList;
    unsigned int patternListSize;
    unsigned int forwardPatternDefs;
    SchemaQuant *quants;
    unsigned int numQuants;
    unsigned int quantsSize;
    int       currentEvals;
    int       cleanupAfterEval;
    int       evalError;
    Tcl_Obj  *reportCmd;
    SchemaValidationStack *lastMatchse;
    Tcl_Obj **evalStub;
    Tcl_Obj **textStub;







<
<







149
150
151
152
153
154
155


156
157
158
159
160
161
162
    Tcl_HashTable attrNames;
    Tcl_HashTable textDef;
    SchemaCP **patternList; 
    unsigned int numPatternList;
    unsigned int patternListSize;
    unsigned int forwardPatternDefs;
    SchemaQuant *quants;


    int       currentEvals;
    int       cleanupAfterEval;
    int       evalError;
    Tcl_Obj  *reportCmd;
    SchemaValidationStack *lastMatchse;
    Tcl_Obj **evalStub;
    Tcl_Obj **textStub;

Changes to tests/schema.test.

17
18
19
20
21
22
23

24
25
26
27
28
29
30
...
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
...
873
874
875
876
877
878
879
































































880
881
882
883
884
885
886
....
5749
5750
5751
5752
5753
5754
5755





5756
5757












#    schema-14.*: text
#    schema-15.*: Constraint cmd tcl
#    schema-16.*: interleave
#    schema-17.*: info
#    schema-18.*: reportcmd
#    schema-19.*: keyspace
#    schema-20.*: domunique

#
# Copyright (c) 2018-2019 Rolf Ade.

source [file join [file dir [info script]] loadtdom.tcl]

if {[dom featureinfo schema]} {

................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 0 1 1 0}

test schema-4.3 {domvalidate} {
    tdom::schema s 
    s define {
        defelement addressBook {
            element card *
        }
        defelement card {
            element name
................................................................................
    <email>fb@example.net</email>
  </card>
</addressBook>        
    }]
    s delete
    set result
} 1

































































test schema-5.1 {dom parse -validateCmd} {
    set result [catch {
        [dom parse -validateCmd tdom::schema <doc/>]
    }]
} 1

................................................................................
    } {
        lappend result [postValidation s $xml]
    }
    s delete
    set result
} {1 0}







}



















>







 







|







 







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







 







>
>
>
>
>
|
|
>
>
>
>
>
>
>
>
>
>
>
>
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
...
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
....
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
#    schema-14.*: text
#    schema-15.*: Constraint cmd tcl
#    schema-16.*: interleave
#    schema-17.*: info
#    schema-18.*: reportcmd
#    schema-19.*: keyspace
#    schema-20.*: domunique
#    schema-21.*: internal: buffers
#
# Copyright (c) 2018-2019 Rolf Ade.

source [file join [file dir [info script]] loadtdom.tcl]

if {[dom featureinfo schema]} {

................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 0 1 1 0}

test schema-4.3 {validation} {
    tdom::schema s 
    s define {
        defelement addressBook {
            element card *
        }
        defelement card {
            element name
................................................................................
    <email>fb@example.net</email>
  </card>
</addressBook>        
    }]
    s delete
    set result
} 1

proc schema-4.4 {scmd} {
    global result
    catch {$scmd event start foo} errMsg
    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>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {{This method is not allowed in nested evaluation} 1 {This method is not allowed in nested evaluation} 1 {This method is not allowed in nested evaluation} 1}

proc schema-4.5 {scmd} {
    global result
    $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>
    } {
        lappend result [s validate $xml errMsg]
        lappend result $errMsg
    }
    s delete
    set result
} {0 {error "This method is not allowed in nested evaluation" at line 1 character 6} 0 {error "This method is not allowed in nested evaluation" at line 1 character 15} 0 {error "This method is not allowed in nested evaluation" at line 1 character 13}}

test schema-4.6 {event start with namespace} {
    tdom::schema s
    s defelement doc http://tdom.org/test {
        element a 1 {
            attribute att1
        }
    }
    s event start doc http://tdom.org/test
    s event start a http://tdom.org/test
    s event end
    s event end
    s delete
} {}

test schema-5.1 {dom parse -validateCmd} {
    set result [catch {
        [dom parse -validateCmd tdom::schema <doc/>]
    }]
} 1

................................................................................
    } {
        lappend result [postValidation s $xml]
    }
    s delete
    set result
} {1 0}

test schema-21.1 {CONTENT_ARRAY_SIZE_INIT} {
    tdom::schema s
    s defelement doc {
        for {set i 1} {$i <= 30} {incr i} {
            element e ?
        }
    }
    set result [list]
    foreach xml [list <doc/> \
                     <doc>[string repeat <e/> 9]</doc> \
                     <doc>[string repeat <e/> 27]</doc>  \
                     <doc>[string repeat <e/> 37]</doc>] {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0}

}