tDOM

Check-in [a155f2862c]
Login

Check-in [a155f2862c]

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

Overview
Comment:wip
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | wip
Files: files | file ages | folders
SHA3-256: a155f2862c11cfd636afa0d417b83dad60f5fc4eb9fca6d6efd8b647aeb384a4
User & Date: rolf 2019-05-01 23:55:56.491
Context
2019-05-02
12:11
Done. Closed-Leaf check-in: 9a631db368 user: rolf tags: wip
2019-05-01
23:55
wip check-in: a155f2862c user: rolf tags: wip
14:56
wip check-in: a858a6ac77 user: rolf tags: wip
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/schema.c.
︙︙
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174

    char *text
    )
{
    SchemaCP *cp = (SchemaCP *) constraintData;
    int rc = 0;
    char *p, *end, saved = 0;
    
    fprintf (stderr, "hier: '%s' -->", text);
    p = text;
    while (*p != 0) {
        while(SPACE (*p)) p++;
        if (*p == 0) break;
        end = p; end++;
        while (*end != 0 && !SPACE(*end)) end++;
        saved = *end;
        *end = 0;
        fprintf (stderr, " '%s'", p);
        rc = checkText (interp, cp, p);
        *end = saved;
        p = end;
        if (!rc) break;
    }
    fprintf (stderr, "\n");
    return rc;
}

typedef struct
{
    int        nrArg;
    Tcl_Obj  **evalStub;








<








<





<








4145
4146
4147
4148
4149
4150
4151

4152
4153
4154
4155
4156
4157
4158
4159

4160
4161
4162
4163
4164

4165
4166
4167
4168
4169
4170
4171

    char *text
    )
{
    SchemaCP *cp = (SchemaCP *) constraintData;
    int rc = 0;
    char *p, *end, saved = 0;
    

    p = text;
    while (*p != 0) {
        while(SPACE (*p)) p++;
        if (*p == 0) break;
        end = p; end++;
        while (*end != 0 && !SPACE(*end)) end++;
        saved = *end;
        *end = 0;

        rc = checkText (interp, cp, p);
        *end = saved;
        p = end;
        if (!rc) break;
    }

    return rc;
}

typedef struct
{
    int        nrArg;
    Tcl_Obj  **evalStub;
︙︙
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219

    char *text
    )
{
    splitTclTCData *tcdata = (splitTclTCData *) constraintData;
    int rc, listlen, i;
    Tcl_Obj *list, *listelm;

    fprintf (stderr, "HIIIER nrArg: %d\n", tcdata->nrArg);
    tcdata->evalStub[tcdata->nrArg-1] = Tcl_NewStringObj(text, -1);
    Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    tcdata->sdata->currentEvals++;
    rc = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
                       TCL_EVAL_GLOBAL);
    tcdata->sdata->currentEvals--;
    Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    if (rc != TCL_OK) {
        fprintf (stderr, "EvalError: %s\n", Tcl_GetStringResult (interp));
        tcdata->sdata->evalError = 1;
        return 0;
    }
    list = Tcl_GetObjResult (interp);
    Tcl_IncrRefCount (list);
    Tcl_ResetResult (interp);
    if (Tcl_ListObjLength (interp, list, &listlen) != TCL_OK) {
        Tcl_DecrRefCount (list);
        tcdata->sdata->evalError = 1;
        return 0;
    }
    rc = 1;
    for (i = 0; i < listlen; i++) {
        Tcl_ListObjIndex (interp, list, i, &listelm);
        rc = checkText (interp, tcdata->cp, Tcl_GetString (listelm));
        if (!rc) break;
    }
    Tcl_DecrRefCount (list);
    return rc;








<








<











|








4181
4182
4183
4184
4185
4186
4187

4188
4189
4190
4191
4192
4193
4194
4195

