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

Overview
Comment:Mostly implemented.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | xsdwhitespace
Files: files | file ages | folders
SHA3-256: 3b1eb552648adb100cd0a03e81732f263befe846f557c471164cbc977ed07d64
User & Date: rolf 2020-06-22 00:38:16
Context
2020-06-27
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
2020-06-13
15:09
Started. check-in: 6c467a9d1f user: rolf tags: xsdwhitespace
Changes

Changes to doc/schema.xml.

793
794
795
796
797
798
799








800
801
802
803
804
805
806
        is <m>tcl</m> everthing that returns TCL_OK if feeded into
        Tcl_GetInt() matches. If the optional argument to the command
        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>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>
      </commanddef>
      







>
>
>
>
>
>
>
>







793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
        is <m>tcl</m> everthing that returns TCL_OK if feeded into
        Tcl_GetInt() matches. If the optional argument to the command
        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>
      </commanddef>
      

Changes to generic/schema.c.

80
81
82
83
84
85
86



87
88
89
90
91
92
93
...
765
766
767
768
769
770
771



772
773
774
775
776
777
778
....
7980
7981
7982
7983
7984
7985
7986


















7987

















7988












7989



7990







































7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002

8003







8004
8005
8006




8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017

8018
8019
8020
8021
8022




8023
8024
8025
8026
8027
8028
8029





8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
....
8188
8189
8190
8191
8192
8193
8194
8195
8196
8197
8198
8199
8200
#endif
#ifndef URI_BUFFER_LEN_INIT
#  define URI_BUFFER_LEN_INIT 128
#endif
#ifndef ATTR_ARRAY_INIT
#  define ATTR_ARRAY_INIT 4
#endif




/*----------------------------------------------------------------------------
|   Local defines
|
\---------------------------------------------------------------------------*/
#ifndef O_BINARY
# ifdef _O_BINARY
................................................................................
        ks = Tcl_GetHashValue (h);
        if (ks->active) {
            Tcl_DeleteHashTable (&ks->ids);
        }
        FREE (ks);
    }
    Tcl_DeleteHashTable (&sdata->keySpaces);



    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from
................................................................................
    sc->freeData = setvarImplFree;
    sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
    return TCL_OK;
}

typedef struct
{


















    char *buf;

















    int   allocedLen;












} whitespaceTCData;











































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









    CHECK_TI
    checkNrArgs (3,3,"(\"preserve\"|\"replace\"|\"collapse\") "
                 "<text constraint script>");




    cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
    cp->type = SCHEMA_CTYPE_TEXT;
    REMEMBER_PATTERN (cp)
    switch (Tcl_GetString(objv[1])[0]) {
    case 'p':
        if (strcmp(Tcl_GetString (objv[0]), "preserve")) {
            checkNrArgs (3,3,"(\"preserve\"|\"replace\"|\"collapse\") "
                         "<text constraint script>");
        }
        rc = evalConstraints (interp, sdata, cp, objv[2]);
        if (rc == TCL_OK) {

            ADD_CONSTRAINT (sdata, sc)
            sc->constraint = checkText;
            sc->constraintData = (void *)cp;
            return TCL_OK;
        }




        return TCL_ERROR;
        break;
    case 'r':
        if (strcmp(Tcl_GetString (objv[0]), "replace")) {
            checkNrArgs (3,3,"(\"preserve\"|\"replace\"|\"collapse\") "
                         "<text constraint script>");
        }





        break;
    case 'c':
        if (strcmp(Tcl_GetString (objv[0]), "collapse")) {
            checkNrArgs (3,3,"(\"preserve\"|\"replace\"|\"collapse\") "
                         "<text constraint script>");
        }
        break;
    default:
        break;
    }
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = setvarImpl;
    sc->freeData = setvarImplFree;
    sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
    return TCL_OK;
}

void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
................................................................................
                          unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
                          unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
                          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);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */







>
>
>







 







>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











|
>

>
>
>
>
>
>
>



>
>
>
>



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







 







|





