Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Fixed not always poping up of tcl errors in called script during validation. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | wip |
| Files: | files | file ages | folders |
| SHA3-256: |
a43c523416a006f86e1e35852c69c496 |
| User & Date: | rolf 2019-10-26 01:20:27 |
Context
|
2019-10-28
| ||
| 00:33 | Added a test. check-in: fd510a13be user: rolf tags: wip | |
|
2019-10-26
| ||
| 01:20 | Fixed not always poping up of tcl errors in called script during validation. check-in: a43c523416 user: rolf tags: wip | |
|
2019-10-25
| ||
| 00:30 | INVALID_DOM_KEYCONSTRAINT is really not a validation error but a validation script error (as a TCL_ERROR from a called script. Though, the evalError flag isn't respected anywhere, obviously. check-in: a77a3f3b23 user: rolf tags: wip | |
Changes
Changes to generic/schema.c.
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
....
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
|
break;
case m_stack:
if (objc != 3) {
Tcl_WrongNumArgs (interp, 2, objv, "top|inside");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj (interp, objv[3],
schemaInstanceInfoStackMethods,
"method", 0, &methodIndex)
!= TCL_OK) {
return TCL_ERROR;
}
switch ((enum schemaInstanceInfoStackMethod) methodIndex) {
case m_inside:
................................................................................
Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
}
} else {
if (objc == 4) {
Tcl_SetVar (interp, Tcl_GetString (objv[3]),
Tcl_GetStringResult (interp), 0);
}
SetBooleanResult (0);
}
schemaReset (sdata);
break;
case m_domvalidate:
CHECK_EVAL
if (objc < 3 || objc > 4) {
|
|
>
>
>
|
>
|
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
....
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
|
break;
case m_stack:
if (objc != 3) {
Tcl_WrongNumArgs (interp, 2, objv, "top|inside");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj (interp, objv[2],
schemaInstanceInfoStackMethods,
"method", 0, &methodIndex)
!= TCL_OK) {
return TCL_ERROR;
}
switch ((enum schemaInstanceInfoStackMethod) methodIndex) {
case m_inside:
................................................................................
Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
}
} else {
if (objc == 4) {
Tcl_SetVar (interp, Tcl_GetString (objv[3]),
Tcl_GetStringResult (interp), 0);
}
if (sdata->evalError) {
return TCL_ERROR;
} else {
SetBooleanResult (0);
}
}
schemaReset (sdata);
break;
case m_domvalidate:
CHECK_EVAL
if (objc < 3 || objc > 4) {
|
Changes to tests/schema.test.
918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 ... 979 980 981 982 983 984 985 986 987 988 989 990 991 992 .... 5307 5308 5309 5310 5311 5312 5313 5314 5315 5316 5317 5318 5319 5320 5321 .... 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 5338 5339 5340 5341 |
}
set result [list]
foreach xml {
<doc/>
<doc><a/></doc>
<doc><a/><b/></doc>
} {
lappend result [s validate $xml errMsg]
lappend result $errMsg
}
s delete
set result
} {0 {error "This method is not allowed in nested evaluation" at line 1 character 6} 0 {error "This method is not allowed in nested evaluation" at line 1 character 15} 0 {error "This method is not allowed in nested evaluation" at line 1 character 13}}
test schema-4.6 {event start with namespace} {
tdom::schema s
s defelement doc http://tdom.org/test {
element a ! text
}
s event start doc http://tdom.org/test
................................................................................
}
s event start doc http://tdom.org/test
s event start a {{att1 http://tdom.org/test} "some data"} http://tdom.org/test
s event end
s event end
} {}
test schema-5.1 {dom parse -validateCmd} {
set result [catch {
[dom parse -validateCmd tdom::schema <doc/>]
}]
} 1
test schema-5.2 {dom parse -validateCmd} {
................................................................................
catch {s event start unknownElement}
s delete
}
set result
} {a b c d}
proc schema-17.15 {type cmd} {
lappend ::result $type [$cmd info stack ]
}
test schema-17.15 {info inside} {
tdom::schema s
s define {
defelement doc {
element a *
................................................................................
tcl schema-17.15 aend
}
}
set result {}
s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
s delete
set result
} {1 {} astart {a doc} aend a astart a aend a}
proc schema-18 {args} {
lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
tdom::schema s
s define {
|
| | > > > > > > > > > > > > > > > > | | |
918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 ... 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 .... 5323 5324 5325 5326 5327 5328 5329 5330 5331 5332 5333 5334 5335 5336 5337 .... 5343 5344 5345 5346 5347 5348 5349 5350 5351 5352 5353 5354 5355 5356 5357 |
}
set result [list]
foreach xml {
<doc/>
<doc><a/></doc>
<doc><a/><b/></doc>
} {
lappend result [catch {s validate $xml errMsg} errMsg]
lappend result $errMsg
}
s delete
set result
} {1 {error "This method is not allowed in nested evaluation" at line 1 character 6} 1 {error "This method is not allowed in nested evaluation" at line 1 character 15} 1 {error "This method is not allowed in nested evaluation" at line 1 character 13}}
test schema-4.6 {event start with namespace} {
tdom::schema s
s defelement doc http://tdom.org/test {
element a ! text
}
s event start doc http://tdom.org/test
................................................................................
}
s event start doc http://tdom.org/test
s event start a {{att1 http://tdom.org/test} "some data"} http://tdom.org/test
s event end
s event end
} {}
proc schema-4.10 {scmd} {
error "Error raised in schema-4.10"
}
test schema-4.10 {event - tcl error in called script} {
tdom::schema s
s defelement doc {
tcl schema-4.10
element a
}
s event start doc
set result [catch {s event start a} errMsg]
lappend result $errMsg
s delete
set result
} {1 {Error raised in schema-4.10}}
test schema-5.1 {dom parse -validateCmd} {
set result [catch {
[dom parse -validateCmd tdom::schema <doc/>]
}]
} 1
test schema-5.2 {dom parse -validateCmd} {
................................................................................
catch {s event start unknownElement}
s delete
}
set result
} {a b c d}
proc schema-17.15 {type cmd} {
lappend ::result $type [$cmd info stack inside]
}
test schema-17.15 {info inside} {
tdom::schema s
s define {
defelement doc {
element a *
................................................................................
tcl schema-17.15 aend
}
}
set result {}
s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
s delete
set result
} {astart {a doc} aend {a doc} astart {a doc} aend {a doc}}
proc schema-18 {args} {
lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
tdom::schema s
s define {
|