to parse any kind of well-formed XML. The parsers are stream oriented XML
parser. This means that you register handler scripts with the parser prior to
starting the parse. These handler scripts are called when the parser discovers
the associated structures in the document being parsed.  A start tag is an
example of the kind of structures for which you may register a handler
script.</p>

<p>The parsers always check for XML well-formedness of the input (and
report error, if the input isn't well-formed). They parse the internal
DTD and, at request, external DTD and external entities, if you
resolve the identifier of the external entities with the
-externalentitycommand script (see there). If you use the -validateCmd
option (see there), the input is additionally validated.</p>

<p>Additionly, the Tcl extension code that implements this command provides an
API for adding C level coded handlers. Up to now, there exists the parser
extension command "tdom". The handler set installed by this extension build an
in memory "tDOM" DOM tree, while the parser is parsing the input.</p>

<p>It is possible to register an arbitrary amount of different handler scripts

until the next call to the parse method, thus delaying the reporting of some of
the data.</p>

<p>If this option is set to "1" then documents which are not well-formed upon
end of input will generate an error.</p></desc>
        </optdef>

        <optdef>
          <optname>-validateCmd</optname>
          <optarg>&lt;tdom schema cmd&gt;</optarg>

          <desc><p>This option expects the name of a tDOM schema
          command. If this option is given, then the input is also
          validated. If the schema command hasn't set a reportcmd then
          the first validation error will stop further parsing (as a
          well-formedness error).</p></desc>
        </optdef>

        <optdef>
          <optname>-baseurl</optname>
          <optarg>url</optarg>

          <desc><p>Reports the base url of the document to the
parser.</p></desc>
        </optdef>

/*----------------------------------------------------------------------------
|   Copyright (c) 2018, 2019  Rolf Ade ([email protected])
|-----------------------------------------------------------------------------
|
|
|   The contents of this file are subject to the Mozilla Public License
|   Version 2.0 (the "License"); you may not use this file except in
|   compliance with the License. You may obtain a copy of the License at
|   http://www.mozilla.org/MPL/

typedef struct
{
    SchemaData *sdata;
    Tcl_Interp    *interp;
    XML_Parser     parser;
    Tcl_DString   *cdata;
    int            onlyWhiteSpace;
    char          *uri;
    int            maxUriLen;
} ValidateMethodData;

/*----------------------------------------------------------------------------
|   Macros
|

#define serializeElementName(rObj, cp)                  \
    rObj = Tcl_NewObj();                                \
    if (cp->namespace) {                                \
        Tcl_SetStringObj (rObj, cp->namespace, -1);     \
        Tcl_AppendToObj (rObj, ":", 1);                 \
    }                                                   \
    Tcl_AppendToObj (rObj, cp->name, -1);

#define S(str)  str, sizeof (str) -1

static SchemaCP*
initSchemaCP (
    Schema_CP_Type type,
    void *namespace,
    char *name
    )

    FREE (sdata->evalStub);
    Tcl_DecrRefCount (sdata->textStub[0]);
    Tcl_DecrRefCount (sdata->textStub[1]);
    Tcl_DecrRefCount (sdata->textStub[2]);
    FREE (sdata->textStub);
    Tcl_DStringFree (sdata->cdata);
    FREE (sdata->cdata);
    if (sdata->reportCmd) {
        Tcl_DecrRefCount (sdata->reportCmd);
    }
    FREE (sdata);
}

static void
cleanupLastPattern (
    SchemaData *sdata,
    unsigned int from

        sdata->stack->interleaveState = NULL;
    }
    se = sdata->stack->down;
    sdata->stack->down = sdata->stackPool;
    sdata->stackPool = sdata->stack;
    sdata->stack = se;
}

static int 
recover (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char *errType,
    int len
    )
{
    Tcl_Obj *cmdPtr;
    int rc;

    if (!sdata->reportCmd) return 0;
    cmdPtr = Tcl_DuplicateObj (sdata->reportCmd);
    Tcl_IncrRefCount(cmdPtr);
    Tcl_ListObjAppendElement (interp, cmdPtr,
                              sdata->self);
    Tcl_ListObjAppendElement (
        interp, cmdPtr,
        Tcl_NewStringObj (errType, len)
        );
    sdata->currentEvals++;
    rc = Tcl_EvalObjEx (interp, cmdPtr,
                        TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT);
    sdata->currentEvals--;
    Tcl_DecrRefCount (cmdPtr);
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;
}

/* The cp argument must be type SCHEMA_CTYPE_TEXT */
static int
checkText (
    Tcl_Interp *interp,
    void *clientData,
    char *text

    char *namespace
    )
{
    SchemaCP *cp, *candidate, *icp;
    int hm, ac, i, mayskip, rc;
    int isName = 0;
    SchemaValidationStack *se;


    if (!sdata->stack) return 0;
    se = sdata->stack;
    getContext (cp, ac, hm);

    switch (cp->type) {
    case SCHEMA_CTYPE_NAME:
        isName = 1;
        /* fall through */
    case SCHEMA_CTYPE_PATTERN:
        while (ac < cp->nc) {
            candidate = cp->content[ac];
            mayskip = 0;
            switch (candidate->type) {
            case SCHEMA_CTYPE_TEXT:
                if (candidate->nc) {
                    if (!checkText (interp, candidate, "")) {






                        if (recover (interp, sdata, S("MISSING_TEXT"))) {


                            mayskip = 1;







                            break;
                        }                        

                        return 0;
                    }
                }
                break;

            case SCHEMA_CTYPE_ANY:
                updateStack (se, cp, ac);

                            return 1;
                        }
                        popStack (sdata);
                        if (rc == -1) mayskip = 1;
                        break;

                    case SCHEMA_CTYPE_VIRTUAL:
                        Tcl_Panic ("Virtual constrain in MIXED or CHOICE");

                        
                    }
                    if (!mayskip && mayMiss (candidate->quants[i]))
                        mayskip = 1;
                }
                break;

            case SCHEMA_CTYPE_VIRTUAL:
                if (evalVirtual (interp, sdata, candidate)) {
                    /* Virtual contraints are always quant ONE, so
                     * that the virtual constraints are called while
                     * looking if an element can end. Therefor we use
                     * here the already present mayskip mechanism to
                     * try further, after calling the tcl script. */
                    mayskip = 1;
                    break;
                }
                else return 0;

            case SCHEMA_CTYPE_INTERLEAVE:
            case SCHEMA_CTYPE_PATTERN:
                pushToStack (sdata, candidate);
                rc = matchElementStart (interp, sdata, name, namespace);
                if (rc == 1) {
                    updateStack (se, cp, ac);
                    return 1;
                }
                popStack (sdata);

                break;
            }
            if (!mayskip && mustMatch (cp->quants[ac], hm)) {
                if (recover (interp, sdata, S("MISSING_CP"))) {
                    /* Skip the just opened element tag and the following
                     * content of the current. */
                    sdata->skipDeep = 2;
                    return 1;
                }
                return 0;
            }
            ac++;
            hm = 0;
        }
        if (isName) {
            if (recover (interp, sdata, "UNEXPECTED_ELEMENT", 15)) {
                /* Skip the just opened element tag and the following
                 * content of the current. */
                sdata->skipDeep = 2;
                return 1;
            }
            return 0;
        }
        return -1;

    case SCHEMA_CTYPE_VIRTUAL:
    case SCHEMA_CTYPE_CHOICE:
    case SCHEMA_CTYPE_TEXT:
    case SCHEMA_CTYPE_ANY:
        /* Never pushed onto stack */
        Tcl_Panic ("Invalid CTYPE onto the validation stack!");

    case SCHEMA_CTYPE_INTERLEAVE:
        mayskip = 1;
        for (i = 0; i < cp->nc; i++) {

            if (se->interleaveState[i]) {
                if (maxOne (cp->quants[i])) continue;
            }
            icp = cp->content[i];
            switch (icp->type) {
            case SCHEMA_CTYPE_TEXT:
                if (icp->nc) {
                    if (!checkText (interp, icp, "")) {
                        mayskip = 0;
                    }
                }
                break;

            case SCHEMA_CTYPE_ANY:
                sdata->skipDeep = 1;
                if (mayskip && minOne (cp->quants[i])) mayskip = 0;
                se->hasMatched = 1;
                se->interleaveState[i] = 1;
                return 1;

            case SCHEMA_CTYPE_NAME:
                if (icp->name == name
                    && icp->namespace == namespace) {

                rc = matchElementStart (interp, sdata, name, namespace);
                if (rc == 1) {
                    se->hasMatched = 1;
                    se->interleaveState[i] = 1;
                    return 1;
                }
                popStack (sdata);
                if (mayskip && rc != -1) mayskip = 0;
                break;

            case SCHEMA_CTYPE_VIRTUAL:
                Tcl_Panic ("Virtual constraint child of INTERLEAVE");
                break;
            }

        }
                
        if (mayskip) break;
        if (recover (interp, sdata, S("UNCOMPLET_CP"))) {
            sdata->skipDeep = 2;
            return 1;
        }
    }
    
    return -1;
}

