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

Overview
Comment:Added the xsd data types negativeInteger, nonNegativeInteger, nonPositiveInteger and positiveInteger.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: d3fc207059c09bd05d546adcd895aeee69f954706fe8c5fc256cb7b3dbe59227
User & Date: rolf 2019-11-29 00:29:48
Context
2019-11-29
16:42
Added text constraint command hexBinary (similar to the xsd type hexBinary). check-in: ea199fedb7 user: rolf tags: schema
00:29
Added the xsd data types negativeInteger, nonNegativeInteger, nonPositiveInteger and positiveInteger. check-in: d3fc207059 user: rolf tags: schema
2019-11-24
01:07
Added the xsd data types Name, NCName and QName as text constraint commands name, ncname and qname. check-in: 3201b746cc user: rolf tags: schema
Changes

Changes to doc/schema.xml.

561
562
563
564
565
566
567




























568
569
570
571
572
573
574
        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 match if the text value is
        string equal to the given value.</desc>
      </commanddef>
      
      <commanddef>







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







561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
        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>
      
      <commanddef>
        <command><cmd>nonNegativeInteger</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 &gt;= zero.</desc>
      </commanddef>

      <commanddef>
        <command><cmd>nonPositiveInteger</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>

      <commanddef>
        <command><cmd>positiveInteger</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 &gt; zero.</desc>
      </commanddef>
      
      <commanddef>
        <command><cmd>fixed</cmd> <m>value</m></command>
        <desc>The text constraint only match if the text value is
        string equal to the given value.</desc>
      </commanddef>
      
      <commanddef>

Changes to generic/schema.c.

23
24
25
26
27
28
29

30
31
32
33
34
35
36
....
4931
4932
4933
4934
4935
4936
4937



4938




4939




















4940



4941








4942
4943
4944
4945
4946
4947
4948
....
4954
4955
4956
4957
4958
4959
4960






















4961
4962
4963
4964
4965
4966
4967
....
4996
4997
4998
4999
5000
5001
5002

5003
5004
5005
5006
5007
5008
5009
....
6606
6607
6608
6609
6610
6611
6612
6613








6614
6615
6616
6617
6618
6619
6620

#ifndef TDOM_NO_SCHEMA

#include <tdom.h>
#include <tcldom.h>
#include <domxpath.h>
#include <schema.h>


/* #define DEBUG */
/* #define DDEBUG */
/*----------------------------------------------------------------------------
|   Debug Macros
|
\---------------------------------------------------------------------------*/
................................................................................
    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;
}

................................................................................
    )
{
    int n;

    if (Tcl_GetInt (interp, text, &n) != TCL_OK) {
        return 0;
    }






















    return 1;
}

static int
integerTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
................................................................................
    case t_xsd:
        sc->constraint = integerImplXsd;
        break;
    case t_tcl:
        sc->constraint = integerImplTcl;
        break;
    }

    return TCL_OK;
}

typedef struct
{
    int nrArg;
    Tcl_Obj **evalStub;
................................................................................

    /* Local key constraints */
    Tcl_CreateObjCommand (interp, "tdom::schema::keyspace",
                          keyspacePatternObjCmd, NULL, NULL);
    
    /* The text constraint commands */
    Tcl_CreateObjCommand (interp,"tdom::schema::text::integer",
                          integerTCObjCmd, NULL, NULL);








    Tcl_CreateObjCommand (interp, "tdom::schema::text::tcl",
                          tclTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::fixed",
                          fixedTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::enumeration",
                          enumerationTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::match",







>







 







>
>
>
|
>
>
>
>

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







 







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







 







>







 







|
>
>
>
>
>
>
>
>







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
....
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
4955
4956
4957
4958
4959
4960
4961
4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
....
4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
5016
5017
5018
5019
5020
5021
5022
5023
5024
5025
5026
5027
5028
....
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
....
6668
6669
6670
6671
6672
6673
6674
6675
6676
6677
6678
6679
6680
6681
6682
6683
6684
6685
6686
6687
6688
6689
6690

#ifndef TDOM_NO_SCHEMA

#include <tdom.h>
#include <tcldom.h>
#include <domxpath.h>
#include <schema.h>
#include <stdint.h>

/* #define DEBUG */
/* #define DDEBUG */
/*----------------------------------------------------------------------------
|   Debug Macros
|
\---------------------------------------------------------------------------*/
................................................................................
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    char *c = text;
    if (*c == 0) return 0;
    switch ((intptr_t)constraintData) {
    case 0:
        /* integer */
        if (*c == '-' || *c == '+') c++;
        break;
    case 1:
        /* negativeInteger */
        if (*c != '-') return 0;
        c++;
        while (*c == '0') c++;
        break;
    case 2:
        /* nonNegativeInteger */
        if (*c == '+') c++;
        else if (*c == '-') {
            c++;
            if (*c == '0') {
                c++;
                while (*c == '0') c++;
                if (*c == 0) return 1;
            }
            return 0;
        }
        break;
    case 3:
        /* nonPositiveInteger */
        if (*c == '-') c++;
        else {
            if (*c == '+') c++;
            if (*c == 0) return 0;
            while (*c == '0') c++;
            if (*c == 0) return 1;
            return 0;
        }
        break;
    case 4:
        /* positiveInteger */
        if (*c == '+') c++;
        while (*c == '0') c++;
        break;
    }
    if (*c == 0) return 0;
    while (isdigit(*c)) {
        c++;
    }
    if (*c != 0) return 0;
    return 1;
}

................................................................................
    )
{
    int n;

    if (Tcl_GetInt (interp, text, &n) != TCL_OK) {
        return 0;
    }
    switch ((intptr_t)constraintData) {
    case 0:
        /* integer */
        break;
    case 1:
        /* negativeInteger */
        if (n >= 0) return 0;
        break;
    case 2:
        /* nonNegativeInteger */
        if (n < 0) return 0;
        break;
    case 3:
        /* nonPositiveInteger */
        if (n > 0) return 0;
        break;
    case 4:
        /* positiveInteger */
        if (n <= 0) return 0;
        break;
    }
    
    return 1;
}

