Index: generic/schema.c ================================================================== --- generic/schema.c +++ generic/schema.c @@ -295,14 +295,17 @@ ); break; case SCHEMA_CTYPE_TEXT: /* content/quant will be allocated, if the cp in fact has * constraints */ + break; + case SCHEMA_CTYPE_KEYSPACE_END: + case SCHEMA_CTYPE_KEYSPACE: + pattern->name = name; break; case SCHEMA_CTYPE_VIRTUAL: case SCHEMA_CTYPE_ANY: - case SCHEMA_CTYPE_KEYSPACE: /* Do nothing */ break; } return pattern; } @@ -313,10 +316,11 @@ ) { fprintf (stderr, "CP %p type: %s\n", pattern, Schema_CP_Type2str[pattern->type]); switch (pattern->type) { + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: fprintf (stderr, "\tName: '%s'\n", pattern->name); break; case SCHEMA_CTYPE_NAME: case SCHEMA_CTYPE_PATTERN: @@ -929,10 +933,11 @@ break; case SCHEMA_CTYPE_VIRTUAL: Tcl_Panic ("Virtual constrain in MIXED or CHOICE"); + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: Tcl_Panic ("Keyspace constrain in MIXED or CHOICE"); } if (!mayskip && mayMiss (candidate->quants[i])) @@ -960,10 +965,13 @@ updateStack (se, cp, ac); return 1; } popStack (sdata); + break; + case SCHEMA_CTYPE_KEYSPACE_END: + break; case SCHEMA_CTYPE_KEYSPACE: break; } @@ -989,10 +997,11 @@ return 0; } return -1; case SCHEMA_CTYPE_KEYSPACE: + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_VIRTUAL: case SCHEMA_CTYPE_CHOICE: case SCHEMA_CTYPE_TEXT: case SCHEMA_CTYPE_ANY: /* Never pushed onto stack */ @@ -1049,10 +1058,11 @@ case SCHEMA_CTYPE_VIRTUAL: Tcl_Panic ("Virtual constraint child of INTERLEAVE"); break; + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: Tcl_Panic ("Keyspace constraint child of INTERLEAVE"); break; } @@ -1483,10 +1493,13 @@ if (mayMiss (cp->quants[ac])) { ac++; continue; } switch (cp->content[ac]->type) { + case SCHEMA_CTYPE_KEYSPACE_END: + break; + case SCHEMA_CTYPE_KEYSPACE: break; case SCHEMA_CTYPE_TEXT: if (cp->content[ac]->nc) { @@ -1528,10 +1541,11 @@ mayMiss = 1; } popStack (sdata); break; + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: case SCHEMA_CTYPE_VIRTUAL: case SCHEMA_CTYPE_CHOICE: Tcl_Panic ("Invalid CTYPE in MIXED or CHOICE"); @@ -1566,10 +1580,11 @@ ac++; } if (isName) return 1; return -1; + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: case SCHEMA_CTYPE_VIRTUAL: case SCHEMA_CTYPE_CHOICE: case SCHEMA_CTYPE_TEXT: case SCHEMA_CTYPE_ANY: @@ -1779,10 +1794,11 @@ break; case SCHEMA_CTYPE_CHOICE: Tcl_Panic ("MIXED or CHOICE child of MIXED or CHOICE"); + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: Tcl_Panic ("Keyspace constrain in MIXED or CHOICE"); } } @@ -1810,10 +1826,14 @@ if (!evalVirtual (interp, sdata, candidate)) return 0; break; case SCHEMA_CTYPE_KEYSPACE: + break; + + case SCHEMA_CTYPE_KEYSPACE: + break; case SCHEMA_CTYPE_NAME: case SCHEMA_CTYPE_ANY: if (mustMatch (cp->quants[ac], hm)) { @@ -1867,18 +1887,23 @@ break; case SCHEMA_CTYPE_CHOICE: Tcl_Panic ("MIXED or CHOICE child of INTERLEAVE"); + case SCHEMA_CTYPE_KEYSPACE_END: case SCHEMA_CTYPE_KEYSPACE: Tcl_Panic ("Keyspace child of INTERLEAVE"); case SCHEMA_CTYPE_VIRTUAL: break; } } + + case SCHEMA_CTYPE_KEYSPACE: + + break; case SCHEMA_CTYPE_KEYSPACE: break; } @@ -3793,32 +3818,45 @@ Tcl_Obj *const objv[] ) { SchemaData *sdata = GETASI; SchemaCP *pattern; - int nrFlags; + int nrKeyspaces, i; + Tcl_Obj *ksObj; CHECK_SI CHECK_TOPLEVEL - checkNrArgs (2, 3, "Expected: ?flags?"); + checkNrArgs (3, 3, "Expected: pattern"); if (sdata->cp->type != SCHEMA_CTYPE_NAME && sdata->cp->type != SCHEMA_CTYPE_PATTERN) { SetResult ("The keyspace schema definition command is only " "allowed in sequential context (defelement, " "element or defpattern)"); return TCL_ERROR; } - if (objc == 3) { - if (Tcl_ListObjLength (interp, objv[2], &nrFlags) != TCL_OK) { - SetResult ("The optional argument must be a valid tcl " - "list"); - return TCL_ERROR; - } - } - pattern = initSchemaCP (SCHEMA_CTYPE_KEYSPACE, NULL, NULL); - REMEMBER_PATTERN (pattern); - + if (Tcl_ListObjLength (interp, objv[1], &nrKeyspaces) != TCL_OK) { + SetResult ("The argument must be a valid tcl " + "list"); + return TCL_ERROR; + } + for (i = 0; i < nrKeyspaces; i++) { + Tcl_ListObjIndex (interp, objv[1], i, &ksObj); + pattern = initSchemaCP (SCHEMA_CTYPE_KEYSPACE, + Tcl_GetString (ksObj), NULL); + REMEMBER_PATTERN (pattern); + addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0); + } + if (Tcl_EvalObjEx (interp, objv[2], TCL_EVAL_DIRECT) != TCL_OK) { + return TCL_ERROR; + } + for (i = 0; i < nrKeyspaces; i++) { + Tcl_ListObjIndex (interp, objv[1], i, &ksObj); + pattern = initSchemaCP (SCHEMA_CTYPE_KEYSPACE_END, + Tcl_GetString (ksObj), NULL); + REMEMBER_PATTERN (pattern); + addToContent (sdata, pattern, SCHEMA_CQUANT_ONE, 0, 0); + } return TCL_OK; } static int integerImpl (