int
probeElement (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char *name,

    }

    if (sdata->stack) {
        SchemaValidationStack *se;
        se = sdata->stack;
        if (se->pattern->type == SCHEMA_CTYPE_NAME
            && se->activeChild >= se->pattern->nc) {
            if (recover (interp, sdata, S("UNEXPECTED_ELEMENT"))) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            SetResult ("Unexpected child element \"");
            if (namespacePtr) {
                Tcl_AppendResult (interp, namespacePtr, ":", NULL);
            }
            Tcl_AppendResult (interp, name, "\" for element \"", NULL);
            if (se->pattern->namespace) {
                Tcl_AppendResult (interp, namespace, ":", NULL);
            }
            Tcl_AppendResult (interp, name, "\"", NULL);
            return TCL_ERROR;
        }
    } else {
        if (!pattern) {
            if (recover (interp, sdata, S("UNKNOWN_ROOT_ELEMENT"))) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            SetResult ("Unknown element");
            return TCL_ERROR;
        }
        pushToStack (sdata, pattern);
        sdata->validationState = VALIDATION_STARTED;
        return TCL_OK;
    }

                if (!cp->attrs[i]->namespace
                    || (strcmp (cp->attrs[i]->namespace, namespace) != 0))
                    continue;
            }
            if (strcmp (ln, cp->attrs[i]->name) == 0) {
                found = 1;
                if (cp->attrs[i]->cp) {
                    if (!checkText (interp, cp->attrs[i]->cp,
                                    (char *) atPtr[1])) {
                        if (!recover (interp, sdata,
                                      S("WRONG_ATTRIBUTE_VALUE"))) {
                            if (nsatt) namespace[j] = '\xFF';
                            SetResult3 ("Attribute value doesn't match for "
                                        "attribute '", atPtr[0], "'");
                            return TCL_ERROR;
                        }
                    }
                }
                if (cp->attrs[i]->required) reqAttr++;
                break;
            }
        }
        if (nsatt) namespace[j] = '\xFF';
        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"))) {
                SetResult3 ("Unknown attribute \"", atPtr[0], "\"");
                return TCL_ERROR;
            }
        }
    }
    if (reqAttr != cp->numReqAttr) {
        /* Lookup the missing attribute(s) */
        SetResult ("Missing mandatory attribute(s):");
        for (i = 0; i < cp->numAttr; i++) {
            if (!cp->attrs[i]->required) continue;

                }
                if (strcmp (atPtr[0], cp->attrs[i]->name) == 0) {
                    found = 1;
                    break;
                }
            }
            if (!found) {
                if (!recover (interp, sdata, S("MISSING_ATTRIBUTE"))) {
                    if (cp->attrs[i]->namespace) {
                        Tcl_AppendResult (interp, " ", cp->attrs[i]->namespace,
                                          ":", cp->attrs[i]->name, NULL);
                    } else {
                        Tcl_AppendResult (interp, " ", cp->attrs[i]->name, NULL);
                    }
                }
            }
        }
        if (!sdata->reportCmd) {
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

int probeDomAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,

                if (!cp->attrs[i]->namespace) continue;
                if (strcmp (ns, cp->attrs[i]->namespace) != 0) continue;
            } else {
                if (cp->attrs[i]->namespace) continue;
            }
            if (strcmp (ln, cp->attrs[i]->name) == 0) {
                if (cp->attrs[i]->cp) {
                    if (!checkText (interp, cp->attrs[i]->cp,
                                    (char *) atPtr->nodeValue)) {
                        if (!recover (interp, sdata,
                                      S("WRONG_ATTRIBUTE_VALUE"))) {
                            SetResult3 ("Attribute value doesn't match for "
                                        "attribute '", ln, "'");
                            return TCL_ERROR;
                        }
                    }
                }
                found = 1;
                if (cp->attrs[i]->required) reqAttr++;
                break;
            }
        }
        if (!found) {
            if (!recover (interp, sdata, S("UNKNOWN_ATTRIBUTE"))) {
                if (ns) {
                    SetResult ("Unknown attribute \"");
                    Tcl_AppendResult (interp, ns, ":", atPtr->nodeName,
                                      "\"");
                } else {
                    SetResult3 ("Unknown attribute \"", atPtr->nodeName, "\"");
                }
                sdata->validationState = VALIDATION_ERROR;
                return TCL_ERROR;
            }
        }
    nextAttr:
        atPtr = atPtr->nextSibling;
    }
    if (reqAttr != cp->numReqAttr) {
        /* Lookup the missing attribute(s) */
        SetResult ("Missing mandatory attribute(s):");

                    found = 1;
                    break;
                }
            nextAttr2:
                atPtr = atPtr->nextSibling;
            }
            if (!found) {
                if (!recover (interp, sdata, S("MISSING_ATTRIBUTE"))) {
                    if (cp->attrs[i]->namespace) {
                        Tcl_AppendResult (interp, " ", cp->attrs[i]->namespace,
                                          ":", cp->attrs[i]->name, NULL);
                    } else {
                        Tcl_AppendResult (interp, " ", cp->attrs[i]->name,
                                          NULL);
                    }
                }
            }
        }
        if (!sdata->reportCmd) {
            sdata->validationState = VALIDATION_ERROR;
            return TCL_ERROR;
        }
    }
    return TCL_OK;
}