80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
...
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
....
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
7997
7998
7999
8000
8001
8002
8003
8004
8005
8006
8007
8008
8009
8010
8011
8012
8013
8014
8015
8016
8017
8018
8019
8020
8021
8022
8023
8024
8025
8026
8027
8028
8029
8030
8031
8032
8033
8034
8035
8036
8037
8038
8039
8040
8041
8042
8043
8044
8045
8046
8047
8048
8049
8050
8051
8052
8053
8054
8055
8056
8057
8058
8059
8060
8061
8062
8063
8064
8065
8066
8067
8068
8069
8070
8071
8072
8073
8074
8075
8076
8077
8078
8079
8080
8081
8082
8083
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
8099
8100
8101
8102
8103
8104
8105
8106
8107
8108
8109
8110
8111
8112
8113
8114
8115
8116
8117
8118



8119


8120
8121
8122
8123
8124
8125
8126
8127
8128
8129
8130





8131
8132
8133
8134
8135
8136
8137
8138
8139


8140








8141
8142
8143
8144
8145
8146
8147
....
8285
8286
8287
8288
8289
8290
8291
8292
8293
8294
8295
8296
8297
#endif
#ifndef URI_BUFFER_LEN_INIT
#  define URI_BUFFER_LEN_INIT 128
#endif
#ifndef ATTR_ARRAY_INIT
#  define ATTR_ARRAY_INIT 4
#endif
#ifndef WHITESPACETC_BUFFER_LEN_INIT
#  define WHITESPACETC_BUFFER_LEN_INIT 200
#endif

/*----------------------------------------------------------------------------
|   Local defines
|
\---------------------------------------------------------------------------*/
#ifndef O_BINARY
# ifdef _O_BINARY
................................................................................
        ks = Tcl_GetHashValue (h);
        if (ks->active) {
            Tcl_DeleteHashTable (&ks->ids);
        }
        FREE (ks);
    }
    Tcl_DeleteHashTable (&sdata->keySpaces);
    if (sdata->wsbufLen) {
        FREE (sdata->wsbuf);
    }
    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from
................................................................................
    sc->freeData = setvarImplFree;
    sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
    return TCL_OK;
}

typedef struct
{
    SchemaCP *cp;
    SchemaData *sdata;
} WhitespaceTCData;

static void
whitespaceImplFree (
    void *constraintData
    )
{
    WhitespaceTCData *wsdata = (WhitespaceTCData *) constraintData;

    FREE (wsdata);
}

static int
whitespaceImplReplace (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    WhitespaceTCData *wsdata = (WhitespaceTCData *) constraintData;
    char *p, *c, *alloced;
    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
    )
{
    WhitespaceTCData *wsdata = (WhitespaceTCData *) constraintData;
    char *p, *c, *alloced;
    SchemaData *sdata;

    sdata = wsdata->sdata;
    p = text;
    c = sdata->wsbuf;
    alloced = sdata->wsbuf + sdata->wsbufLen;
    while (IS_XML_WHITESPACE(*p)) p++;
    while (*p) {
        if (IS_XML_WHITESPACE (*p)) {
            *c = ' ';
            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++;
            while (IS_XML_WHITESPACE (*p)) p++;
            if (!*p) 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
whitespaceTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaCP *cp;
    SchemaConstraint *sc;
    int type;
    WhitespaceTCData *wsdata;

    static const char *types[] = {
        "preserve", "replace", "collapse", NULL
    };
    enum typeSyms {
        t_preserve, t_replace, t_collapse
    };
        
    CHECK_TI
    checkNrArgs (3,3,"(\"preserve\"|\"replace\"|\"collapse\") "
                 "<text constraint script>");
    if (Tcl_GetIndexFromObj (interp, objv[1], types, "type", 0, &type)
        != TCL_OK) {
        return TCL_ERROR;
    }
    cp = initSchemaCP (SCHEMA_CTYPE_CHOICE, NULL, NULL);
    cp->type = SCHEMA_CTYPE_TEXT;
    REMEMBER_PATTERN (cp)
    if (evalConstraints (interp, sdata, cp, objv[2]) != TCL_OK) {
        return TCL_ERROR;



    }


    if (type == t_preserve) {
        ADD_CONSTRAINT (sdata, sc)
        sc->constraint = checkText;
        sc->constraintData = (void *)cp;
        return TCL_OK;
    }
    ADD_CONSTRAINT (sdata, sc)
    sc->freeData = whitespaceImplFree;
    if (sdata->wsbufLen == 0) {
        sdata->wsbuf = (char *) MALLOC (WHITESPACETC_BUFFER_LEN_INIT);
        sdata->wsbufLen = WHITESPACETC_BUFFER_LEN_INIT;





    }
    wsdata = TMALLOC (WhitespaceTCData);
    wsdata->sdata = sdata;
    wsdata->cp = cp;
    sc->constraintData = (void *)wsdata;
    if (type == t_replace) {
        sc->constraint = whitespaceImplReplace;
    } else {
        sc->constraint = whitespaceImplCollapse;


    }








    return TCL_OK;
}

void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
................................................................................
                          unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
                          unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
                          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);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to generic/schema.h.

194
195
196
197
198
199
200


201
202
203
204
205
206
207
    Tcl_HashTable idTables;
    Tcl_HashTable keySpaces;
    XML_Parser parser;
    domNode *node;
    domNode *insideNode;
    int choiceHashThreshold;
    int attributeHashThreshold;


} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,







