Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | (This and the previous commit on this branch:) Changed the calling convention of the virtual contraints: Append the schema command name to the args given and evaluate that. Whatever data the virtual contraint need has to be requested inside the called script (most probably by the new [<schemacmd> info ...] method, which has to be enhanced over time to provide the information that may needed in practice by this. Added code to ensure a Tcl error in evaluated virtual event does pop up in the result of the schema command call. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | virtualConstraints |
| Files: | files | file ages | folders |
| SHA3-256: |
71d80fea6e44e7ac3717592394167198 |
| User & Date: | rolf 2019-03-07 13:42:32 |
Context
|
2019-03-07
| ||
| 13:44 | Merged feature virtual constraints into the main schema dev branch. check-in: c24d55afe8 user: rolf tags: schema | |
| 13:42 | (This and the previous commit on this branch:) Changed the calling convention of the virtual contraints: Append the schema command name to the args given and evaluate that. Whatever data the virtual contraint need has to be requested inside the called script (most probably by the new [<schemacmd> info ...] method, which has to be enhanced over time to provide the information that may needed in practice by this. Added code to ensure a Tcl error in evaluated virtual event does pop up in the result of the schema command call. Closed-Leaf check-in: 71d80fea6e user: rolf tags: virtualConstraints | |
| 01:48 | Save work. check-in: ba4f23dbc4 user: rolf tags: virtualConstraints | |
Changes
Changes to generic/schema.c.
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 ... 729 730 731 732 733 734 735 736 737 738 739 740 741 742 .... 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 .... 1960 1961 1962 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 .... 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 |
SchemaConstraint *sc;
switch (pattern->type) {
case SCHEMA_CTYPE_ANY:
/* do nothing */
break;
case SCHEMA_CTYPE_VIRTUAL:
for (i = 0; i < pattern->nc - 2; 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 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) {
return 0;
}
return 1;
}
static int
matchElementStart (
................................................................................
return TCL_OK;
}
DBG(
fprintf (stderr, "element '%s' DOESN'T match\n", name);
serializeStack (sdata);
fprintf (stderr, "\n");
);
SetResult ("Element \"");
if (namespacePtr) {
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
................................................................................
schemaReset (
SchemaData *sdata
)
{
while (sdata->stack) popStack (sdata);
sdata->validationState = VALIDATION_READY;
sdata->skipDeep = 0;
}
static int
evalConstraints (
Tcl_Interp *interp,
SchemaData *sdata,
SchemaCP *cp,
................................................................................
serializeElementName (elmObj, cp);
if (Tcl_ListObjAppendElement (interp, resultObj, elmObj) != TCL_OK)
return TCL_ERROR;
}
break;
case m_stack:
if (Tcl_GetIndexFromObj (interp, objv[1],
schemaInstanceInfoStackMethods,
"method", 0, &methodIndex)
!= TCL_OK) {
return TCL_ERROR;
}
switch ((enum schemaInstanceInfoStackMethod) methodIndex) {
case m_top:
|
| > > | | | | | > > | |
375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 ... 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 .... 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 .... 1963 1964 1965 1966 1967 1968 1969 1970 1971 1972 1973 1974 1975 1976 1977 .... 2062 2063 2064 2065 2066 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 |
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 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;
}
static int
matchElementStart (
................................................................................
return TCL_OK;
}
DBG(
fprintf (stderr, "element '%s' DOESN'T match\n", name);
serializeStack (sdata);
fprintf (stderr, "\n");
);
if (!sdata->evalError) {
SetResult ("Element \"");
if (namespacePtr) {
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
................................................................................
schemaReset (
SchemaData *sdata
)
{
while (sdata->stack) popStack (sdata);
sdata->validationState = VALIDATION_READY;
sdata->skipDeep = 0;
sdata->evalError = 0;
}
static int
evalConstraints (
Tcl_Interp *interp,
SchemaData *sdata,
SchemaCP *cp,
................................................................................
serializeElementName (elmObj, cp);
if (Tcl_ListObjAppendElement (interp, resultObj, elmObj) != TCL_OK)
return TCL_ERROR;
}
break;
case m_stack:
if (Tcl_GetIndexFromObj (interp, objv[2],
schemaInstanceInfoStackMethods,
"method", 0, &methodIndex)
!= TCL_OK) {
return TCL_ERROR;
}
switch ((enum schemaInstanceInfoStackMethod) methodIndex) {
case m_top:
|
Changes to generic/schema.h.
120 121 122 123 124 125 126 127 128 129 130 131 132 133 |
unsigned int patternListSize;
unsigned int forwardPatternDefs;
SchemaQuant *quants;
unsigned int numQuants;
unsigned int quantsSize;
int currentEvals;
int cleanupAfterEval;
Tcl_Obj *reportCmd;
Tcl_Obj **evalStub;
Tcl_Obj **textStub;
char *currentNamespace;
int defineToplevel;
int isTextConstraint;
int isAttributeConstaint;
|
> |
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 |
unsigned int patternListSize;
unsigned int forwardPatternDefs;
SchemaQuant *quants;
unsigned int numQuants;
unsigned int quantsSize;
int currentEvals;
int cleanupAfterEval;
int evalError;
Tcl_Obj *reportCmd;
Tcl_Obj **evalStub;
Tcl_Obj **textStub;
char *currentNamespace;
int defineToplevel;
int isTextConstraint;
int isAttributeConstaint;
|
Changes to tests/schema.test.
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
....
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
|
}
}
set ::schema-15.1 ""
set result [s validate {<a><b/></a>} msg]
s delete
lappend result $msg ${::schema-15.1}
set result
} {1 {} ba}
proc schema-15.2-astart {args} {
append ::schema-15.2 astart
}
proc schema-15.2-aend {args} {
append ::schema-15.2 aend
................................................................................
set schema-15.2 ""
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.2}
set result
} {1 {} astartaendastartaend}
test schema-16.1 {interleave} {
tdom::schema s
s define {
defelement doc {
interleave {
element a
element b
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
....
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
|
}
}
set ::schema-15.1 ""
set result [s validate {<a><b/></a>} msg]
s delete
lappend result $msg ${::schema-15.1}
set result
} {1 {} ss}
proc schema-15.2-astart {args} {
append ::schema-15.2 astart
}
proc schema-15.2-aend {args} {
append ::schema-15.2 aend
................................................................................
set schema-15.2 ""
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.2}
set result
} {1 {} astartaendastartaend}
proc schema-15.3 {type cmd} {
lappend ::schema-15.3 $type [$cmd info stack inside]
}
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
} {1 {} astart a aend a astart a aend a}
test schema-16.1 {interleave} {
tdom::schema s
s define {
defelement doc {
interleave {
element a
element b
|