tDOM

Check-in [23f4f6f626]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Allow schema definition command "tcl" only inside of sequential content particles. Still uncertain about the interface.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | virtualConstraints
Files: files | file ages | folders
SHA3-256: 23f4f6f6268ce81eda5a4ac3970acf07c4c57072b2bd3c560430777312f38e9a
User & Date: rolf 2019-02-19 23:06:22
Context
2019-03-07
00:05
Merged from schema. check-in: f189f4695e user: rolf tags: virtualConstraints
2019-02-19
23:06
Allow schema definition command "tcl" only inside of sequential content particles. Still uncertain about the interface. check-in: 23f4f6f626 user: rolf tags: virtualConstraints
01:36
Merged from schema. check-in: 7718b1e0ff user: rolf tags: virtualConstraints
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to doc/schema.xml.

214
215
216
217
218
219
220
221
222

223
224
225
226
227
228
229
230
        <command><method>mixed</method> <m>?quant?</m> <m>&lt;definition script></m></command>
        <desc></desc>
      </commanddef>

      <commanddef>
        <command><method>text</method> <m>?&lt;constraint script>?</m></command>
        <desc>Without the optional constraint script this validation
        constraint matches every string (including the empty one).
        With <m>constraint script</m> argument a text matching this

        script is expected.</desc>
      </commanddef>

      <commanddef>
        <command><method>any</method> <m>?quant?</m></command>
        <desc>The any command matches every element (with whatever
        attributes) or subtree, no matter if known within the schema
        or not. Please notice, that this mean the quantifier * and +






|
|
>
|







214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
        <command><method>mixed</method> <m>?quant?</m> <m>&lt;definition script></m></command>
        <desc></desc>
      </commanddef>

      <commanddef>
        <command><method>text</method> <m>?&lt;constraint script>?</m></command>
        <desc>Without the optional constraint script this validation
        constraint matches every string (including the empty one). If
        the <m>constraint script</m> argument is given then a text
        machtes if it passes all text constraints in the
        script.</desc>
      </commanddef>

      <commanddef>
        <command><method>any</method> <m>?quant?</m></command>
        <desc>The any command matches every element (with whatever
        attributes) or subtree, no matter if known within the schema
        or not. Please notice, that this mean the quantifier * and +

Changes to generic/schema.c.

881
882
883
884
885
886
887



888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
....
1591
1592
1593
1594
1595
1596
1597
1598
1599



1600
1601
1602
1603
1604
1605
1606
....
2943
2944
2945
2946
2947
2948
2949











2950
2951
2952
2953
2954
2955
2956
                    se->hasMatched = 1;
                    se->interleaveState[i] = 1;
                    return 1;
                }
                popStack (sdata);
                if (!mayskip && rc == -1) mayskip = 1;
                break;



            }

        }
                
        break;


        fprintf (stderr, "matchElementStart: SCHEMA_CTYPE_INTERLEAVE to be implemented\n");
        return 0;
    }
    
    return 0;
}

int
probeElement (
................................................................................
                        updateStack (se, cp, ac);
                        return 1;
                    }
                    popStack (sdata);
                    break;

                case SCHEMA_CTYPE_CHOICE:
                    Tcl_Panic ("MIXED or CHOICE child of MIXED or CHOICE");




                }
            }
        }
        break;
    }
    return 0;
}
................................................................................

    CHECK_SI
    CHECK_TOPLEVEL
    if (objc < 2) {
        SetResult ("Expected: <tclcmd> ?arg? ?arg? ...");
        return TCL_ERROR;
    }












    pattern = initSchemaCP (SCHEMA_CTYPE_VIRTUAL, NULL, NULL);
    REMEMBER_PATTERN (pattern)
        pattern->content = MALLOC (sizeof (Tcl_Obj*) * (objc +1));
    for (i = 1; i < objc; i++) {
        pattern->content[i-1] = (SchemaCP *) objv[i];
        Tcl_IncrRefCount (objv[i]);






>
>
>





<
<
<
<







 







|

>
>
>







 







>
>
>
>
>
>
>
>
>
>
>







881
882
883
884
885
886
887
888
889
890
891
892
893
894
895




896
897
898
899
900
901
902
....
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
....
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
                    se->hasMatched = 1;
                    se->interleaveState[i] = 1;
                    return 1;
                }
                popStack (sdata);
                if (!mayskip && rc == -1) mayskip = 1;
                break;

            case SCHEMA_CTYPE_VIRTUAL:
                break;
            }

        }
                
        break;




    }
    
    return 0;
}

