tDOM: Check-in [2e024420ae]

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

Overview

Comment:	Fixed whitespaceImplReplace - correct mistakenly double test for \n and handle (the semi-hidden, because of the end-of-line handling by the parser) \r also. More tests.
Downloads:	Tarball \| ZIP archive \| SQL archive
Timelines:	family \| ancestors \| descendants \| both \| xsdwhitespace
Files:	files \| file ages \| folders
SHA3-256:	2e024420aef2a3a14b005820d66a2700cd5b469170515d0218893fe3ea242241
User & Date:	rolf 2020-06-27 00:07:41

Context

2020-06-27
00:09		Added text constraint command whitespace. check-in: 567b33a968 user: rolf tags: schema
00:07		Fixed whitespaceImplReplace - correct mistakenly double test for \n and handle (the semi-hidden, because of the end-of-line handling by the parser) \r also. More tests. Closed-Leaf check-in: 2e024420ae user: rolf tags: xsdwhitespace
2020-06-22
00:38		Mostly implemented. check-in: 3b1eb55264 user: rolf tags: xsdwhitespace

Changes

Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/schema.xml.

        is <m>xsd</m> then the constraint match if the value is a
        valid xsd:integer. Without argument <m>xsd</m> is the
        default.</desc>
      </commanddef>

      <commanddef>
        <command><cmd>whitespace</cmd> <m>(preserve|replace|collapse)</m> <m>&lt;constraint script></m></command>
        <desc>This text constraint command does whitespace

        normalization to the text value and checks the resulting text
        with the text constraints of the constraint script
        argument.</desc>







      </commanddef>

      <commanddef>
        <command><cmd>negativeInteger</cmd> <m>?(xsd|tcl)?</m></command>
        <desc>This text constraint match the same text values as the
        <m>integer</m> text constraint (see there) with the additional
        constraint that the value must be &lt; zero.</desc>
................................................................................
            <dt>whitespace</dt><dd>The text to split is striped of all
            white space at start and end splited into a list at any
            successive white space.</dd>
            <dt>tcl tclcmd ?arg ...?</dt><dd>The text to split is
            handed to the <m>tclcmd</m>, which is evaluated on global
            level, appended with every given arg and the text to split
            as last argument. This call must return a valid tcl list,
            which elements are tested..</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <m>whitespace</m>.</p></desc>
      </commanddef>
      <commanddef>
        <command><cmd>id</cmd> <m>?keySpace?</m></command>
        <desc>This text constraint command marks the text as a








|
>
|
|
<
>
>
>
>
>
>
>







 







|

        is <m>xsd</m> then the constraint match if the value is a
        valid xsd:integer. Without argument <m>xsd</m> is the
        default.</desc>
      </commanddef>

      <commanddef>
        <command><cmd>whitespace</cmd> <m>(preserve|replace|collapse)</m> <m>&lt;constraint script></m></command>
        <desc>This text constraint command does whitespace (#x20
        (space, ' '), #x9 (tab, \t), #xA (linefeed, \n), and #xD
        (carriage return, \r) normalization to the text value and
        checks the resulting text with the text constraints of the

        constraint script argument. The normalization method
        <m>preserve</m> keeps everything as it is; this is another way
        to say <m>allOf</m>. The <m>replace</m> normalization method
        replaces any single whitespace character (as above) to a
        space. The <m>collapse</m> normalization method removes all
        leading and trailing whitespace and all the other sequences of
        contiguous whitespace are replaced by a single space.</desc>
      </commanddef>

      <commanddef>
        <command><cmd>negativeInteger</cmd> <m>?(xsd|tcl)?</m></command>
        <desc>This text constraint match the same text values as the
        <m>integer</m> text constraint (see there) with the additional
        constraint that the value must be &lt; zero.</desc>
................................................................................
            <dt>whitespace</dt><dd>The text to split is striped of all
            white space at start and end splited into a list at any
            successive white space.</dd>
            <dt>tcl tclcmd ?arg ...?</dt><dd>The text to split is
            handed to the <m>tclcmd</m>, which is evaluated on global
            level, appended with every given arg and the text to split
            as last argument. This call must return a valid tcl list,
            which elements are tested.</dd>
        </dl>
        <p>The default in case no split type argument is given is
        <m>whitespace</m>.</p></desc>
      </commanddef>
      <commanddef>
        <command><cmd>id</cmd> <m>?keySpace?</m></command>
        <desc>This text constraint command marks the text as a

Changes to generic/schema.c.

    SchemaData *sdata;

    sdata = wsdata->sdata;
    p = text;
    c = sdata->wsbuf;
    alloced = sdata->wsbuf + sdata->wsbufLen;
    while (*p) {
        if (*p == '\t' || *p == '\n' || *p == '\n') {
            *c = ' ';
        } else {
            *c = *p;
        }
        c++;
        if (c == alloced) {
            sdata->wsbuf = REALLOC (sdata->wsbuf, 2 * sdata->wsbufLen);
................................................................................
            c = sdata->wsbuf + sdata->wsbufLen;
            sdata->wsbufLen *= 2;
            alloced = sdata->wsbuf + sdata->wsbufLen;
        }
        p++;
    }
    *c = '\0';
    return checkText (interp, wsdata->cp, wsdata->sdata->wsbuf);
}