static int checkElementEnd (
    Tcl_Interp *interp,
    SchemaData *sdata
    )
{
    SchemaValidationStack *se;
    SchemaCP *cp, *ic;
    int hm, ac, i, mayMiss, rc;
    int isName = 0;

    DBG(fprintf (stderr, "checkElementEnd:\n");
        serializeStack(sdata););
    se = sdata->stack;

                ac++; continue;
            }
            
            switch (cp->content[ac]->type) {
            case SCHEMA_CTYPE_TEXT:
                if (cp->content[ac]->nc) {
                    if (!checkText (interp, cp->content[ac], "")) {
                        if (recover (interp, sdata, S("MISSING_TEXT"))) {
                            break;
                        }
                        return 0;
                    }
                }
                break;

            case SCHEMA_CTYPE_CHOICE:
                mayMiss = 0;

                        if (checkElementEnd (interp, sdata)) {
                            mayMiss = 1;
                        }
                        popStack (sdata);
                        break;
                        
                    case SCHEMA_CTYPE_VIRTUAL:
                        Tcl_Panic ("Virtual constrain in MIXED or CHOICE");


                        


                    }
                    if (mayMiss) break;
                }
                if (mayMiss) break;
                if (!recover (interp, sdata, S("MISSING_ONE_OF_CHOICE"))) {
                    return 0;
                }

                break;


                
            case SCHEMA_CTYPE_VIRTUAL:
                if (evalVirtual (interp, sdata, cp->content[ac])) break;
                else return 0;
                
            case SCHEMA_CTYPE_INTERLEAVE:
            case SCHEMA_CTYPE_PATTERN:
                pushToStack (sdata, cp->content[ac]);
                rc = checkElementEnd (interp, sdata);
                popStack (sdata);
                if (rc) break;
                return 0;
                
            case SCHEMA_CTYPE_ANY:
            case SCHEMA_CTYPE_NAME:
                if (recover (interp, sdata, S("MISSING_ELEMENT"))) {
                    break;
                }
                return 0;
            }
            ac++;
        }
        if (isName) return 1;
        return -1;

    case SCHEMA_CTYPE_VIRTUAL:
    case SCHEMA_CTYPE_CHOICE:
    case SCHEMA_CTYPE_TEXT:
    case SCHEMA_CTYPE_ANY:
        /* Never pushed onto stack */
        Tcl_Panic ("Invalid CTYPE onto the validation stack!");
        return 0;

    case SCHEMA_CTYPE_INTERLEAVE:
        for (i = 0; i < cp->nc; i++) {
            if (mustMatch (cp->quants[i], se->interleaveState[i])) {
                if (recover (interp, sdata, S("MISSING_ONE_OF_INTERLEAVE"))) {
                    break;
                }
                return 0;
            }
        }
        return -1;
    }
    return 0;
}

