sizeof (SchemaQuant) * CONTENT_ARRAY_SIZE_INIT
            );
        break;
    case SCHEMA_CTYPE_TEXT:
        /* content/quant will be allocated, if the cp in fact has
         * constraints */
        break;
    case SCHEMA_CTYPE_VIRTUAL:
    case SCHEMA_CTYPE_ANY:
        /* Do nothing */
        break;
    }
    return pattern;
}

        /* Fall thru. */
    case SCHEMA_CTYPE_CHOICE:
    case SCHEMA_CTYPE_INTERLEAVE:
        fprintf (stderr, "\t%d childs\n", pattern->nc);
        break;
    case SCHEMA_CTYPE_ANY:
    case SCHEMA_CTYPE_TEXT:
    case SCHEMA_CTYPE_VIRTUAL:
        /* Do nothing */
        break;
    }
}

static void serializeQuant (
    SchemaQuant quant

    int i;
    SchemaConstraint *sc;

    switch (pattern->type) {
    case SCHEMA_CTYPE_ANY:
        /* do nothing */
        break;
    case SCHEMA_CTYPE_VIRTUAL:
        for (i = 0; i < pattern->nc - 1; i++) {
            Tcl_DecrRefCount ((Tcl_Obj *)pattern->content[i]);
        }
        FREE (pattern->content);
        break;
    case SCHEMA_CTYPE_TEXT:
        for (i = 0; i < pattern->nc; i++) {
            sc = (SchemaConstraint *) pattern->content[i];
            if (sc->freeData) {
                (sc->freeData) (sc->constraintData);
            }
            FREE (pattern->content[i]);

        sc = (SchemaConstraint *) cp->content[i];
        if (!(sc->constraint) (interp, sc->constraintData, text)) {
            return 0;
        }
    }
    return 1;
}

static int
evalVirtual (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp
    )
{
    int rc;

    cp->content[cp->nc-1] = (SchemaCP *) sdata->self;
    rc = Tcl_EvalObjv (interp, cp->nc, (Tcl_Obj **) cp->content,
                       TCL_EVAL_GLOBAL);
    if (rc != TCL_OK) {
        sdata->evalError = 1;
        return 0;
    }
    return 1;
}

static int
matchElementStart (
    Tcl_Interp *interp,
    SchemaData *sdata,
    char *name,
    char *namespace

                        if (rc == 1) {
                            updateStack (se, cp, ac);
                            return 1;
                        }
                        popStack (sdata);
                        if (rc == -1) mayskip = 1;
                        break;

                    case SCHEMA_CTYPE_VIRTUAL:
                        if (evalVirtual (interp, sdata, icp)) break;
                        else return 0;
                        
                    }
                    if (!mayskip && mayMiss (candidate->quants[i]))
                        mayskip = 1;
                }
                break;

            case SCHEMA_CTYPE_VIRTUAL:
                if (evalVirtual (interp, sdata, candidate)) {
                    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);

            }
            ac++;
            hm = 0;
        }
        if (isName) 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:

                    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 (
    Tcl_Interp *interp,
    SchemaData *sdata,

        return TCL_OK;
    }
    DBG(
        fprintf (stderr, "element '%s' DOESN'T match\n", name);
        serializeStack (sdata);
        fprintf (stderr, "\n");
        );
    if (!sdata->evalError) {
        SetResult ("Element \"");
        if (namespacePtr) {
            Tcl_AppendResult (interp, namespacePtr, ":", NULL);
        }
        Tcl_AppendResult (interp, name, "\" doesn't match", NULL);
    }
    return TCL_ERROR;
}

int probeAttributes (
    Tcl_Interp *interp,
    SchemaData *sdata,
    const char **attr

}

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

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

                    case SCHEMA_CTYPE_PATTERN:
                        pushToStack (sdata, ic);
                        if (checkElementEnd (interp, sdata)) {
                            mayMiss = 1;
                        }
                        popStack (sdata);
                        break;
                        
                    case SCHEMA_CTYPE_VIRTUAL:
                        tse = se;
                        while (tse->pattern->type != SCHEMA_CTYPE_NAME) {
                            tse = tse->down;
                        }
                        if (evalVirtual (interp, sdata, ic)) break;
                        else return 0;
                    }
                    if (mayMiss) break;
                }
                if (mayMiss) break;
                return 0;

            case SCHEMA_CTYPE_VIRTUAL:
                tse = se;
                while (tse->pattern->type != SCHEMA_CTYPE_NAME) {
                    tse = tse->down;
                }
                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:
                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;

