Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | More work on introspection of validation state. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | wip |
| Files: | files | file ages | folders |
| SHA3-256: |
4328236591c2cc95d4ab2a611ba12b57 |
| User & Date: | rolf 2019-10-03 22:39:39 |
Context
|
2019-10-04
| ||
| 12:15 | Again, more work on introspection of validation state. check-in: 5dd7e9928d user: rolf tags: wip | |
|
2019-10-03
| ||
| 22:39 | More work on introspection of validation state. check-in: 4328236591 user: rolf tags: wip | |
| 11:29 | Added #text to the possible next events in case of mixed. check-in: f1a7ec26da user: rolf tags: wip | |
Changes
Changes to generic/schema.c.
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 .... 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 .... 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737 1738 1739 1740 1741 .... 1789 1790 1791 1792 1793 1794 1795 1796 1797 1798 1799 1800 1801 1802 .... 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 1978 .... 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 .... 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 .... 3021 3022 3023 3024 3025 3026 3027 3028 3029 3030 3031 3032 3033 3034 3035 3036 3037 .... 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 |
if (!(sc->constraint) (interp, sc->constraintData, text)) {
return 0;
}
}
return 1;
}
static int
evalVirtual (
Tcl_Interp *interp,
SchemaData *sdata,
SchemaCP *cp
)
{
int rc;
cp->content[cp->nc-1] = (SchemaCP *) sdata->self;
rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
TCL_EVAL_GLOBAL);
if (rc != TCL_OK) {
sdata->evalError = 1;
return 0;
}
return 1;
}
................................................................................
}
if (!mayskip && mayMiss (candidate->quants[i]))
mayskip = 1;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (evalVirtual (interp, sdata, candidate)) {
/* Virtual contraints are always quant ONE, so
* that the virtual constraints are called while
* looking if an element can end. Therefor we use
* here the already present mayskip mechanism to
* try further, after calling the tcl script. */
mayskip = 1;
break;
................................................................................
if (mayMiss) break;
if (!recover (interp, sdata, S("MISSING_ONE_OF_CHOICE"), 0, 0)) {
return 0;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (evalVirtual (interp, sdata, cp->content[ac])) break;
else return 0;
case SCHEMA_CTYPE_INTERLEAVE:
case SCHEMA_CTYPE_PATTERN:
pushToStack (sdata, cp->content[ac]);
rc = checkElementEnd (interp, sdata);
popStack (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) {
................................................................................
updateStack (se, cp, ac);
return 1;
}
popStack (sdata);
break;
case SCHEMA_CTYPE_VIRTUAL:
if (!evalVirtual (interp, sdata, ic)) return 0;
break;
case SCHEMA_CTYPE_CHOICE:
Tcl_Panic ("MIXED or CHOICE child of MIXED or CHOICE");
case SCHEMA_CTYPE_KEYSPACE_END:
case SCHEMA_CTYPE_KEYSPACE:
Tcl_Panic ("Keyspace constrain in MIXED or CHOICE");
................................................................................
if (mustMatch (cp->quants[ac], hm)) {
SetResult ("Unexpected text content");
return 0;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (!evalVirtual (interp, sdata, candidate)) return 0;
break;
case SCHEMA_CTYPE_KEYSPACE:
if (!cp->content[ac]->keySpace->active) {
Tcl_InitHashTable (&cp->content[ac]->keySpace->ids,
TCL_STRING_KEYS);
cp->content[ac]->keySpace->active = 1;
................................................................................
break;
case SCHEMA_CTYPE_VIRTUAL:
case SCHEMA_CTYPE_KEYSPACE:
case SCHEMA_CTYPE_KEYSPACE_END:
break;
}
if (minOne (cp->quants[ac])) return;
ac++;
}
break;
case SCHEMA_CTYPE_ANY:
case SCHEMA_CTYPE_CHOICE:
case SCHEMA_CTYPE_TEXT:
................................................................................
SetBooleanResult (0);
} else {
SetBooleanResult (1);
}
return TCL_OK;
case m_frontexpected:
if (sdata->validationState != VALIDATION_STARTED) {
SetResult ("No validation started");
return TCL_ERROR;
}
if (!sdata->stack) {
if (sdata->start) {
Tcl_AppendElement (interp, sdata->start);
if (sdata->startNamespace) {
Tcl_AppendElement (interp, sdata->startNamespace);
}
................................................................................
return TCL_ERROR;
}
if (sdata->cp->type != SCHEMA_CTYPE_NAME
&& sdata->cp->type != SCHEMA_CTYPE_PATTERN) {
SetResult ("The \"tcl\" schema definition command is only "
"allowed in sequential context (defelement, "
"element 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. */
|
> > | | > > > > > > > > | | > | < | | | | > > | |
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 952 953 .... 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 .... 1737 1738 1739 1740 1741 1742 1743 1744 1745 1746 1747 1748 1749 1750 1751 .... 1799 1800 1801 1802 1803 1804 1805 1806 1807 1808 1809 1810 1811 1812 1813 .... 1974 1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 .... 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018 2019 2020 .... 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 .... 3031 3032 3033 3034 3035 3036 3037 3038 3039 3040 3041 3042 3043 3044 3045 3046 3047 3048 3049 .... 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 |
if (!(sc->constraint) (interp, sc->constraintData, text)) {
return 0;
}
}
return 1;
}
/* The argument ac points to the child of the current top-most stack
* element pattern which is to evaluate. */
static int
evalVirtual (
Tcl_Interp *interp,
SchemaData *sdata,
int ac
)
{
SchemaCP *cp;
int savedac, savedhm, rc;
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;
}
................................................................................
}
if (!mayskip && mayMiss (candidate->quants[i]))
mayskip = 1;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (evalVirtual (interp, sdata, ac)) {
/* Virtual contraints are always quant ONE, so
* that the virtual constraints are called while
* looking if an element can end. Therefor we use
* here the already present mayskip mechanism to
* try further, after calling the tcl script. */
mayskip = 1;
break;
................................................................................
if (mayMiss) break;
if (!recover (interp, sdata, S("MISSING_ONE_OF_CHOICE"), 0, 0)) {
return 0;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (evalVirtual (interp, sdata, ac)) break;
else return 0;
case SCHEMA_CTYPE_INTERLEAVE:
case SCHEMA_CTYPE_PATTERN:
pushToStack (sdata, cp->content[ac]);
rc = checkElementEnd (interp, sdata);
popStack (sdata);
................................................................................
)
{
Tcl_HashEntry *h, *h1;
Tcl_HashSearch search, search1;
int haveErrMsg = 0;
SchemaDocKey *dk;
/* TODO: add recovering */
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) {
................................................................................
updateStack (se, cp, ac);
return 1;
}
popStack (sdata);
break;
case SCHEMA_CTYPE_VIRTUAL:
Tcl_Panic ("Virtual constrain in MIXED or CHOICE");
case SCHEMA_CTYPE_CHOICE:
Tcl_Panic ("MIXED or CHOICE child of MIXED or CHOICE");
case SCHEMA_CTYPE_KEYSPACE_END:
case SCHEMA_CTYPE_KEYSPACE:
Tcl_Panic ("Keyspace constrain in MIXED or CHOICE");
................................................................................
if (mustMatch (cp->quants[ac], hm)) {
SetResult ("Unexpected text content");
return 0;
}
break;
case SCHEMA_CTYPE_VIRTUAL:
if (!evalVirtual (interp, sdata, ac)) return 0;
break;
case SCHEMA_CTYPE_KEYSPACE:
if (!cp->content[ac]->keySpace->active) {
Tcl_InitHashTable (&cp->content[ac]->keySpace->ids,
TCL_STRING_KEYS);
cp->content[ac]->keySpace->active = 1;
................................................................................
break;
case SCHEMA_CTYPE_VIRTUAL:
case SCHEMA_CTYPE_KEYSPACE:
case SCHEMA_CTYPE_KEYSPACE_END:
break;
}
if (minOne (cp->quants[ac])) break;
ac++;
}
break;
case SCHEMA_CTYPE_ANY:
case SCHEMA_CTYPE_CHOICE:
case SCHEMA_CTYPE_TEXT:
................................................................................
SetBooleanResult (0);
} else {
SetBooleanResult (1);
}
return TCL_OK;
case m_frontexpected:
if (sdata->validationState == VALIDATION_ERROR) {
SetResult ("Validation command in error state.");
return TCL_ERROR;
} else if (sdata->validationState == VALIDATION_FINISHED) {
return TCL_OK;
}
if (!sdata->stack) {
if (sdata->start) {
Tcl_AppendElement (interp, sdata->start);
if (sdata->startNamespace) {
Tcl_AppendElement (interp, sdata->startNamespace);
}
................................................................................
return TCL_ERROR;
}
if (sdata->cp->type != SCHEMA_CTYPE_NAME
&& sdata->cp->type != SCHEMA_CTYPE_PATTERN) {
SetResult ("The \"tcl\" schema definition command is only "
"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. */
|
Changes to tests/schema.test.
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
....
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
|
# schema-15.*: Constraint cmd tcl
# schema-16.*: interleave
# schema-17.*: info
# schema-18.*: reportcmd
# schema-19.*: keyspace
# schema-20.*: domunique
#
# Copyright (c) 2018 Rolf Ade.
source [file join [file dir [info script]] loadtdom.tcl]
if {[dom featureinfo schema]} {
test schema-1.1 {create} {
tdom::schema create grammar
................................................................................
}
s event start doc
set result [s info frontexpected]
s delete
set result
} {{#text} a c b toplevel {musthave http://foo.bar}}
proc schema-18 {args} {
lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
tdom::schema s
s define {
defelement doc {
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
....
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
|
# 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]} { test schema-1.1 {create} { tdom::schema create grammar ................................................................................ } s event start doc set result [s info frontexpected] s delete set result } {{#text} a c b toplevel {musthave http://foo.bar}} test schema-17.8 {info frontexpected} { tdom::schema s s defelement doc { choice ? { element a element c element b } element toplevel ? element musthave element aftermust } set result [s info frontexpected] s define { foreach elm {a b c} { defelement $elm {} } } lappend result {*}[lsort [s info frontexpected]] s event start doc lappend result {*}[s info frontexpected] s event start c s event end lappend result {*}[s info frontexpected] s delete set result } {doc a b c doc a c b toplevel musthave toplevel musthave} proc schema-17.9 {scmd} { global result set result [$scmd info frontexpected] } test schema-17.9 {info frontexpected 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 result "" lappend [s validate {<doc><must/></doc>}] s delete set result } {c may must} proc schema-18 {args} { lappend ::result {*}$args } test schema-18.1 {reportcmd} { tdom::schema s s define { defelement doc { |