matchText (
    Tcl_Interp *interp,
    SchemaData *sdata,
    char *text
    )
{
    SchemaCP *cp, *candidate, *ic;
    SchemaValidationStack *se;
    int ac, hm, isName = 0, i;

    DBG(fprintf (stderr, "matchText called with text '%s'\n", text));
    
    while (1) {
        se = sdata->stack;
        getContext (cp, ac, hm);

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

                        case SCHEMA_CTYPE_VIRTUAL:




                            if (!evalVirtual (interp, sdata, ic)) return 0;
                            break;
                            
                        case SCHEMA_CTYPE_CHOICE:
                            Tcl_Panic ("MIXED or CHOICE child of MIXED or CHOICE");

                        }

                    if (mustMatch (cp->quants[ac], hm)) {
                        SetResult ("Unexpected text content");
                        return 0;
                    }
                    break;

                case SCHEMA_CTYPE_VIRTUAL:




                    if (!evalVirtual (interp, sdata, ic)) return 0;
                    break;
                    
                case SCHEMA_CTYPE_NAME:
                case SCHEMA_CTYPE_ANY:
                    if (mustMatch (cp->quants[ac], hm)) {
                        SetResult ("Unexpected text content");

            break;
        }
        if (only_whites)  return TCL_OK;
        if (matchText (interp, sdata, text)) {
            return TCL_OK;
        }
    }
    if (recover (interp, sdata, S("WRONG_VALUE"))) {
        return TCL_OK;
    }            
    SetResult ("Text content doesn't match");
    return TCL_ERROR;
}

