Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Added text constraint command length. |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | schema |
| Files: | files | file ages | folders |
| SHA3-256: |
cc382337fc4e00fbf13e1c426e28831f |
| User & Date: | rolf 2020-08-01 23:33:55 |
Context
|
2020-08-02
| ||
| 23:37 | Added test. Leaf check-in: fc793568d2 user: rolf tags: schema | |
|
2020-08-01
| ||
| 23:33 | Added text constraint command length. check-in: cc382337fc user: rolf tags: schema | |
|
2020-07-31
| ||
| 10:59 | Minor documentation and test suite work. check-in: a14c1bb515 user: rolf tags: schema | |
Changes
Changes to doc/schema.xml.
1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 |
<url>https://www.tcl.tk/man/tcl8.6/TclCmd/string.htm#M35</url>.</desc>
</commanddef>
<commanddef>
<command><cmd>regexp</cmd> <m>expression</m></command>
<desc>This text constraint match if the text value match the
regular expression given as argument. <url>https://www.tcl.tk/man/tcl8.6/TclCmd/re_syntax.htm</url> describes the regular expression syntax</desc>
</commanddef>
<commanddef>
<command><cmd>maxLength</cmd> <m>length</m></command>
<desc>This text constraint match if the length of the text
value (in characters, not bytes) is at most <m>length</m>. The
length argument must be an integer greater zero.</desc>
</commanddef>
<commanddef>
|
> > > > > > |
1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 |
<url>https://www.tcl.tk/man/tcl8.6/TclCmd/string.htm#M35</url>.</desc>
</commanddef>
<commanddef>
<command><cmd>regexp</cmd> <m>expression</m></command>
<desc>This text constraint match if the text value match the
regular expression given as argument. <url>https://www.tcl.tk/man/tcl8.6/TclCmd/re_syntax.htm</url> describes the regular expression syntax</desc>
</commanddef>
<commanddef>
<command><cmd>length</cmd> <m>length</m></command>
<desc>This text constraint match if the length of the text
value (in characters, not bytes) is <m>length</m>. The
length argument must be a positive integer or zero.</desc>
</commanddef>
<commanddef>
<command><cmd>maxLength</cmd> <m>length</m></command>
<desc>This text constraint match if the length of the text
value (in characters, not bytes) is at most <m>length</m>. The
length argument must be an integer greater zero.</desc>
</commanddef>
<commanddef>
|
Changes to generic/schema.c.
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
8421
8422
8423
8424
....
8634
8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
|
CHECK_TI
checkNrArgs (1,1,"No arguments expected");
ADD_CONSTRAINT (sdata, sc)
sc->constraint = durationImpl;
return TCL_OK;
}
static int
dateObjCmd (
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
................................................................................
unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
setvarTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::whitespace",
whitespaceTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::not",
notTCObjCmd, (ClientData) 3, NULL);
/* Exposed text type commands */
Tcl_CreateObjCommand (interp,"tdom::type::date",
dateObjCmd, NULL, NULL);
Tcl_CreateObjCommand (interp,"tdom::type::dateTime",
dateTimeObjCmd, NULL, NULL);
Tcl_CreateObjCommand (interp,"tdom::type::time",
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
8411
8412
8413
8414
8415
8416
8417
8418
8419
8420
8421
8422
8423
8424
8425
8426
8427
8428
8429
8430
8431
8432
8433
8434
8435
8436
8437
8438
8439
8440
8441
8442
8443
8444
8445
8446
8447
8448
8449
8450
8451
8452
8453
8454
8455
8456
8457
8458
8459
8460
8461
8462
8463
8464
8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
....
8684
8685
8686
8687
8688
8689
8690
8691
8692
8693
8694
8695
8696
8697
8698
8699
|
CHECK_TI
checkNrArgs (1,1,"No arguments expected");
ADD_CONSTRAINT (sdata, sc)
sc->constraint = durationImpl;
return TCL_OK;
}
static int
lengthImpl (
Tcl_Interp *interp,
void *constraintData,
char *text
)
{
unsigned int length = PTR2UINT(constraintData);
int len = 0, clen;
while (*text != '\0') {
clen = UTF8_CHAR_LEN (*text);
if (!clen) {
SetResult ("Invalid UTF-8 character");
return 0;
}
len++;
if (len > length) return 0;
text += clen;
}
if (len == length) return 1;
return 0;
}
static int
lengthTCObjCmd (
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
)
{
SchemaData *sdata = GETASI;
SchemaConstraint *sc;
int len;
CHECK_TI
checkNrArgs (2,2,"Expected: <length as integer>");
if (Tcl_GetIntFromObj (interp, objv[1], &len) != TCL_OK) {
SetResult ("Expected: <length as integer>");
return TCL_ERROR;
}
if (len < 0) {
SetResult ("The length must be at least 0");
}
ADD_CONSTRAINT (sdata, sc)
sc->constraint = lengthImpl;
sc->constraintData = UINT2PTR(len);
return TCL_OK;
}
static int
dateObjCmd (
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[]
................................................................................
unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
setvarTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::whitespace",
whitespaceTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::not",
notTCObjCmd, (ClientData) 3, NULL);
Tcl_CreateObjCommand (interp,"tdom::schema::text::length",
lengthTCObjCmd, (ClientData) 3, NULL);
/* Exposed text type commands */
Tcl_CreateObjCommand (interp,"tdom::type::date",
dateObjCmd, NULL, NULL);
Tcl_CreateObjCommand (interp,"tdom::type::dateTime",
dateTimeObjCmd, NULL, NULL);
Tcl_CreateObjCommand (interp,"tdom::type::time",
|
Changes to tests/schema.test.
6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 |
"<doc>T15:20:17.0-02:00 </doc>"
} {
lappend result [s validate $xml]
}
s delete
set result
} {0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0}
test schema-15.1 {constraint cmd tcl} {
tdom::schema s
s define {
defelement a {
tcl append ::schema-15.1 [self]
element b
|
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
6024 6025 6026 6027 6028 6029 6030 6031 6032 6033 6034 6035 6036 6037 6038 6039 6040 6041 6042 6043 6044 6045 6046 6047 6048 6049 6050 6051 6052 6053 6054 6055 6056 6057 6058 6059 6060 6061 6062 6063 6064 6065 6066 6067 6068 6069 6070 6071 6072 6073 6074 6075 6076 6077 6078 6079 6080 6081 6082 6083 6084 6085 6086 |
"<doc>T15:20:17.0-02:00 </doc>"
} {
lappend result [s validate $xml]
}
s delete
set result
} {0 0 0 0 1 1 1 1 1 1 1 0 0 0 0 0 0 1 0 0 0 1 1 0 1 0 0}
test schema-14.56 {length} {
tdom::schema s
s defelement doc {
element e ! {
text {length 2}
}
}
set result [list]
foreach xml {
<doc><e/></doc>
<doc><e></e></doc>
{<doc><e>1</e></doc>}
{<doc><e>12</e></doc>}
{<doc><e> </e></doc>}
{<doc><e>123</e></doc>}
{<doc><e>1ሴ</e></doc>}
} {
lappend result [s validate $xml]
set rc [catch {dom parse -validateCmd s $xml doc}]
if {$rc == 0} {
$doc delete
}
lappend result $rc
}
s delete
set result
} {0 1 0 1 0 1 1 0 1 0 0 1 1 0}
test schema-14.57 {length} {
tdom::schema s
s defelement doc {
element e ! {
text {length 0}
}
}
set result [list]
foreach xml {
<doc><e/></doc>
<doc><e></e></doc>
{<doc><e>1</e></doc>}
{<doc><e>12</e></doc>}
{<doc><e> </e></doc>}
} {
lappend result [s validate $xml]
}
s delete
set result
} {1 1 0 0 0}
test schema-15.1 {constraint cmd tcl} {
tdom::schema s
s define {
defelement a {
tcl append ::schema-15.1 [self]
element b
|