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

Overview
Comment:Added xsd like boolean text constraint.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: c24f4e9aeb0ce918c6322179b9f56531e8756748656e881182ce7d183e404150
User & Date: rolf 2019-08-11 01:35:26
Context
2019-08-12
21:11
Fix for [011e259c69]. check-in: cafa5160c0 user: rolf tags: schema
2019-08-11
01:35
Added xsd like boolean text constraint. check-in: c24f4e9aeb user: rolf tags: schema
2019-08-06
23:31
Removed cruft for versions not supported anymore. check-in: 13fe3aff35 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
....
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
....
4571
4572
4573
4574
4575
4576
4577
4578
























4579
4580
4581
4582
4583
4584
4585
....
4595
4596
4597
4598
4599
4600
4601

4602







4603
4604
4605








4606


4607





4608
4609
4610
4611
4612
4613
4614
    };
    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;
        }
................................................................................
    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;
................................................................................
    checkNrArgs (1,1,"No arguments expected");
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = numberImpl;
    return TCL_OK;
}

static int
booleanImpl (
























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

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









    CHECK_TI
    CHECK_TOPLEVEL
    checkNrArgs (1,1,"No arguments expected");








    ADD_CONSTRAINT (sdata, sc)


    sc->constraint = booleanImpl;





    return TCL_OK;
}

static int
isodateImpl (
    Tcl_Interp *interp,
    void *constraintData,







|







 







<
<







 







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







 







>

>
>
>
>
>
>
>


|
>
>
>
>
>
>
>
>

>
>
|
>
>
>
>
>







4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
....
4102
4103
4104
4105
4106
4107
4108


4109
4110
4111
4112
4113
4114
4115
....
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
....
4617
4618
4619
4620
4621
4622
4623
4624
4625
4626
4627
4628
4629
4630
4631
4632
4633
4634
4635
4636
4637
4638
4639
4640
4641
4642
4643
4644
4645
4646
4647
4648
4649
4650
4651
4652
4653
4654
4655
4656
4657
4658
4659
    };
    enum typeSyms {
        t_xsd, t_tcl
    };

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


    return TCL_OK;
}

typedef struct
{
    int nrArg;
    Tcl_Obj **evalStub;
................................................................................
    checkNrArgs (1,1,"No arguments expected");
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = numberImpl;
    return TCL_OK;
}

static int
booleanImplXsd (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    char *c = text;
    switch (*c) {
    case '0':
    case '1':
        c++;
        if (*c == 0) return 1;
        break;
    case 't':
        if (strcmp (text, "true") == 0) return 1;
        break;
    case 'f':
        if (strcmp (text, "false") == 0) return 1;
        break;
    }
    return 0;
}

static int
booleanImplTcl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    int b;

................................................................................
    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?");
    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 = booleanImplXsd;
        break;
    case t_tcl:
        sc->constraint = booleanImplTcl;
        break;
    }
    return TCL_OK;
}

static int
isodateImpl (
    Tcl_Interp *interp,
    void *constraintData,

Changes to tests/schema.test.

3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
....
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
....
3979
3980
3981
3982
3983
3984
3985


























































































3986
3987
3988
3989
3990
3991
3992
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0 1 1 0 0}

test schema-14.27 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}

test schema-14.28 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}



























































































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







|







 







|







 







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







3915
3916
3917
3918
3919
3920
3921
3922
3923
3924
3925
3926
3927
3928
3929
....
3947
3948
3949
3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
....
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
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
4025
4026
4027
4028
4029
4030
4031
4032
4033
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
4079
4080
4081
4082
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0 1 1 0 0}

test schema-14.28 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}

test schema-14.29 {element content id/idref} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element id *
                element idref *
                element ida *
................................................................................
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 0 0 0 1 1}

test schema-14.30 {text: boolean (xsd)} {
    tdom::schema s
    s defelement doc {
        text boolean
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>00</doc>
        <doc>01</doc>
        <doc>1</doc>
        <doc>11</doc>
        <doc>false</doc>
        {<doc>false </doc>}
        <doc>False</doc>
        <doc>FALSE</doc>
        <doc>true</doc>
        {<doc> true</doc>}
        <doc>TrUe</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 1 0 1 0 0 0 1 0 0}

test schema-14.30a {text: boolean (xsd)} {
    tdom::schema s
    s defelement doc {
        text {boolean xsd}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>00</doc>
        <doc>01</doc>
        <doc>1</doc>
        <doc>11</doc>
        <doc>false</doc>
        {<doc>false </doc>}
        <doc>False</doc>
        <doc>FALSE</doc>
        <doc>true</doc>
        {<doc> true</doc>}
        <doc>TrUe</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 1 0 1 0 0 0 1 0 0}

test schema-14.31 {text: boolean (tcl)} {
    tdom::schema s
    s defelement doc {
        text {boolean tcl}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc></doc>
        <doc>5</doc>
        <doc>0</doc>
        <doc>01</doc>
        <doc>1</doc>
        <doc>11</doc>
        <doc>false</doc>
        <doc>f</doc>
        <doc>no</doc>
        {<doc>no </doc>}
        <doc>n</doc>
        {<doc> n </doc>}
        {<doc>false </doc>}
        <doc>False</doc>
        <doc>FALSE</doc>
        <doc>true</doc>
        {<doc> true</doc>}
        <doc>TrUe</doc>
        <doc>ON</doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 1 0 1 0 1 1 1 0 1 0 0 1 1 1 0 1 1}

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