static int
whitespaceImplCollapse (
    Tcl_Interp *interp,
    void *constraintData,
    char *text

    SchemaData *sdata;

    sdata = wsdata->sdata;
    p = text;
    c = sdata->wsbuf;
    alloced = sdata->wsbuf + sdata->wsbufLen;
    while (*p) {
        if (*p == '\t' || *p == '\n' || *p == '\r') {
            *c = ' ';
        } else {
            *c = *p;
        }
        c++;
        if (c == alloced) {
            sdata->wsbuf = REALLOC (sdata->wsbuf, 2 * sdata->wsbufLen);
................................................................................
            c = sdata->wsbuf + sdata->wsbufLen;
            sdata->wsbufLen *= 2;
            alloced = sdata->wsbuf + sdata->wsbufLen;
        }
        p++;
    }
    *c = '\0';
    return checkText (interp, wsdata->cp, sdata->wsbuf);
}

static int
whitespaceImplCollapse (
    Tcl_Interp *interp,
    void *constraintData,
    char *text

Changes to tests/schema.test.


test schema-14.45 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace preserve {
                oneOf {
                    enumeration foo
                    allOf {
                        minLength 5
                        integer
                    }
                }
            }
        }
................................................................................
} {0 0 1 1 0 0}

test schema-14.46 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace replace {
                enumeration [list "foo bar"]
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
................................................................................
} {0 0 1 1 1 0}

test schema-14.47 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace collapse {
                enumeration [list "foo bar"]
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
................................................................................
} {0 0 1 1 1 1 1 0}

test schema-14.48 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace preserve {
                enumeration [list "foo[string repeat " " 300]bar"]
            }
        }
    }
    set xmls {
        <doc/>
    }
    lappend xmls "<doc>foo[string repeat " " 300]bar</doc>"
................................................................................
    set result [list]
    foreach xml $xmls {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1}





































































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








|







 







|







 







|







 







|







 







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


test schema-14.45 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace preserve {
                oneOf {
                    fixed foo
                    allOf {
                        minLength 5
                        integer
                    }
                }
            }
        }
................................................................................
} {0 0 1 1 0 0}

test schema-14.46 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace replace {
                fixed "foo bar"
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
................................................................................
} {0 0 1 1 1 0}

test schema-14.47 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace collapse {
                fixed "foo bar"
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
................................................................................
} {0 0 1 1 1 1 1 0}

test schema-14.48 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace preserve {
                fixed "foo[string repeat " " 300]bar"
            }
        }
    }
    set xmls {
        <doc/>
    }
    lappend xmls "<doc>foo[string repeat " " 300]bar</doc>"
................................................................................
    set result [list]
    foreach xml $xmls {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1}

test schema-14.49 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace collapse {
                fixed "foo [string repeat "x" 1200]bar"
            }
        }
    }
    set xmls {
        <doc/>
    }
    lappend xmls "<doc>[string repeat " " 300]foo[string repeat " " 300][string repeat "x" 1200]bar[string repeat " " 300]</doc>"
    set result [list]
    foreach xml $xmls {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1}

test schema-14.50 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        element b ! {
            text {
                whitespace replace {
                    fixed "foo[string repeat " " 400]bar"
                }
            }
        }
    }
    set xml <doc> 
    append xml <b> foo [string repeat "&#xA; \t&#xD;" 100] bar </b>
    append xml </doc>
    set result [s validate $xml]
    s delete
    set result
} 1

test schema-14.51 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        element a ! {
            text {
                whitespace collapse {
                    fixed "foo [string repeat "x" 1200]bar"
                }
            }
        }
        element b ! {
            text {
                whitespace replace {
                    fixed "foo[string repeat " " 8000]bar"
                }
            }
        }
    }
    set xml <doc> 
    append xml <a> [string repeat " " 20] foo " " [string repeat x 1200] bar \
        [string repeat " " 8000] </a>
    append xml <b> foo [string repeat "&#xA; \t&#xD;" 2000] bar </b>
    append xml </doc>
    set result [s validate $xml]
    s delete
    set result
} 1

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