tDOM

Check-in [b6738cb9c3]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Added text constraint command strip which tests all text constraints in the evaluated argument with the text to test striped of all white space at start and end.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: b6738cb9c3c9eb271d43752a1b2e1c63bc311c840590e749ddc003167f8fa424
User & Date: rolf 2019-04-27 00:38:55
Context
2019-04-27
00:50
Added documentation for the strip text constraint command. check-in: d441a1e8b1 user: rolf tags: schema
00:38
Added text constraint command strip which tests all text constraints in the evaluated argument with the text to test striped of all white space at start and end. check-in: b6738cb9c3 user: rolf tags: schema
00:33
Prepare for more converters to come. check-in: fd2f1e3238 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

4074
4075
4076
4077
4078
4079
4080
























































4081
4082
4083
4084
4085
4086
4087
....
4158
4159
4160
4161
4162
4163
4164


4165
4166
4167
4168
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = checkText;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    return TCL_ERROR;
}

























































void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          maxLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::minLength",
                          minLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::oneOf",
                          oneOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::allOf",
                          allOfTCObjCmd, NULL, NULL);


}


#endif  /* #ifndef TDOM_NO_SCHEMA */






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







 







>
>




4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
....
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = checkText;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    return TCL_ERROR;
}

static int
stripImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    SchemaCP *cp = (SchemaCP *) constraintData;
    int rc, restore = 0;
    char *end, saved;

    while(isspace((unsigned char)*text)) text++;
    if(*text != 0) {
        /* Not white space only */
        /* Trim trailing space */
        end = text + strlen(text) - 1;
        while(end > text && isspace((unsigned char)*end)) end--;
        saved = end[1];
        restore = 1;
        end[1] = '\0';
    }
    rc = checkText (interp, cp, text);
    if (restore) end[1] = saved;
    return rc;
}

static int
stripTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaCP *cp;
    SchemaConstraint *sc;
    int rc;

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (2,2,"Expected: <text constraint script>");
    
    cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
    cp->type = SCHEMA_CTYPE_TEXT;
    REMEMBER_PATTERN (cp)
    rc = evalConstraints (interp, sdata, cp, objv[1]);
    if (rc == TCL_OK) {
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = stripImpl;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    return TCL_ERROR;
}

void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    /* Inline definition commands. */
................................................................................
                          maxLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::minLength",
                          minLengthTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::oneOf",
                          oneOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::allOf",
                          allOfTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::strip",
                          stripTCObjCmd, NULL, NULL);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to tests/schema.test.

3170
3171
3172
3173
3174
3175
3176
































3177
3178
3179
3180
3181
3182
3183
        {<doc xmlns:ns1="http://tdom.org/test"><e ns1:and="this" ns1:this="12345alkajsdlfjkals"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 1 0 0 0}

































test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b






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







3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
        {<doc xmlns:ns1="http://tdom.org/test"><e ns1:and="this" ns1:this="12345alkajsdlfjkals"/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 1 0 0 0}

test schema-14.21 {strip} {
    tdom::schema s
    s define {
        defelement a {
            text {
                strip {
                    minLength 3
                    maxLength 5
                }
            }
        }
    }
    set result [list]
    foreach xml {
        <a/>
        <a></a>
        {<a> </a>}
        {<a>  3  </a>}
        {<a>123</a>}
        {<a> 123    </a>}
        {<a>  123   </a>}
        {<a>1234</a>}
        {<a>12345</a>}
        {<a>123456</a>}
        {<a> 12 34 </a>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 1 1 1 1 1 0 1}

test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b