tDOM

Check-in [7319d6926f]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:More gardening towards reportcmd.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | wip
Files: files | file ages | folders
SHA3-256: 7319d6926f2a6979777d56a415e0ce93a74d5fc4081cf93e151f499b00418378
User & Date: rolf 2019-03-30 01:31:58
Context
2019-04-15
23:20
More work on validation error recovering. check-in: a5c155ee31 user: rolf tags: wip
2019-03-30
01:31
More gardening towards reportcmd. check-in: 7319d6926f user: rolf tags: wip
2019-03-29
00:35
wip check-in: 1f800e1c4b user: rolf tags: wip
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
....
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
....
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
....
3190
3191
3192
3193
3194
3195
3196

3197
3198
3199
3200
3201
3202
3203
                Tcl_AppendResult (interp, namespace, ":", NULL);
            }
            Tcl_AppendResult (interp, name, "\"", NULL);
            return TCL_ERROR;
        }
    } else {
        if (!pattern) {
            SetResult ("Unknown element");
            if (recover (interp, sdata, S("UNKNOWN_DOKUMENT_ELEMENT"))) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            
            return TCL_ERROR;
        }
        pushToStack (sdata, pattern);
        sdata->validationState = VALIDATION_STARTED;
        return TCL_OK;
    }

................................................................................
    SchemaData *sdata;
    char *namespace;
    const char *s;
    int i = 0;

    DBG(fprintf (stderr, "startElement: '%s'\n", name);)
    sdata = vdata->sdata;
    if (!sdata->skipDeep && sdata->stack &&
        (Tcl_DStringLength (vdata->cdata)
         || sdata->stack->pattern->flags & CONSTRAINT_TEXT_CHILD)) {
        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
................................................................................
    SchemaData *sdata;
    
    DBG(fprintf (stderr, "endElement: '%s'\n", name);)
    sdata = vdata->sdata;
    if (sdata->validationState == VALIDATION_ERROR) {
        return;
    }
    if (!sdata->skipDeep && sdata->stack &&
        (Tcl_DStringLength (vdata->cdata)
         || sdata->stack->pattern->flags & CONSTRAINT_TEXT_CHILD)) {
        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
................................................................................
        pattern->type = SCHEMA_CTYPE_TEXT;
    } else {
        h = Tcl_FindHashEntry (&sdata->textDef, Tcl_GetString (objv[2]));
        if (!h) {
            SetResult3 ("Unknown text type \"", Tcl_GetString (objv[2]), "\"");
            return TCL_ERROR;
        }

        pattern = (SchemaCP *) Tcl_GetHashValue (h);
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    if (objc < 3) {
        REMEMBER_PATTERN (pattern)
    }
    addToContent (sdata, pattern, quant, 0, 0);






<




|







 







|
<
<







 







|
<
<







 







>







1095
1096
1097
1098
1099
1100
1101

1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
....
1754
1755
1756
1757
1758
1759
1760
1761


1762
1763
1764
1765
1766
1767
1768
....
1816
1817
1818
1819
1820
1821
1822
1823


1824
1825
1826
1827
1828
1829
1830
....
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
                Tcl_AppendResult (interp, namespace, ":", NULL);
            }
            Tcl_AppendResult (interp, name, "\"", NULL);
            return TCL_ERROR;
        }
    } else {
        if (!pattern) {

            if (recover (interp, sdata, S("UNKNOWN_DOKUMENT_ELEMENT"))) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            SetResult ("Unknown element");
            return TCL_ERROR;
        }
        pushToStack (sdata, pattern);
        sdata->validationState = VALIDATION_STARTED;
        return TCL_OK;
    }