static void
startElement(
    void         *userData,
    const char   *name,
    const char  **atts
)
{
    ValidateMethodData *vdata = (ValidateMethodData *) userData;
    SchemaData *sdata;
    char *namespace;
    const char *s;
    int i = 0;

    DBG(fprintf (stderr, "startElement: '%s'\n", name);)

    sdata = vdata->sdata;
    if (!sdata->skipDeep && sdata->stack && Tcl_DStringLength (vdata->cdata)) {
        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
        }
        Tcl_DStringSetLength (vdata->cdata, 0);
        vdata->onlyWhiteSpace = 1;
    }
    s = name;
    while (*s && *s != '\xFF') {
        i++; s++;
    }
    namespace = NULL;
    if (*s == '\xFF') {

            vdata->uri[i] = '\0';
            namespace = vdata->uri;
        }
    } else {
        s = name;
    }

    if (probeElement (vdata->interp, sdata, s, namespace)
        != TCL_OK) {
        sdata->validationState = VALIDATION_ERROR;
        XML_StopParser (vdata->parser, 0);
        return;
    }
    if (atts[0] || (sdata->stack
                    && sdata->stack->pattern->attrs)) {
        if (probeAttributes (vdata->interp, sdata, atts)
            != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
        }
    }
}

static void
endElement (
    void        *userData,
    const char  *name
)
{
    ValidateMethodData *vdata = (ValidateMethodData *) userData;
    SchemaData *sdata;
    
    DBG(fprintf (stderr, "endElement: '%s'\n", name);)
    sdata = vdata->sdata;
    if (sdata->validationState == VALIDATION_ERROR) {
        return;
    }
    if (!sdata->skipDeep && sdata->stack && Tcl_DStringLength (vdata->cdata)) {

        if (probeText (vdata->interp, sdata,
                       Tcl_DStringValue (vdata->cdata)) != TCL_OK) {
            sdata->validationState = VALIDATION_ERROR;
            XML_StopParser (vdata->parser, 0);
            Tcl_DStringSetLength (vdata->cdata, 0);
            vdata->onlyWhiteSpace = 1;
            return;
        }
    }
    if (Tcl_DStringLength (vdata->cdata)) {
        Tcl_DStringSetLength (vdata->cdata, 0);
        vdata->onlyWhiteSpace = 1;
    }
    if (probeElementEnd (vdata->interp, sdata)
        != TCL_OK) {
        sdata->validationState = VALIDATION_ERROR;
        XML_StopParser (vdata->parser, 0);
    }
}

static void
characterDataHandler (
    void        *userData,
    const char  *s,
    int          len
)
{
    ValidateMethodData *vdata = (ValidateMethodData *) userData;
    const char *pc;
    
    if (vdata->onlyWhiteSpace) {
        int i = 0;
        pc = s;
        while (i < len) {
            if ( (*pc == ' ')  ||
                 (*pc == '\n') ||
                 (*pc == '\r') ||
                 (*pc == '\t') ) {
                pc++;
                i++;
                continue;
            }
            vdata->onlyWhiteSpace = 0;
            break;
        }
    }
    Tcl_DStringAppend (vdata->cdata, s, len);
}