matchText (
    Tcl_Interp *interp,
    SchemaData *sdata,
    char *text
    )
{
    SchemaCP *cp, *candidate, *ic;
    SchemaValidationStack *se, *tse;
    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);

                            if (matchText (interp, sdata, text)) {
                                updateStack (se, cp, ac);
                                return 1;
                            }
                            popStack (sdata);
                            break;

                        case SCHEMA_CTYPE_VIRTUAL:
                            tse = se;
                            while (tse->pattern->type != SCHEMA_CTYPE_NAME) {
                                tse = tse->down;
                            }
                            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");

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

                case SCHEMA_CTYPE_VIRTUAL:
                    tse = se;
                    while (tse->pattern->type != SCHEMA_CTYPE_NAME) {
                        tse = tse->down;
                    }
                    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");
                        return 0;
                    }
                    break;

                }
                ac++;
            }
            if (isName) {
                SetResult ("Unexpected text content");
                return 0;
            }
            popStack (sdata);
            continue;

        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!");
            break;

                        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;
}

schemaReset (
    SchemaData *sdata
    )
{
    while (sdata->stack) popStack (sdata);
    sdata->validationState = VALIDATION_READY;
    sdata->skipDeep = 0;
    sdata->evalError = 0;
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,

            serializeElementName (elmObj, cp);
            if (Tcl_ListObjAppendElement (interp, resultObj, elmObj) != TCL_OK)
                return TCL_ERROR;
        }
        break;

    case m_stack:
        if (Tcl_GetIndexFromObj (interp, objv[2],
                                 schemaInstanceInfoStackMethods,
                                 "method", 0, &methodIndex)
            != TCL_OK) {
            return TCL_ERROR;
        }
        switch ((enum schemaInstanceInfoStackMethod) methodIndex) {
        case m_top:

    }
    addToContent (sdata, pattern, quant, 0, 0);
    if (objc == 2) {
        return evalConstraints (interp, sdata, pattern, objv[1]);
    }
    return TCL_OK;
}

static int
VirtualPatternObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    SchemaCP *pattern;
    int i;

    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)
    /* We alloc for one arugment more: the always appended schema
     * cmd, */
    pattern->content = MALLOC (sizeof (Tcl_Obj*) * (objc));
    for (i = 1; i < objc; i++) {
        pattern->content[i-1] = (SchemaCP *) objv[i];
        Tcl_IncrRefCount (objv[i]);
    }
    pattern->nc = objc;
    addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0);
    return TCL_OK;
}

static int
integerImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )

    Tcl_CreateObjCommand (interp, "tdom::schema::nsattribute",
                          AttributePatternObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::namespace",
                          NamespacePatternObjCmd, NULL, NULL);
    Tcl_CreateObjCommand (interp, "tdom::schema::text",
                          TextPatternObjCmd, NULL, NULL);

    /* The 'virtual' "tcl" definition command */
    Tcl_CreateObjCommand (interp, "tdom::schema::tcl",
                          VirtualPatternObjCmd, 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);

typedef enum {
  SCHEMA_CTYPE_ANY,
  SCHEMA_CTYPE_NAME,
  SCHEMA_CTYPE_CHOICE,
  SCHEMA_CTYPE_INTERLEAVE,
  SCHEMA_CTYPE_PATTERN,
  SCHEMA_CTYPE_TEXT,
  SCHEMA_CTYPE_VIRTUAL
} Schema_CP_Type;

typedef enum {
  SCHEMA_CQUANT_ONE,
  SCHEMA_CQUANT_OPT,
  SCHEMA_CQUANT_REP,
  SCHEMA_CQUANT_PLUS,

    unsigned int patternListSize;
    unsigned int forwardPatternDefs;
    SchemaQuant *quants;
    unsigned int numQuants;
    unsigned int quantsSize;
    int       currentEvals;
    int       cleanupAfterEval;
    int       evalError;
    Tcl_Obj  *reportCmd;
    Tcl_Obj **evalStub;
    Tcl_Obj **textStub;
    char *currentNamespace;
    int   defineToplevel;
    int   isTextConstraint;
    int   isAttributeConstaint;

#    schema-8.*: tdom::schema validate method
#    schema-9.*: Choice
#    scheam-10.*: Any
#    schema-11.*: attribute, nsattribute
#    schema-12.*: schemaCmd domvalidate
#    schema-13.*: XML namespaces
#    schema-14.*: text
#    schema-15.*: Constraint cmd tcl
#    schema-16.*: interleave
#
# Copyright (c) 2018 Rolf Ade.

source [file join [file dir [info script]] loadtdom.tcl]

if {[dom featureinfo schema]} {

    } {
        lappend result [s validate $xml]
    }
    s delete
    set result
} {0 0 1 0 1 0 1 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 {} ss}

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}

proc schema-15.3 {type cmd} {
    lappend ::schema-15.3 $type [$cmd info stack inside]
}

test schema-15.3 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement doc {
            element a *
        }
        defelement a {
            tcl schema-15.3 astart
            element b ! text
            element c ! text
            tcl schema-15.3 aend
        }
    }
    set schema-15.3 ""
    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.3}
    set result
} {1 {} astart a aend a astart a aend a}

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