tDOM

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

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

Overview
Comment:Make sure that calling another tDOM schema command inside a schema definition script (after all they are just a Tcl script) work. But ensure that calling a schema definition script evaluation inside a currently evaluated schema definition script by the same schema command raises error.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: 258c031b81bc8fcd505739238e49385235c3ecc023ba201fc5daa32852984e69
User & Date: rolf 2019-02-15 16:57:29
Context
2019-02-17
00:46
Added schema command method deftext - defining named text constraints. Enhanced the schema definition command text to allow to refer to named text constraints. check-in: ee18aed126 user: rolf tags: schema
2019-02-15
16:57
Make sure that calling another tDOM schema command inside a schema definition script (after all they are just a Tcl script) work. But ensure that calling a schema definition script evaluation inside a currently evaluated schema definition script by the same schema command raises error. check-in: 258c031b81 user: rolf tags: schema
2019-02-14
02:39
Added text constraint commands oneOf and allOf. check-in: 046b4f9866 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
....
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
....
1961
1962
1963
1964
1965
1966
1967





1968
1969
1970
1971
1972
1973
1974
....
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008





2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
}
# define SETASI(v) SetActiveSchemaData (v)
#endif


#define CHECK_SI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context.");        \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (sdata->isTextConstraint) {                                      \
        SetResult ("Command called in invalid schema context.");        \
        return TCL_ERROR;                                               \
    }

#define CHECK_TI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context.");        \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (!sdata->isTextConstraint) {                                     \
        SetResult ("Command called in invalid schema context.");        \
        return TCL_ERROR;                                               \
    }

#define CHECK_TOPLEVEL                                                  \
    if (sdata->defineToplevel) {                                        \
        SetResult("Command not allowed at top level "                   \
                  "in schema define evaluation");                       \
................................................................................
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData  *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *entryPtr;
    SchemaCP   *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;

    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern", "start", "event", "delete",
................................................................................
                pattern->next = current;
            }
            REMEMBER_PATTERN (pattern);
            Tcl_SetHashValue (entryPtr, pattern);
        }

        if (!sdata->defineToplevel) {





            SETASI(sdata);
        }
        savedDefineToplevel = sdata->defineToplevel;
        savedNamespacePtr = sdata->currentNamespace;
        sdata->defineToplevel = 0;
        sdata->currentNamespace = namespacePtr;
        sdata->cp = pattern;
