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

Overview
Comment:Don't call event on a schem command in any script evaluated from the same schema command.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: d1707acfbf83047699c904e2d87732fccbf68ceb92f2e9efcf3f501c8d58f5e6
User & Date: rolf 2019-10-18 23:43:07
Context
2019-10-19
00:08
Ensure that the script error of a script evaluated by a schema command pops up to global level. check-in: a15e6f3d24 user: rolf tags: schema
2019-10-18
23:43
Don't call event on a schem command in any script evaluated from the same schema command. check-in: d1707acfbf user: rolf tags: schema
2019-10-11
00:29
Added a few tests to document the behaviour in case of validation against forward defined elements or refs. check-in: bb898f3778 user: rolf tags: schema
Changes

Changes to generic/schema.c.

183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
...
942
943
944
945
946
947
948

949
950

951
952
953
954
955
956
957
        return TCL_ERROR;                                               \
    }

#define CHECK_RECURSIVE_CALL                                            \
    if (clientData != NULL) {                                           \
        savedsdata = GETASI;                                            \
        if (savedsdata == sdata) {                                      \
            SetResult ("This recursive call is not allowed"); \
            return TCL_ERROR;                                           \
        }                                                               \
    }
      
#define CHECK_EVAL                                                      \
    if (sdata->currentEvals) {                                          \
        SetResult ("Method not allowed in nested schema define script"); \
        return TCL_ERROR;                                               \
    }
    
#define REMEMBER_PATTERN(pattern)                                       \
    if (sdata->numPatternList == sdata->patternListSize) {              \
        sdata->patternList = (SchemaCP **) REALLOC (                    \
            sdata->patternList,                                         \
................................................................................

    cp = sdata->stack->pattern->content[ac];
    savedac = sdata->stack->activeChild;
    savedhm = sdata->stack->hasMatched;
    sdata->stack->activeChild = ac;
    sdata->stack->hasMatched = 1;
    cp->content[cp->nc-1] = (SchemaCP *) sdata->self;

    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);

    sdata->stack->activeChild = savedac;
    sdata->stack->hasMatched = savedhm;    
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;







|






|







 







>


>







183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
...
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
        return TCL_ERROR;                                               \
    }

#define CHECK_RECURSIVE_CALL                                            \
    if (clientData != NULL) {                                           \
        savedsdata = GETASI;                                            \
        if (savedsdata == sdata) {                                      \
            SetResult ("This recursive call is not allowed");           \
            return TCL_ERROR;                                           \
        }                                                               \
    }
      
#define CHECK_EVAL                                                      \
    if (sdata->currentEvals) {                                          \
        SetResult ("This method is not allowed in nested evaluation");  \
        return TCL_ERROR;                                               \
    }
    
#define REMEMBER_PATTERN(pattern)                                       \
    if (sdata->numPatternList == sdata->patternListSize) {              \
        sdata->patternList = (SchemaCP **) REALLOC (                    \
            sdata->patternList,                                         \
................................................................................

    cp = sdata->stack->pattern->content[ac];
    savedac = sdata->stack->activeChild;
    savedhm = sdata->stack->hasMatched;
    sdata->stack->activeChild = ac;
    sdata->stack->hasMatched = 1;
    cp->content[cp->nc-1] = (SchemaCP *) sdata->self;
    sdata->currentEvals++;
    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);
    sdata->currentEvals--;
    sdata->stack->activeChild = savedac;
    sdata->stack->hasMatched = savedhm;    
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;

Changes to tests/schema.test.

844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
...
874
875
876
877
878
879
880

























881
882
883
884
885
886
887
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 0 1 1 0}

test schema-4.3 {domvalidate} {
    tdom::schema s 
    s define {
        defelement addressBook {
            element card *
        }
        defelement card {
            element name
................................................................................
  </card>
</addressBook>        
    }]
    s delete
    set result
} 1


























test schema-5.1 {dom parse -validateCmd} {
    set result [catch {
        [dom parse -validateCmd tdom::schema <doc/>]
    }]
} 1

test schema-5.2 {dom parse -validateCmd} {







|







 







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







844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
...
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 0 1 1 0}

test schema-4.3 {validation} {
    tdom::schema s 
    s define {
        defelement addressBook {
            element card *
        }
        defelement card {
            element name
................................................................................
  </card>
</addressBook>        
    }]
    s delete
    set result
} 1

proc schema-4.4 {scmd} {
    global result
    catch {$scmd event start foo} errMsg
    lappend result $errMsg
}

test schema-4.4 {event on itself in called script} {
    tdom::schema s
    s defelement doc {
        element a ?
        tcl schema-4.4
        element b ?
    }
    set result [list]
    foreach xml {
        <doc/>
        <doc><a/></doc>
        <doc><a/><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {{This method is not allowed in nested evaluation} 1 {This method is not allowed in nested evaluation} 1 {This method is not allowed in nested evaluation} 1}

test schema-5.1 {dom parse -validateCmd} {
    set result [catch {
        [dom parse -validateCmd tdom::schema <doc/>]
    }]
} 1

test schema-5.2 {dom parse -validateCmd} {