>
>







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
    Tcl_HashTable idTables;
    Tcl_HashTable keySpaces;
    XML_Parser parser;
    domNode *node;
    domNode *insideNode;
    int choiceHashThreshold;
    int attributeHashThreshold;
    char *wsbuf;
    int wsbufLen;
} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,

Changes to tests/schema.test.

5741
5742
5743
5744
5745
5746
5747







































































































5748
5749
5750
5751
5752
5753
5754
        element a ! {text {setvar from_schema-14.44}}
        element b ! {text {setvar from_schema-14.44}}
    }
    set result [s validate "<doc><a>a</a><b>b</b></doc>"]
    s delete
    lappend result ${from_schema-14.44}
} {1 b}








































































































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







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







5741
5742
5743
5744
5745
5746
5747
5748
5749
5750
5751
5752
5753
5754
5755
5756
5757
5758
5759
5760
5761
5762
5763
5764
5765
5766
5767
5768
5769
5770
5771
5772
5773
5774
5775
5776
5777
5778
5779
5780
5781
5782
5783
5784
5785
5786
5787
5788
5789
5790
5791
5792
5793
5794
5795
5796
5797
5798
5799
5800
5801
5802
5803
5804
5805
5806
5807
5808
5809
5810
5811
5812
5813
5814
5815
5816
5817
5818
5819
5820
5821
5822
5823
5824
5825
5826
5827
5828
5829
5830
5831
5832
5833
5834
5835
5836
5837
5838
5839
5840
5841
5842
5843
5844
5845
5846
5847
5848
5849
5850
5851
5852
5853
5854
5855
5856
5857
        element a ! {text {setvar from_schema-14.44}}
        element b ! {text {setvar from_schema-14.44}}
    }
    set result [s validate "<doc><a>a</a><b>b</b></doc>"]
    s delete
    lappend result ${from_schema-14.44}
} {1 b}

test schema-14.45 {text constraint whitespace} {
    tdom::schema s
    s defelement doc {
        text {
            whitespace preserve {
                oneOf {
                    enumeration foo
                    allOf {
                        minLength 5
                        integer
                    }
                }
            }
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>foo</doc>
        <doc>12345</doc>
        <doc>1234</doc>
        <doc>1234a</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {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>
        {<doc>foo bar</doc>}
        {<doc>foo
bar</doc>}
        {<doc>foo	bar</doc>}
        {<doc>foo	 bar</doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {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>
        {<doc>foo bar</doc>}
        {<doc>foo
bar</doc>}
        {<doc>foo	bar</doc>}
        {<doc>foo	 bar</doc>}
        {<doc>  foo  bar  </doc>}
        {<doc>  foo  bar  rr</doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {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