................................................................................
    SchemaData *sdata;
    char *namespace;
    const char *s;
    int i = 0;

    DBG(fprintf (stderr, "startElement: '%s'\n", name);)
    sdata = vdata->sdata;
    if (!sdata->skipDeep && sdata->stack && Tcl_DStringLength (vdata->cdata)) {


        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
................................................................................
    SchemaData *sdata;
    
    DBG(fprintf (stderr, "endElement: '%s'\n", name);)
    sdata = vdata->sdata;
    if (sdata->validationState == VALIDATION_ERROR) {
        return;
    }
    if (!sdata->skipDeep && sdata->stack && Tcl_DStringLength (vdata->cdata)) {


        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
................................................................................
        pattern->type = SCHEMA_CTYPE_TEXT;
    } else {
        h = Tcl_FindHashEntry (&sdata->textDef, Tcl_GetString (objv[2]));
        if (!h) {
            SetResult3 ("Unknown text type \"", Tcl_GetString (objv[2]), "\"");
            return TCL_ERROR;
        }
        quant = SCHEMA_CQUANT_ONE;
        pattern = (SchemaCP *) Tcl_GetHashValue (h);
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    if (objc < 3) {
        REMEMBER_PATTERN (pattern)
    }
    addToContent (sdata, pattern, quant, 0, 0);

Changes to tests/schema.test.

3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
....
3806
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
....
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
3885
3886
3887
3888
    s delete
    set result
} {a b}

proc schema-18 {args} {
    lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element e
            text {minLength 1}
            element e
        }
................................................................................
    set result ""
    set rc [s validate {<doc><a/><c/></doc>}]
    lappend result $rc
    s delete
    set result
} {s MISSING_CP 1}

test schema-18.3 {reportcmd} {knownBug} {
    tdom::schema s
    s define {
        defelement doc {
            element a
        }
    }
    s reportcmd schema-18
    set result ""
    foreach xml {
        <foo/>
        <bar>baz</bar>

        <bar><a><b/></a></bar>
    } {
        set rc [s validate $xml]
        lappend result $rc
    }
    s delete
    set result
} {s MISSING_CP 1}

proc validatedSAX {g xml {keepEmpties 1}} {
    set args [list -validateCmd $g]
    if {!$keepEmpties} {
        lappend args -ignorewhitespace 1
    }
    xml::parser p {*}$args
................................................................................
    set doc [dom parse $xml]
    set rc [$g domvalidate $doc errMsg]
    $doc delete
    return $rc
}


test schema-18.4 {reportcmd} {knownBug} {
    tdom::schema s
    s define {
        defelement doc {
            element a
        }
    }
    s reportcmd schema-18
    set result ""
    foreach xml {
        <foo/>
        <bar>baz</bar>
        <bar><a><b/></a></bar>
    } {
        set rc [s validate $xml]
        lappend result $rc
    }
    s delete
    set result
} {s MISSING_CP 1}

}






|







 







|











>







|







 







<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
....
3806
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
....
3861
3862
3863
3864
3865
3866
3867





3868
















    s delete
    set result
} {a b}

proc schema-18 {args} {
    lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {knownBug} {
    tdom::schema s
    s define {
        defelement doc {
            element e
            text {minLength 1}
            element e
        }
................................................................................
    set result ""
    set rc [s validate {<doc><a/><c/></doc>}]
    lappend result $rc
    s delete
    set result
} {s MISSING_CP 1}

test schema-18.3 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element a
        }
    }
    s reportcmd schema-18
    set result ""
    foreach xml {
        <foo/>
        <bar>baz</bar>
        <bar>baz<a/>grill</bar>
        <bar><a><b/></a></bar>
    } {
        set rc [s validate $xml]
        lappend result $rc
    }
    s delete
    set result
} {s UNKNOWN_DOKUMENT_ELEMENT 1 s UNKNOWN_DOKUMENT_ELEMENT 1 s UNKNOWN_DOKUMENT_ELEMENT 1 s UNKNOWN_DOKUMENT_ELEMENT 1}

proc validatedSAX {g xml {keepEmpties 1}} {
    set args [list -validateCmd $g]
    if {!$keepEmpties} {
        lappend args -ignorewhitespace 1
    }
    xml::parser p {*}$args
................................................................................
    set doc [dom parse $xml]
    set rc [$g domvalidate $doc errMsg]
    $doc delete
    return $rc
}







}