Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | wip |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | wip |
| Files: | files | file ages | folders |
| SHA3-256: |
a858a6ac777f36397ded12bb47511bdc |
| User & Date: | rolf 2019-05-01 14:56:13 |
Context
|
2019-05-01
| ||
| 23:55 | wip check-in: a155f2862c user: rolf tags: wip | |
| 14:56 | wip check-in: a858a6ac77 user: rolf tags: wip | |
|
2019-04-27
| ||
| 00:50 | Added documentation for the strip text constraint command. check-in: d441a1e8b1 user: rolf tags: schema | |
Changes
Changes to generic/schema.c.
97 98 99 100 101 102 103 104 105 106 107 108 109 110 .... 3352 3353 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 .... 4086 4087 4088 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 .... 4130 4131 4132 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 .... 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 |
#define SetResult3(str1,str2,str3) Tcl_ResetResult(interp); \
Tcl_AppendResult(interp, (str1), (str2), (str3), NULL)
#define SetIntResult(i) Tcl_ResetResult(interp); \
Tcl_SetIntObj(Tcl_GetObjResult(interp), (i))
#define SetBooleanResult(i) Tcl_ResetResult(interp); \
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (i))
#define checkNrArgs(l,h,err) if (objc < l || objc > h) { \
SetResult (err); \
return TCL_ERROR; \
}
#if defined(DEBUG) || defined(DDEBUG)
static char *Schema_CP_Type2str[] = {
................................................................................
Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
tcdata->sdata->currentEvals++;
result = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
TCL_EVAL_GLOBAL);
tcdata->sdata->currentEvals--;
Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
if (result != TCL_OK) {
return 0;
}
result = Tcl_GetBooleanFromObj (interp, Tcl_GetObjResult (interp), &bool);
if (result != TCL_OK) {
return 0;
}
if (bool) {
................................................................................
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;
................................................................................
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. */
................................................................................
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 */
|
> > > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 .... 3354 3355 3356 3357 3358 3359 3360 3361 3362 3363 3364 3365 3366 3367 3368 .... 4089 4090 4091 4092 4093 4094 4095 4096 4097 4098 4099 4100 4101 4102 4103 4104 4105 4106 4107 4108 .... 4133 4134 4135 4136 4137 4138 4139 4140 4141 4142 4143 4144 4145 4146 4147 4148 4149 4150 4151 4152 4153 4154 4155 4156 4157 4158 4159 4160 4161 4162 4163 4164 4165 4166 4167 4168 4169 4170 4171 4172 4173 4174 4175 4176 4177 4178 4179 4180 4181 4182 4183 4184 4185 4186 4187 4188 4189 4190 4191 4192 4193 4194 4195 4196 4197 4198 4199 4200 4201 4202 4203 4204 4205 4206 4207 4208 4209 4210 4211 4212 4213 4214 4215 4216 4217 4218 4219 4220 4221 4222 4223 4224 4225 4226 4227 4228 4229 4230 4231 4232 4233 4234 4235 4236 4237 4238 4239 4240 4241 4242 4243 4244 4245 4246 4247 4248 4249 4250 4251 4252 4253 4254 4255 4256 4257 4258 4259 4260 4261 4262 4263 4264 4265 4266 4267 4268 4269 4270 4271 4272 4273 4274 4275 4276 4277 4278 4279 4280 4281 4282 4283 4284 4285 4286 4287 4288 4289 4290 4291 4292 4293 4294 4295 4296 4297 4298 4299 4300 4301 4302 4303 4304 4305 4306 4307 4308 4309 4310 4311 4312 4313 4314 4315 4316 4317 4318 4319 4320 4321 4322 4323 .... 4396 4397 4398 4399 4400 4401 4402 4403 4404 4405 4406 4407 4408 |
#define SetResult3(str1,str2,str3) Tcl_ResetResult(interp); \
Tcl_AppendResult(interp, (str1), (str2), (str3), NULL)
#define SetIntResult(i) Tcl_ResetResult(interp); \
Tcl_SetIntObj(Tcl_GetObjResult(interp), (i))
#define SetBooleanResult(i) Tcl_ResetResult(interp); \
Tcl_SetBooleanObj(Tcl_GetObjResult(interp), (i))
#define SPACE(c) ((c) == ' ' || (c) == '\n' || (c )== '\t' || (c) == '\r')
#define checkNrArgs(l,h,err) if (objc < l || objc > h) { \
SetResult (err); \
return TCL_ERROR; \
}
#if defined(DEBUG) || defined(DDEBUG)
static char *Schema_CP_Type2str[] = {
................................................................................
Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
tcdata->sdata->currentEvals++;
result = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
TCL_EVAL_GLOBAL);
tcdata->sdata->currentEvals--;
Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
if (result != TCL_OK) {
tcdata->sdata->evalError = 1;
return 0;
}
result = Tcl_GetBooleanFromObj (interp, Tcl_GetObjResult (interp), &bool);
if (result != TCL_OK) {
return 0;
}
if (bool) {
................................................................................
char *text
)
{
SchemaCP *cp = (SchemaCP *) constraintData;
int rc, restore = 0;
char *end, saved;
while(SPACE((unsigned char)*text)) text++;
if(*text != 0) {
/* Not white space only */
/* Trim trailing space */
end = text + strlen(text) - 1;
while(end > text && SPACE((unsigned char)*end)) end--;
saved = end[1];
restore = 1;
end[1] = '\0';
}
rc = checkText (interp, cp, text);
if (restore) end[1] = saved;
return rc;
................................................................................
ADD_CONSTRAINT (sdata, sc)
sc->constraint = stripImpl;
sc->constraintData = (void *)cp;
return TCL_OK;
}
return TCL_ERROR;
}
static int
splitWhitespaceImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
SchemaCP *cp = (SchemaCP *) constraintData;
int rc = 0;
char *p, *end, saved = 0;
fprintf (stderr, "hier: '%s' -->", text);
p = text;
while (*p != 0) {
while(SPACE (*p)) p++;
if (*p == 0) break;
end = p; end++;
while (*end != 0 && !SPACE(*end)) end++;
saved = *end;
*end = 0;
fprintf (stderr, " '%s'", p);
rc = checkText (interp, cp, p);
*end = saved;
p = end;
if (!rc) break;
}
fprintf (stderr, "\n");
return rc;
}
typedef struct
{
int nrArg;
Tcl_Obj **evalStub;
SchemaData *sdata;
SchemaCP *cp;
} splitTclTCData;
static int
splitTclImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
splitTclTCData *tcdata = (splitTclTCData *) constraintData;
int rc, listlen, i;
Tcl_Obj *list, *listelm;
fprintf (stderr, "HIIIER nrArg: %d\n", tcdata->nrArg);
tcdata->evalStub[tcdata->nrArg-1] = Tcl_NewStringObj(text, -1);
Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
tcdata->sdata->currentEvals++;
rc = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
TCL_EVAL_GLOBAL);
tcdata->sdata->currentEvals--;
Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
if (rc != TCL_OK) {
fprintf (stderr, "EvalError: %s\n", Tcl_GetStringResult (interp));
tcdata->sdata->evalError = 1;
return 0;
}
list = Tcl_GetObjResult (interp);
Tcl_IncrRefCount (list);
Tcl_ResetResult (interp);
if (Tcl_ListObjLength (interp, list, &listlen) != TCL_OK) {
Tcl_DecrRefCount (list);
tcdata->sdata->evalError = 1;
return 0;
}
rc = 1;
for (i = 0; i < listlen; i++) {
Tcl_ListObjIndex (interp, list, i, &listelm);
rc = checkText (interp, tcdata->cp, Tcl_GetString (listelm));
if (!rc) break;
}
Tcl_DecrRefCount (list);
return rc;
}
static void
splitTclImplFree (
void *constraintData
)
{
splitTclTCData *tcdata = constraintData;
int i;
for (i = 0; i < tcdata->nrArg-1; i++) {
Tcl_DecrRefCount (tcdata->evalStub[i]);
}
FREE (tcdata->evalStub);
FREE (tcdata);
}
static int
splitTCObjCmd (
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
)
{
SchemaData *sdata = GETASI;
SchemaCP *cp;
SchemaConstraint *sc;
int methodIndex, rc, i;
splitTclTCData *tcdata;
static const char *methods[] = {
"whitespace", "tcl", NULL
};
enum method {
m_whitespace, m_tcl
};
CHECK_TI
CHECK_TOPLEVEL
if (objc < 2) {
SetResult("Expected: ?type ?args?? <text constraint script>");
return TCL_ERROR;
}
if (objc == 2) {
methodIndex = m_whitespace;
} else {
if (Tcl_GetIndexFromObj (interp, objv[1], methods, "type", 0,
&methodIndex) != TCL_OK) {
fprintf (stderr, "HIIIER %d\n", objc);
return TCL_ERROR;
}
}
switch ((enum method) methodIndex) {
case m_whitespace:
if (objc > 2) {
SetResult ("Type whitespace expects no argument.");
return TCL_ERROR;
}
break;
case m_tcl:
if (objc < 3) {
SetResult ("Expected: tclcmd ?arg ...?.");
return TCL_ERROR;
}
}
cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
cp->type = SCHEMA_CTYPE_TEXT;
REMEMBER_PATTERN (cp)
rc = evalConstraints (interp, sdata, cp, objv[objc-1]);
if (rc != TCL_OK) {
return TCL_ERROR;
}
ADD_CONSTRAINT (sdata, sc)
switch ((enum method) methodIndex) {
case m_whitespace:
sc->constraint = splitWhitespaceImpl;
sc->constraintData = cp;
break;
case m_tcl:
sc->constraint = splitTclImpl;
sc->freeData = splitTclImplFree;
tcdata = TMALLOC (splitTclTCData);
tcdata->nrArg = objc - 2;
tcdata->evalStub = MALLOC (sizeof (Tcl_Obj*) * (objc-1));
for (i = 2; i < objc; i++) {
tcdata->evalStub[i-2] = objv[i];
Tcl_IncrRefCount (tcdata->evalStub[i-2]);
}
tcdata->sdata = sdata;
tcdata->cp = cp;
sc->constraintData = tcdata;
}
return TCL_OK;
}
void
tDOM_SchemaInit (
Tcl_Interp *interp
)
{
/* Inline definition commands. */
................................................................................
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);
Tcl_CreateObjCommand (interp,"tdom::schema::text::split",
splitTCObjCmd, NULL, NULL);
}
#endif /* #ifndef TDOM_NO_SCHEMA */
|
Changes to tests/schema.test.
3202 3203 3204 3205 3206 3207 3208 3209 3210 3211 3212 3213 3214 3215 |
{<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
|
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
3202 3203 3204 3205 3206 3207 3208 3209 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 3248 3249 3250 3251 3252 3253 3254 3255 3256 3257 3258 3259 3260 3261 3262 3263 3264 3265 3266 3267 3268 3269 3270 3271 3272 3273 3274 3275 3276 3277 3278 3279 3280 3281 3282 3283 3284 3285 3286 3287 3288 3289 3290 |
{<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-14.22 {split} {
tdom::schema s
s define {
defelement doc {
element a 1 {
text {
split {
number
}
}
}
}
}
set result [list]
foreach xml {
<doc><a/></doc>
<doc><a></a></doc>
{<doc><a> </a></doc>}
{<doc><a>1</a></doc>}
{<doc><a>-2.1</a></doc>}
{<doc><a> -2.1
</a></doc>}
{<doc><a>-a</a></doc>}
{<doc><a>-a b c</a></doc>}
{<doc><a> 1 2 3.5</a></doc>}
{<doc><a> 1 a 3.5</a></doc>}
{<doc><a>1 2 fooo</a></doc>}
{<doc><a>1 2 fooo </a></doc>}
} {
lappend result [s validate $xml]
}
s delete
set result
} {0 0 0 1 1 1 0 0 1 0 0 0}
proc schema-14.23 {text} {
return [split $text]
}
test schema-14.23 {split} {
tdom::schema s
s define {
defelement doc {
element a 1 {
text {
split tcl schema-14.23 {
number
}
}
}
}
}
set result [list]
foreach xml {
<doc><a/></doc>
<doc><a></a></doc>
{<doc><a> </a></doc>}
{<doc><a>1</a></doc>}
{<doc><a>-2.1</a></doc>}
{<doc><a> -2.1
</a></doc>}
{<doc><a>-a</a></doc>}
{<doc><a>-a b c</a></doc>}
{<doc><a>- 1 2 3.5</a></doc>}
{<doc><a>- 1 a 3.5</a></doc>}
{<doc><a>-1 2 fooo</a></doc>}
{<doc><a>-1 2 fooo </a></doc>}
} {
lappend result [s validate $xml errMsg]
puts $errMsg
}
s delete
set result
} {0 0 1 1 1 1 0 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
|