4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214

    char *text
    )
{
    splitTclTCData *tcdata = (splitTclTCData *) constraintData;
    int rc, listlen, i;
    Tcl_Obj *list, *listelm;


    tcdata->evalStub[tcdata->nrArg-1] = Tcl_NewStringObj(text, -1);
    Tcl_IncrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    tcdata->sdata->currentEvals++;
    rc = Tcl_EvalObjv (interp, tcdata->nrArg, tcdata->evalStub,
                       TCL_EVAL_GLOBAL);
    tcdata->sdata->currentEvals--;
    Tcl_DecrRefCount (tcdata->evalStub[tcdata->nrArg-1]);
    if (rc != TCL_OK) {

        tcdata->sdata->evalError = 1;
        return 0;
    }
    list = Tcl_GetObjResult (interp);
    Tcl_IncrRefCount (list);
    Tcl_ResetResult (interp);
    if (Tcl_ListObjLength (interp, list, &listlen) != TCL_OK) {
        Tcl_DecrRefCount (list);
        tcdata->sdata->evalError = 1;
        return 0;
    }
    rc = 0;
    for (i = 0; i < listlen; i++) {
        Tcl_ListObjIndex (interp, list, i, &listelm);
        rc = checkText (interp, tcdata->cp, Tcl_GetString (listelm));
        if (!rc) break;
    }
    Tcl_DecrRefCount (list);
    return rc;
︙︙
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277

    }
    
    if (objc == 2) {
        methodIndex = m_whitespace;
    } else {
        if (Tcl_GetIndexFromObj (interp, objv[1], methods, "type", 0,
                                 &methodIndex) != TCL_OK) {
            fprintf (stderr, "HIIIER %d\n", objc);
            return TCL_ERROR;
        }
    }
    switch ((enum method) methodIndex) {
    case m_whitespace:
        if (objc > 2) {
            SetResult ("Type whitespace expects no argument.");








<








4258
4259
4260
4261
4262
4263
4264

4265
4266
4267
4268
4269
4270
4271

    }
    
    if (objc == 2) {
        methodIndex = m_whitespace;
    } else {
        if (Tcl_GetIndexFromObj (interp, objv[1], methods, "type", 0,
                                 &methodIndex) != TCL_OK) {

            return TCL_ERROR;
        }
    }
    switch ((enum method) methodIndex) {
    case m_whitespace:
        if (objc > 2) {
            SetResult ("Type whitespace expects no argument.");
︙︙
Changes to tests/schema.test.
︙︙
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278




3279
































3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290

        {<doc><a>  </a></doc>}
        {<doc><a>1</a></doc>}
        {<doc><a>-2.1</a></doc>}
        {<doc><a> -2.1
            </a></doc>}
        {<doc><a>-a</a></doc>}
        {<doc><a>-a b c</a></doc>}
        {<doc><a>- 1   2 3.5</a></doc>}
        {<doc><a>- 1   a 3.5</a></doc>}
        {<doc><a>-1 2 fooo</a></doc>}
        {<doc><a>-1 2 fooo   </a></doc>}
    } {
        lappend result [s validate $xml errMsg]




        puts $errMsg
































    }
    s delete
    set result
} {0 0 1 1 1 1 0 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








|
|
|
|


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



|








3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326

        {<doc><a>  </a></doc>}
        {<doc><a>1</a></doc>}
        {<doc><a>-2.1</a></doc>}
        {<doc><a> -2.1
            </a></doc>}
        {<doc><a>-a</a></doc>}
        {<doc><a>-a b c</a></doc>}
        {<doc><a>1   2 3.5</a></doc>}
        {<doc><a> 1   a 3.5</a></doc>}
        {<doc><a>1 2 fooo</a></doc>}
        {<doc><a>1 2 3 -4.5</a></doc>}
    } {
        lappend result [s validate $xml errMsg]
    }
    s delete
    set result
} {0 0 0 1 1 0 0 0 0 0 0 1}

proc schema-14.24 {text} {
    global schema-14.24
    switch ${schema-14.24} {
        1 {return {1 2 3}}
        2 {return {-23.4 .5}}
        3 {return {0 a 5}}
        default {error "Unexpected value of the global var schema-14.24."}
    }
}

test schema-14.24 {split} {
    set schema-14.24 0
    tdom::schema s
    s define {
        defelement doc {
            element a 1 {
                text {
                    split tcl schema-14.24 {
                        number
                    }
                }
            }
        }
    }
    set result [list]
    foreach xml {
        {<doc><a>  </a></doc>}
        {<doc><a>-a</a></doc>}
        {<doc><a>1 2 3 -4.5</a></doc>}
    } {
        incr schema-14.24
        lappend result [s validate $xml errMsg]
    }
    s delete
    set result
} {1 1 0}

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