static int
validateString (
    Tcl_Interp *interp,
    SchemaData *sdata,

    parser = XML_ParserCreate_MM (NULL, MEM_SUITE, &sep);
    vdata.interp = interp;
    vdata.sdata = sdata;
    vdata.parser = parser;
    Tcl_DStringInit (&cdata);
    vdata.cdata = &cdata;
    vdata.onlyWhiteSpace = 1;
    vdata.uri = (char *) MALLOC (URI_BUFFER_LEN_INIT);
    vdata.maxUriLen = URI_BUFFER_LEN_INIT;
    XML_SetUserData (parser, &vdata);
    XML_SetElementHandler (parser, startElement, endElement);
    XML_SetCharacterDataHandler (parser, characterDataHandler);

    if (XML_Parse (parser, xmlstr, len, 1) != XML_STATUS_OK

        pattern->type = SCHEMA_CTYPE_TEXT;
    } else {
        h = Tcl_FindHashEntry (&sdata->textDef, Tcl_GetString (objv[2]));
        if (!h) {
            SetResult3 ("Unknown text type \"", Tcl_GetString (objv[2]), "\"");
            return TCL_ERROR;
        }
        quant = SCHEMA_CQUANT_ONE;
        pattern = (SchemaCP *) Tcl_GetHashValue (h);
        sdata->cp->flags |= CONSTRAINT_TEXT_CHILD;
    }
    if (objc < 3) {
        REMEMBER_PATTERN (pattern)
    }
    addToContent (sdata, pattern, quant, 0, 0);

            element a
            any
            element b
        }
        defelement a {}
        defelement b {}
    }
    set result [list]
    foreach xml {
        <doc><a/><something/><b/></doc>
        <doc><a/><a><b>text</b><c><c><c/></c></c></a><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {1 1}            

test schema-10.2 {any} {
    tdom::schema create s
    s define {

            element a2
        }
    }
    set result [lsort [s info defelements]]
    s delete
    set result
} {a b}

proc schema-18 {args} {
    lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element e
            text {minLength 1}
            element e
        }
    }
    s reportcmd schema-18
    set result ""
    set rc [s validate {<doc><e/></doc>}]
    lappend result $rc
    s delete
    set result
} {s MISSING_TEXT s MISSING_ELEMENT 1}

test schema-18.1a {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element e
            text {minLength 1}
            element e
        }
    }
    s reportcmd schema-18
    set result ""
    set rc [s validate {<doc><e/><e/></doc>}]
    lappend result $rc
    s delete
    set result
} {s MISSING_TEXT 1}

test schema-18.2 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element a
            element b
            element c
        }
    }
    s reportcmd schema-18
    set result ""
    set rc [s validate {<doc><a/><c/></doc>}]
    lappend result $rc
    s delete
    set result
} {s MISSING_CP 1}

test schema-18.3 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {
            element a
        }
    }
    s reportcmd schema-18
    set result ""
    foreach xml {
        <foo/>
        <bar>baz</bar>
        <bar>baz<a/>grill</bar>
        <bar><a><b/></a></bar>
    } {
        set rc [s validate $xml]
        lappend result $rc
    }
    s delete
    set result
} {s UNKNOWN_ROOT_ELEMENT 1 s UNKNOWN_ROOT_ELEMENT 1 s UNKNOWN_ROOT_ELEMENT 1 s UNKNOWN_ROOT_ELEMENT 1}

proc validatedSAX {g xml {keepEmpties 1}} {
    set args [list -validateCmd $g]
    if {!$keepEmpties} {
        lappend args -ignorewhitespace 1
    }
    xml::parser p {*}$args
    set rc [catch {p parse $xml} errMsg]
    p delete
    return $rc
}

proc validatedDOM {g xml {keepEmpties 0}} {
    set args [list -validateCmd $g]
    if {$keepEmpties} {
        lappend args -keepEmpties
    }
    set rc [catch {
        set doc [dom parse {*}$args $xml]
    } errMsg]
    if {$doc ne ""} {
        $doc delete
    }
    return $rc
}

proc postValidation {g xml} {
    set doc [dom parse $xml]
    set rc [$g domvalidate $doc errMsg]
    $doc delete
    return $rc
}


}