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

Overview
Comment:Save work.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | linkvar
Files: files | file ages | folders
SHA3-256: 8b206fdd93284f8d85549749f3029b7b653b69e0b2c38aeadb266488ee96185a
User & Date: rolf 2020-01-18 01:32:05
Context
2020-01-18
01:32
Save work. Leaf check-in: 8b206fdd93 user: rolf tags: linkvar
2020-01-11
02:18
Merged from trunk. check-in: 8cd9ca1c3a user: rolf tags: schema
Changes

Changes to generic/schema.c.

6484
6485
6486
6487
6488
6489
6490
6491
6492
6493
6494
6495
6496
6497
6498
....
7175
7176
7177
7178
7179
7180
7181
































































7182
7183
7184
7185
7186
7187
7188
....
7315
7316
7317
7318
7319
7320
7321


7322
7323
7324
7325
{
    int         nrArg;
    Tcl_Obj   **evalStub;
    SchemaData *sdata;
    SchemaCP   *cp;
} splitTclTCData;


static int
splitTclImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
................................................................................
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = setvarImpl;
    sc->freeData = setvarImplFree;
    sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
    return TCL_OK;
}

































































void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    Tcl_CreateObjCommand (interp, "tdom::schema", tDOM_SchemaObjCmd,
                          NULL, NULL);
................................................................................
                          unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
                          unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
                          unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
                          setvarTCObjCmd, (ClientData) 3, NULL);


}


#endif  /* #ifndef TDOM_NO_SCHEMA */







<







 







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







 







>
>




6484
6485
6486
6487
6488
6489
6490

6491
6492
6493
6494
6495
6496
6497
....
7174
7175
7176
7177
7178
7179
7180
7181
7182
7183
7184
7185
7186
7187
7188
7189
7190
7191
7192
7193
7194
7195
7196
7197
7198
7199
7200
7201
7202
7203
7204
7205
7206
7207
7208
7209
7210
7211
7212
7213
7214
7215
7216
7217
7218
7219
7220
7221
7222
7223
7224
7225
7226
7227
7228
7229
7230
7231
7232
7233
7234
7235
7236
7237
7238
7239
7240
7241
7242
7243
7244
7245
7246
7247
7248
7249
7250
7251
....
7378
7379
7380
7381
7382
7383
7384
7385
7386
7387
7388
7389
7390
{
    int         nrArg;
    Tcl_Obj   **evalStub;
    SchemaData *sdata;
    SchemaCP   *cp;
} splitTclTCData;


static int
splitTclImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
................................................................................
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = setvarImpl;
    sc->freeData = setvarImplFree;
    sc->constraintData = tdomstrdup (Tcl_GetString (objv[1]));
    return TCL_OK;
}

typedef struct
{
    char *varname;
    char *value;
    Tcl_Interp *interp;
} linkvarTCData;

static void
linkvarImplFree (
    void *constraintData
    )
{
    linkvarTCData *linkvarData = (linkvarTCData *) constraintData;
    Tcl_UnlinkVar (linkvarData->interp, linkvarData->varname);
    if (linkvarData->value) FREE (linkvarData->value);
    FREE (linkvarData->varname);
    FREE (linkvarData);
}

static int
linkvarImpl (
    Tcl_Interp *interp,
    void *constraintData,
    char *text
    )
{
    linkvarTCData *linkvarData = (linkvarTCData *) constraintData;

    if (linkvarData->value) FREE (linkvarData->value);
    linkvarData->value = tdomstrdup (text);
    return 1;
}

static int
linkvarTCObjCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    SchemaData *sdata = GETASI;
    linkvarTCData *linkvarData;
    SchemaConstraint *sc;

    CHECK_TI
    checkNrArgs (2,2,"<tcl variable name>");
    linkvarData = TMALLOC (linkvarTCData);
    memset (linkvarData, 0, sizeof (linkvarTCData));
    if (Tcl_LinkVar (interp, Tcl_GetString (objv[1]),
                     (char *) &(linkvarData->value),
                     TCL_LINK_STRING | TCL_LINK_READ_ONLY)) {
        FREE (linkvarData);
        return TCL_ERROR;
    }
    linkvarData->varname = tdomstrdup (Tcl_GetString (objv[1]));
    linkvarData->interp = interp;
    ADD_CONSTRAINT (sdata, sc)
    sc->constraint = linkvarImpl;
    sc->freeData = linkvarImplFree;
    sc->constraintData = linkvarData;
    return TCL_OK;
}
        
void
tDOM_SchemaInit (
    Tcl_Interp *interp
    )
{
    Tcl_CreateObjCommand (interp, "tdom::schema", tDOM_SchemaObjCmd,
                          NULL, NULL);
................................................................................
                          unsignedIntTypesTCObjCmd, (ClientData) 1, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedInt",
                          unsignedIntTypesTCObjCmd, (ClientData) 2, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::unsignedLong",
                          unsignedIntTypesTCObjCmd, (ClientData) 3, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::setvar",
                          setvarTCObjCmd, (ClientData) 3, NULL);
    Tcl_CreateObjCommand (interp,"tdom::schema::text::linkvar",
                          linkvarTCObjCmd, (ClientData) 3, NULL);
}


#endif  /* #ifndef TDOM_NO_SCHEMA */

Changes to tests/schema.test.

5168
5169
5170
5171
5172
5173
5174























5175
5176
5177
5178
5179
5180
5181
        element a ! {text {setvar from_schema-14.44}}
        element b ! {text {setvar from_schema-14.44}}
    }
    set result [s validate "<doc><a>a</a><b>b</b></doc>"]
    s delete
    lappend result ${from_schema-14.44}
} {1 b}
























test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b







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







5168
5169
5170
5171
5172
5173
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
5191
5192
5193
5194
5195
5196
5197
5198
5199
5200
5201
5202
5203
5204
        element a ! {text {setvar from_schema-14.44}}
        element b ! {text {setvar from_schema-14.44}}
    }
    set result [s validate "<doc><a>a</a><b>b</b></doc>"]
    s delete
    lappend result ${from_schema-14.44}
} {1 b}

proc schema-14.45 {args} {
    lappend ::result ${::from_schema-14.45} ${::schema-14.45::foo}
    return 1
}

test schema-14.45 {text constraint linkvar} {
    tdom::schema s
    namespace eval ::schema-14.45 { }
    set ::schema-14.45::foo "foo from namespace"
    set from_schema-14.45 "foo"
    set result [list]
    s defelement doc {
        text {
            linkvar from_schema-14.45
            linkvar ::schema-14.45::foo
            tcl schema-14.45
        }
    }
    s validate "<doc>this</doc>"
    s delete
    list ${::schema-14.45::foo} ${from_schema-14.45}
} {this this}

test schema-15.1 {constraint cmd tcl} {
    tdom::schema s
    s define {
        defelement a {
            tcl append ::schema-15.1
            element b