int
probeElement (
................................................................................
                        updateStack (se, cp, ac);
                        return 1;
                    }
                    popStack (sdata);
                    break;

                case SCHEMA_CTYPE_CHOICE:
                    Tcl_Panic ("MIXED or CHOICE child of INTERLEAVE");

                case SCHEMA_CTYPE_VIRTUAL:
                    break;
                    
                }
            }
        }
        break;
    }
    return 0;
}
................................................................................

    CHECK_SI
    CHECK_TOPLEVEL
    if (objc < 2) {
        SetResult ("Expected: <tclcmd> ?arg? ?arg? ...");
        return TCL_ERROR;
    }

    switch (sdata->cp->type) {
    case SCHEMA_CTYPE_NAME:
    case SCHEMA_CTYPE_PATTERN:
        break;
    default:
        SetResult ("The \"tcl\" schema definition command is only "
                   "allowed in sequential context (defelement, "
                   "element or defpattern)");
        return TCL_ERROR;
    }

    pattern = initSchemaCP (SCHEMA_CTYPE_VIRTUAL, NULL, NULL);
    REMEMBER_PATTERN (pattern)
        pattern->content = MALLOC (sizeof (Tcl_Obj*) * (objc +1));
    for (i = 1; i < objc; i++) {
        pattern->content[i-1] = (SchemaCP *) objv[i];
        Tcl_IncrRefCount (objv[i]);

Changes to tests/schema.test.

2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
....
2980
2981
2982
2983
2984
2985
2986












































2987
2988
2989
2990
2991
2992
2993
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 1 1 1 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
            tcl append ::schema-15.1
        }
    }
    set ::schema-15.1 ""
    set result [s validate {<a><b/></a>} msg]
    s delete
    lappend result $msg ${::schema-15.1}
    set result
} {1 {} ba}

proc schema-15.2-astart {args} {
    append ::schema-15.2 astart
}

proc schema-15.2-aend {args} {
    append ::schema-15.2 aend
}

test schema-15.2 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-15.2-astart
            element b ! text
            element c ! text
            tcl schema-15.2-aend
        }
    }
    set schema-15.2 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg ${schema-15.2}
    set result
} {1 {} astartaendastartaend}

test schema-14.15 {text: oneOf} {
    tdom::schema s
    s define {
        defelement doc {
            text {
                oneOf {
                    maxLength 3
................................................................................
            $doc delete
        }
        lappend result $rc
    }
    s delete
    set result
} {0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0}













































test schema-16.1 {interleave} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element a






<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







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







2804
2805
2806
2807
2808
2809
2810












































2811
2812
2813
2814
2815
2816
2817
....
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 1 1 1 0 0 0 0}













































test schema-14.15 {text: oneOf} {
    tdom::schema s
    s define {
        defelement doc {
            text {
                oneOf {
                    maxLength 3
................................................................................
            $doc delete
        }
        lappend result $rc
    }
    s delete
    set result
} {0 1 0 1 0 1 0 1 0 1 1 0 1 0 1 0 1 0 0 1 0 1 1 0}

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
        }
    }
    set ::schema-15.1 ""
    set result [s validate {<a><b/></a>} msg]
    s delete
    lappend result $msg ${::schema-15.1}
    set result
} {1 {} ba}

proc schema-15.2-astart {args} {
    append ::schema-15.2 astart
}

proc schema-15.2-aend {args} {
    append ::schema-15.2 aend
}

test schema-15.2 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-15.2-astart
            element b ! text
            element c ! text
            tcl schema-15.2-aend
        }
    }
    set schema-15.2 ""
    set result [s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>} msg]
    s delete
    lappend result $msg ${schema-15.2}
    set result
} {1 {} astartaendastartaend}

test schema-16.1 {interleave} {
    tdom::schema s
    s define {
        defelement doc {
            interleave {
                element a