static int
integerTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
................................................................................
    case t_xsd:
        sc->constraint = integerImplXsd;
        break;
    case t_tcl:
        sc->constraint = integerImplTcl;
        break;
    }
    sc->constraintData = clientData;
    return TCL_OK;
}

typedef struct
{
    int nrArg;
    Tcl_Obj **evalStub;
................................................................................

    /* Local key constraints */
    Tcl_CreateObjCommand (interp, "tdom::schema::keyspace",
                          keyspacePatternObjCmd, NULL, NULL);
    
    /* The text constraint commands */
    Tcl_CreateObjCommand (interp,"tdom::schema::text::integer",
                          integerTCObjCmd, (ClientData) 0, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::negativeInteger",
                          integerTCObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::nonNegativeInteger",
                          integerTCObjCmd, (ClientData) 2, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::nonPositiveInteger",
                          integerTCObjCmd, (ClientData) 3, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::positiveInteger",
                          integerTCObjCmd, (ClientData) 4, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::tcl",
                          tclTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::fixed",
                          fixedTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::enumeration",
                          enumerationTCObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text::match",

Changes to tests/schema.test.

4520
4521
4522
4523
4524
4525
4526


































































































































































































































































4527
4528
4529
4530
4531
4532
4533
        <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







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







4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
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
4608
4609
4610
4611
4612
4613
4614
4615
4616
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
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
        <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-14.32 {text: negativeInteger} {
    tdom::schema s
    s defelement doc {
        text negativeInteger
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
        {<doc> -23 </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 0}

test schema-14.32.1 {text: negativeInteger tcl} {
    tdom::schema s
    s defelement doc {
        text {negativeInteger tcl}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
        {<doc> -23 </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 0 0 0 1}

test schema-14.33 {text: nonNegativeInteger} {
    tdom::schema s
    s defelement doc {
        text nonNegativeInteger
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0}

test schema-14.33.1 {text: nonNegativeInteger tcl} {
    tdom::schema s
    s defelement doc {
        text {nonNegativeInteger tcl}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0}

test schema-14.34 {text: nonPositiveInteger} {
    tdom::schema s
    s defelement doc {
        text nonPositiveInteger
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0}

test schema-14.34.1 {text: nonPositiveInteger tcl} {
    tdom::schema s
    s defelement doc {
        text {nonPositiveInteger tcl}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0}

test schema-14.35 {text: positiveInteger} {
    tdom::schema s
    s defelement doc {
        text positiveInteger
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0}

test schema-14.35.1 {text: positiveInteger tcl} {
    tdom::schema s
    s defelement doc {
        text {positiveInteger tcl}
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc>5782</doc>
        <doc>3</doc>
        <doc>+2</doc>
        <doc>+002</doc>
        <doc>1</doc>
        <doc>01</doc>
        <doc>+0</doc>
        <doc>+000</doc>
        <doc>0</doc>
        <doc>-0</doc>
        <doc>-000</doc>
        <doc>-002</doc>
        <doc>-1</doc>
        <doc>-12345</doc>
        <doc>-</doc>
        <doc>+</doc>
        {<doc> </doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0 0}

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