tDOM

Check-in [9a589897fb]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:An example of different 'styles' of a certain type: The 'interger' text constraint now has two interpretation of an integer - what Tcl_GetInt() accept and what a valid xsd:integer is, which is quite different.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: 9a589897fb91e7aa6f9ec30c37ead4aa30d9115a47e3aaacc69336d76390ebca
User & Date: rolf 2019-06-18 22:18:39
Context
2019-07-12
22:26
Merged from trunk. Leaf check-in: df3a907a20 user: rolf tags: schema
2019-07-08
21:45
Musing over error reporting. Leaf check-in: 900e627f9a user: rolf tags: wip
2019-06-18
22:18
An example of different 'styles' of a certain type: The 'interger' text constraint now has two interpretation of an integer - what Tcl_GetInt() accept and what a valid xsd:integer is, which is quite different. check-in: 9a589897fb user: rolf tags: schema
2019-06-17
09:43
Made the lately added new Schema_CP_Type types known to the debuging machinery. check-in: 8e9437ea75 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/schema.xml.

378
379
380
381
382
383
384
385






386
387
388
389
390
391
392
393
    have to be of a certain kind, must comply to some rules etc to be
    valid.</p>

    <p>The text constraint commands are:</p>

    <commandlist>
      <commanddef>
        <command><cmd>integer</cmd></command>






        <desc></desc>
      </commanddef>

      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc>The text constraint only matches if the text value is
        string equal to the given value.</desc>
      </commanddef>






|
>
>
>
>
>
>
|







378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
    have to be of a certain kind, must comply to some rules etc to be
    valid.</p>

    <p>The text constraint commands are:</p>

    <commandlist>
      <commanddef>
        <command><cmd>integer</cmd> <m>?(xsd|tcl)?</command>
        <desc>This text constraint match if the text value could be
        parsed as an integer. If the optional argument to the command
        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>fixed</cmd> <m>value</m></command>
        <desc>The text constraint only matches if the text value is
        string equal to the given value.</desc>
      </commanddef>

Changes to generic/schema.c.

3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
....
3990
3991
3992
3993
3994
3995
3996
3997




















3998
3999
4000
4001
4002
4003
4004
....
4014
4015
4016
4017
4018
4019
4020








4021
4022
4023
4024








4025


4026







4027
4028
4029
4030
4031
4032
4033
                                     Tcl_GetString (namespaceObj));
    }
    h = Tcl_CreateHashEntry (&sdata->attrNames,
                             Tcl_GetString (nameObj), &hnew);
    name = Tcl_GetHashKey (&sdata->attrNames, h);
    if (!hnew) {
        /* Check, if there is already an attribute with this name
         * / namespace */
        for (i = 0; i < sdata->numAttr; i++) {
            if (sdata->currentAttrs[i]->name == name
                && sdata->currentAttrs[i]->namespace == namespace) {
                /* Ignore the later attribute declaration */
                return TCL_OK;
            }
        }
................................................................................
        pattern->keySpace = Tcl_GetHashValue (h);
        addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    }
    return TCL_OK;
}

static int
integerImpl (




















    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    int n;

................................................................................
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaConstraint *sc;









    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,1,"no argument expected");








    ADD_CONSTRAINT (sdata, sc)


    sc->constraint = integerImpl;







    return TCL_OK;
}

typedef struct
{
    int nrArg;
    Tcl_Obj **evalStub;






|







 







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







 







>
>
>
>
>
>
>
>



|
>
>
>
>
>
>
>
>

>
>
|
>
>
>
>
>
>
>







3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
....
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
....
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
                                     Tcl_GetString (namespaceObj));
    }
    h = Tcl_CreateHashEntry (&sdata->attrNames,
                             Tcl_GetString (nameObj), &hnew);
    name = Tcl_GetHashKey (&sdata->attrNames, h);
    if (!hnew) {
        /* Check, if there is already an attribute with this name
           and namespace */
        for (i = 0; i < sdata->numAttr; i++) {
            if (sdata->currentAttrs[i]->name == name
                && sdata->currentAttrs[i]->namespace == namespace) {
                /* Ignore the later attribute declaration */
                return TCL_OK;
            }
        }
................................................................................
        pattern->keySpace = Tcl_GetHashValue (h);
        addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    }
    return TCL_OK;
}

static int
integerImplXsd (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    char *c = text;
    if (*c == 0) return 0;
    if (*c == '-' || *c == '+') {
        c++;
        if (*c == 0) return 0;
    }
    while (isdigit(*c)) {
        c++;
    }
    if (*c != 0) return 0;
    return 1;
}

static int
integerImplTcl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    int n;

................................................................................
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaConstraint *sc;
    int type;

    static const char *types[] = {
        "xsd", "tcl", NULL
    };
    enum typeSyms {
        t_xsd, t_tcl
    };

    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,2,"?xsd|tcl|json?");
    if (objc == 1) {
        type = t_xsd;
    } else {
        if (Tcl_GetIndexFromObj (interp, objv[1], types, "type", 0, &type)
            != TCL_OK) {
            return TCL_ERROR;
        }
    }
    ADD_CONSTRAINT (sdata, sc)
    switch ((enum typeSyms) type) {
    case t_xsd:
        sc->constraint = integerImplXsd;
        break;
    case t_tcl:
        sc->constraint = integerImplTcl;
        break;
    }
    sc->constraintData = sdata;
    
    return TCL_OK;
}

typedef struct
{
    int nrArg;
    Tcl_Obj **evalStub;

Changes to tests/schema.test.

2874
2875
2876
2877
2878
2879
2880

2881
2882
2883
2884
2885
2886





















































2887
2888
2889
2890
2891
2892
2893
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>eeee</doc>
        <doc>56666</doc>
        {<doc>   </doc>}

    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0}






















































proc proc-14.2 {param text} {
    if {$text in {one two tree}} {
        return true
    }
    return false
}






>





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







2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>eeee</doc>
        <doc>56666</doc>
        {<doc>   </doc>}
        {<doc>  97  </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 0}

test schema-14.1.1 {text: integer} {
    tdom::schema s
    s defelement doc {
        text {
            integer tcl
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>eeee</doc>
        <doc>56666</doc>
        {<doc>   </doc>}
        {<doc>  +34 </doc>}
        {<doc>034</doc>}
        {<doc>0034 </doc>}
        {<doc>0xAB</doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 1 1 1 1}

test schema-14.1.2 {text: integer} {
    tdom::schema s
    s defelement doc {
        text {
            integer xsd
        }
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>eeee</doc>
        <doc>56666</doc>
        {<doc>   </doc>}
        {<doc>  +34 </doc>}
        {<doc>034</doc>}
        {<doc>0034 </doc>}
        {<doc>0xAB</doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 0 1 0 0}


proc proc-14.2 {param text} {
    if {$text in {one two tree}} {
        return true
    }
    return false
}