................................................................................
            }
        } else {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = savedDefineToplevel;
        sdata->currentNamespace = savedNamespacePtr;
        if (!savedDefineToplevel) {
            SETASI(0);
        }
        break;

    case m_define:
        if (objc != 3) {
            Tcl_WrongNumArgs (interp, 2, objv, "<definition commands>");
            return TCL_ERROR;
        }





        SETASI(sdata);
        savedNumPatternList = sdata->numPatternList;
        sdata->currentNamespace = 0;
        sdata->cp = NULL;
        sdata->contentSize = 0;
        sdata->defineToplevel = 1;
        sdata->evalStub[3] = objv[2];
        result = Tcl_EvalObjv (interp, 4, sdata->evalStub,
                               TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
        if (result != TCL_OK) {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = 0;
        SETASI(0);
        break;

    case m_start:
        if (objc < 3-i || objc > 4-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "<documentElement>"
                              " ?<namespace>?");
            return TCL_ERROR;






|



|





|



|







 







|


|







 







>
>
>
>
>







 







|








>
>
>
>
>













|







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
....
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
....
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
....
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
}
# define SETASI(v) SetActiveSchemaData (v)
#endif


#define CHECK_SI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context");         \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (sdata->isTextConstraint) {                                      \
        SetResult ("Command called in invalid schema context");         \
        return TCL_ERROR;                                               \
    }

#define CHECK_TI                                                        \
    if (!sdata) {                                                       \
        SetResult ("Command called outside of schema context");         \
        return TCL_ERROR;                                               \
    }                                                                   \
    if (!sdata->isTextConstraint) {                                     \
        SetResult ("Command called in invalid schema context");         \
        return TCL_ERROR;                                               \
    }

#define CHECK_TOPLEVEL                                                  \
    if (sdata->defineToplevel) {                                        \
        SetResult("Command not allowed at top level "                   \
                  "in schema define evaluation");                       \
................................................................................
    Tcl_Obj *const objv[]
    )
{
    int            methodIndex, keywordIndex, hnew, patternIndex;
    int            result = TCL_OK, forwardDef = 0, i = 0;
    int            savedDefineToplevel, type, len;
    unsigned int   savedNumPatternList;
    SchemaData    *savedsdata, *sdata = (SchemaData *) clientData;
    Tcl_HashTable *hashTable;
    Tcl_HashEntry *entryPtr;
    SchemaCP      *pattern, *current = NULL;
    void          *namespacePtr, *savedNamespacePtr;
    char          *xmlstr, *errMsg;
    domDocument   *doc;
    domNode       *node;

    static const char *schemaInstanceMethods[] = {
        "defelement", "defpattern", "start", "event", "delete",
................................................................................
                pattern->next = current;
            }
            REMEMBER_PATTERN (pattern);
            Tcl_SetHashValue (entryPtr, pattern);
        }

        if (!sdata->defineToplevel) {
            savedsdata = GETASI;
            if (savedsdata == sdata) {
                SetResult ("Recursive call of schema command is not allowed");
                return TCL_ERROR;
            }
            SETASI(sdata);
        }
        savedDefineToplevel = sdata->defineToplevel;
        savedNamespacePtr = sdata->currentNamespace;
        sdata->defineToplevel = 0;
        sdata->currentNamespace = namespacePtr;
        sdata->cp = pattern;
................................................................................
            }
        } else {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = savedDefineToplevel;
        sdata->currentNamespace = savedNamespacePtr;
        if (!savedDefineToplevel) {
            SETASI(savedsdata);
        }
        break;

    case m_define:
        if (objc != 3) {
            Tcl_WrongNumArgs (interp, 2, objv, "<definition commands>");
            return TCL_ERROR;
        }
        savedsdata = GETASI;
        if (savedsdata == sdata) {
            SetResult ("Recursive call of schema command is not allowed");
            return TCL_ERROR;
        }
        SETASI(sdata);
        savedNumPatternList = sdata->numPatternList;
        sdata->currentNamespace = 0;
        sdata->cp = NULL;
        sdata->contentSize = 0;
        sdata->defineToplevel = 1;
        sdata->evalStub[3] = objv[2];
        result = Tcl_EvalObjv (interp, 4, sdata->evalStub,
                               TCL_EVAL_DIRECT | TCL_EVAL_GLOBAL);
        if (result != TCL_OK) {
            cleanupLastPattern (sdata, savedNumPatternList);
        }
        sdata->defineToplevel = 0;
        SETASI(savedsdata);
        break;

    case m_start:
        if (objc < 3-i || objc > 4-i) {
            Tcl_WrongNumArgs (interp, 2-i, objv, "<documentElement>"
                              " ?<namespace>?");
            return TCL_ERROR;

Changes to tests/schema.test.

227
228
229
230
231
232
233
234






























































235
236
237
238
239
240
241
        {<doc><a/><b/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0}
        






























































test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {






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







227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
        {<doc><a/><b/></doc>}
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1 1 0}

test schema-1.15 {call structure constraint outside define/defelement} {
    set result [catch {tdom::schema::element foo} errMsg]
    lappend result $errMsg
    tdom::schema create grammar
    lappend result [catch {tdom::schema::element foo} errMsg]
    lappend result $errMsg
    lappend result [catch {grammar define {::tdom::schema::element foo}} errMsg]
    lappend result $errMsg
    lappend result [catch {grammar defelement bar {::tdom::schema::element foo}} errMsg]
    lappend result $errMsg
    grammar delete
    set result
} {1 {Command called outside of schema context} 1 {Command called outside of schema context} 1 {Command not allowed at top level in schema define evaluation} 0 {}}

test schema-1.16 {call another schema cmd in a schema definition script} {
    tdom::schema create s1
    s1 define {
        defelement s1a {
            element s1b *
            element s1c
        }
        ::tdom::schema ::s2
        s2 define {
            defelement s1a {
                element s1b *
                element s1c
            }
        }
        defelement s1b {
            element s1b1
        }
    }
    set result [list]
    foreach xml {
        <s1a/>
        <s1a><s1b/><s1c/></s1a>
        <s1a><s1c/></s1a>
        <s1a><s1b><s1b1/></s1b><s1c/></s1a>
    } {
        lappend result [s1 validate $xml]
        lappend result [s2 validate $xml]
    }
    s1 delete
    s2 delete
    set result
} {0 0 0 1 1 1 1 0}

test schema-1.17 {call schema cmd evaluation in his own schema definition script} {
    tdom::schema create s1
    set result [catch {s1 define {
        defelement s1a {
            s1 defelement s1b {
                element s1b1
            }
            element s1b *
            element s1c
        }
    }} errMsg]
    s1 delete
    set result
} 1

test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {