tDOM

Check-in [71d80fea6e]
Login

Check-in [71d80fea6e]

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
Timelines: family | ancestors | descendants | both | virtualConstraints
Files: files | file ages | folders
SHA3-256: 71d80fea6e44e7ac371759239416719849e846fe2b491f714bbc6b0c730214d8
User & Date: rolf 2019-03-07 13:42:32.710
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
Unified Diff Ignore Whitespace Patch
Changes to generic/schema.c.
︙︙
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

    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];








|








375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

    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];
︙︙
729
730
731
732
733
734
735

736
737
738
739
740
741
742

{
    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 (








>








729
730
731
732
733
734
735
736
737
738
739
740
741
742
743

{
    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 (
︙︙
1068
1069
1070
1071
1072
1073
1074

1075
1076
1077
1078
1079

1080
1081
1082
1083
1084
1085
1086

        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








>
|
|
|
|
|
>








1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089

        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
︙︙
1960
1961
1962
1963
1964
1965
1966

1967
1968
1969
1970
1971
1972
1973

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,








>








1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977

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,
︙︙
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072

            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:








|








2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076

            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

        }
    }
    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








|








3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194

        }
    }
    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
︙︙
3210
3211
3212
3213
3214
3215
3216
























3217
3218
3219
3220
3221
3222
3223

    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








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








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.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
︙︙