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

Overview
Comment:Another attempt to get info expected right.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: 03f415149889eb9b1074835d6c81f27bbe56c8d77bc05adcaa7973fc6911c11f
User & Date: rolf 2019-11-05 22:16:39
Context
2019-11-06
20:48
Minor additions. check-in: f5f54ce49b user: rolf tags: schema
2019-11-05
22:16
Another attempt to get info expected right. check-in: 03f4151498 user: rolf tags: schema
2019-11-04
18:08
Added simple recovery, with infrastructure to add more fancy recovery features without too much fall out. Added info expected, which returns the expected (possible) events, even in a validation error report handler. check-in: a16fad774f user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
....
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228

3229

3230



3231
3232
3233







3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
....
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
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
    SchemaData *sdata,
    SchemaValidationStack *se,
    Tcl_Interp *interp,
    Tcl_HashTable *seenCPs,
    Tcl_Obj *rObj
    )
{
    int ac, hm, i, hnew, mustMatch, mayskip;
    SchemaCP *cp, *ic, *jc;
    SchemaValidationStack *se1;

    getContext (cp, ac, hm);
    if (hm && maxOne(cp->quants[ac])) ac++;
    switch (cp->type) {
    case SCHEMA_CTYPE_INTERLEAVE:
................................................................................
            case SCHEMA_CTYPE_KEYSPACE_END:
                mayskip = 1;
                break;
            }
            if (cp->type == SCHEMA_CTYPE_INTERLEAVE) {
                if (minOne(cp->quants[ac])) mustMatch = 1;
            } else {
                if (!mayskip && minOne (cp->quants[ac])) break;
            }
            ac++;

        }

        if (cp->type == SCHEMA_CTYPE_NAME && ac == cp->nc) {



            Tcl_ListObjAppendElement (
                interp, rObj, serializeElementEnd (interp)
                );







        }
        break;
        
    case SCHEMA_CTYPE_ANY:
    case SCHEMA_CTYPE_CHOICE:
    case SCHEMA_CTYPE_TEXT:
    case SCHEMA_CTYPE_VIRTUAL:
    case SCHEMA_CTYPE_KEYSPACE:
    case SCHEMA_CTYPE_KEYSPACE_END:
        Tcl_Panic ("Invalid CTYPE onto the validation stack!");
    }
    if (cp->type == SCHEMA_CTYPE_NAME) {
        return 0;
    }
    if (cp->type == SCHEMA_CTYPE_INTERLEAVE && mustMatch) {
        return 0;
    }
    return 1;
}

static Tcl_Obj *
unifyMatchList (
    Tcl_Interp *interp,
    Tcl_HashTable *htable,
    Tcl_Obj *list
................................................................................

static void
getNextExpected (
    SchemaData *sdata,
    Tcl_Interp *interp
    )
{
    int remainingLastMatch, count;
    Tcl_Obj *rObj;
    Tcl_HashTable localHash;
    SchemaValidationStack *se;



    remainingLastMatch = 0;
    if (sdata->lastMatchse) {
        se = sdata->lastMatchse;
        while (se->down) {
            remainingLastMatch++;
            se = se->down;
        }
    } else {
        se = sdata->stack;
    }
    rObj = Tcl_NewObj();
    Tcl_InitHashTable (&localHash, TCL_ONE_WORD_KEYS);
    while (getNextExpectedWorker (sdata, se, interp, &localHash, rObj)) {
        if (remainingLastMatch) {
            count = 0;
            se = sdata->lastMatchse;
            while (count < remainingLastMatch) {
                se = se->down;
                count++;
            }
            remainingLastMatch--;
        } else {







            se = se->down;



        }
    }
    Tcl_DeleteHashTable (&localHash);
    Tcl_SetObjResult (interp, unifyMatchList (interp, &localHash,
                                              rObj));
    Tcl_DecrRefCount (rObj);
}

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







|







 







|


>

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











<
|
<
<
<
<
<







 







|




>
>







<
<
<
<
<
|
|
|
|
|
|
|
|
|
|
>
>
>
>
>
>
>
|
>
>
>



|
<







3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
....
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256

3257





3258
3259
3260
3261
3262
3263
3264
....
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
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341

3342
3343
3344
3345
3346
3347
3348
    SchemaData *sdata,
    SchemaValidationStack *se,
    Tcl_Interp *interp,
    Tcl_HashTable *seenCPs,
    Tcl_Obj *rObj
    )
{
    int ac, hm, i, hnew, mustMatch, mayskip, rc;
    SchemaCP *cp, *ic, *jc;
    SchemaValidationStack *se1;

    getContext (cp, ac, hm);
    if (hm && maxOne(cp->quants[ac])) ac++;
    switch (cp->type) {
    case SCHEMA_CTYPE_INTERLEAVE:
................................................................................
            case SCHEMA_CTYPE_KEYSPACE_END:
                mayskip = 1;
                break;
            }
            if (cp->type == SCHEMA_CTYPE_INTERLEAVE) {
                if (minOne(cp->quants[ac])) mustMatch = 1;
            } else {
                if (!mayskip && !hm && minOne (cp->quants[ac])) break;
            }
            ac++;
            hm = 0;
        }
        rc = 1;
        if (cp->type == SCHEMA_CTYPE_NAME) {
            if (ac == cp->nc) {
                /* The curently open element can end here, no
                 * mandatory elements missing */
                Tcl_ListObjAppendElement (
                    interp, rObj, serializeElementEnd (interp)
                    );
            }
            rc = 0;
        } else if (cp->type == SCHEMA_CTYPE_INTERLEAVE) {
            if (mustMatch) rc = 0;
        } else {
            /* SCHEMA_CTYPE_PATTERN */
            if (ac < cp->nc) rc = 0;
        }
        break;
        
    case SCHEMA_CTYPE_ANY:
    case SCHEMA_CTYPE_CHOICE:
    case SCHEMA_CTYPE_TEXT:
    case SCHEMA_CTYPE_VIRTUAL:
    case SCHEMA_CTYPE_KEYSPACE:
    case SCHEMA_CTYPE_KEYSPACE_END:
        Tcl_Panic ("Invalid CTYPE onto the validation stack!");
    }

    return rc;





}

static Tcl_Obj *
unifyMatchList (
    Tcl_Interp *interp,
    Tcl_HashTable *htable,
    Tcl_Obj *list
................................................................................

static void
getNextExpected (
    SchemaData *sdata,
    Tcl_Interp *interp
    )
{
    int remainingLastMatch, count, rc;
    Tcl_Obj *rObj;
    Tcl_HashTable localHash;
    SchemaValidationStack *se;

    rObj = Tcl_NewObj();
    Tcl_InitHashTable (&localHash, TCL_ONE_WORD_KEYS);
    remainingLastMatch = 0;
    if (sdata->lastMatchse) {
        se = sdata->lastMatchse;
        while (se->down) {
            remainingLastMatch++;
            se = se->down;
        }





        while (se && getNextExpectedWorker (sdata, se, interp, &localHash, rObj)) {
            if (remainingLastMatch) {
                count = 1;
                se = sdata->lastMatchse;
                while (count < remainingLastMatch) {
                    se = se->down;
                    count++;
                }
                remainingLastMatch--;
            } else break;
        }
    }
    
    se = sdata->stack;
    while (se) {
        rc = getNextExpectedWorker (sdata, se, interp, &localHash, rObj);
        if (se->pattern->type == SCHEMA_CTYPE_NAME) break;
        se = se->down;
        if (!rc) {
            if (mayMiss(se->pattern->quants[se->activeChild])) continue;
            break;
        }
    }
    Tcl_DeleteHashTable (&localHash);
    Tcl_SetObjResult (interp, unifyMatchList (interp, &localHash, rObj));

    Tcl_DecrRefCount (rObj);
}

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

Changes to tests/schema.test.

5402
5403
5404
5405
5406
5407
5408
























































































































































5409
5410
5411
5412
5413
5414
5415
    }
    set result {}
    s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
    s delete
    set result
} {astart {a doc} aend {a doc} astart {a doc} aend {a doc}}

























































































































































proc schema-18 {args} {
    lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {







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







5402
5403
5404
5405
5406
5407
5408
5409
5410
5411
5412
5413
5414
5415
5416
5417
5418
5419
5420
5421
5422
5423
5424
5425
5426
5427
5428
5429
5430
5431
5432
5433
5434
5435
5436
5437
5438
5439
5440
5441
5442
5443
5444
5445
5446
5447
5448
5449
5450
5451
5452
5453
5454
5455
5456
5457
5458
5459
5460
5461
5462
5463
5464
5465
5466
5467
5468
5469
5470
5471
5472
5473
5474
5475
5476
5477
5478
5479
5480
5481
5482
5483
5484
5485
5486
5487
5488
5489
5490
5491
5492
5493
5494
5495
5496
5497
5498
5499
5500
5501
5502
5503
5504
5505
5506
5507
5508
5509
5510
5511
5512
5513
5514
5515
5516
5517
5518
5519
5520
5521
5522
5523
5524
5525
5526
5527
5528
5529
5530
5531
5532
5533
5534
5535
5536
5537
5538
5539
5540
5541
5542
5543
5544
5545
5546
5547
5548
5549
5550
5551
5552
5553
5554
5555
5556
5557
5558
5559
5560
5561
5562
5563
5564
5565
5566
5567
    }
    set result {}
    s validate {<doc><a><b>foo</b><c/></a><a><b></b><c>bar</c></a></doc>}
    s delete
    set result
} {astart {a doc} aend {a doc} astart {a doc} aend {a doc}}

test schema-17.16 {info expected} {
    tdom::schema s
    s defelement doc {
        element a
        group {
            group {
                group {
                    element aaaa
                    element bbbb ?
                }
                element bbb ?
            }
            element bb ?
        }
        element b
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s reportcmd schema-17.13
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        set fromReportCmd ""
        lappend result [s validate $xml]
        lappend result {*}$fromReportCmd
    }
    s delete
    set result
} {0 0 1 1 aaaa 1 b bb bbb bbbb 1}

test schema-17.16a {info expected} {
    tdom::schema s
    s defelement doc {
        element a
        group {
            group {
                group {
                    element aaaa *
                    element bbbb ?
                }
                element bbb ?
            }
            element bb ?
        }
        element b
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s reportcmd schema-17.13
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        set fromReportCmd ""
        lappend result [s validate $xml]
        lappend result {*}$fromReportCmd
    }
    s delete
    set result
} {0 0 1 1 aaaa b bb bbb bbbb 1 aaaa b bb bbb bbbb 1}

test schema-17.16b {info expected} {
    tdom::schema s
    s defelement doc {
        element a
        group {
            group {
                group {
                    element aaaa ?
                    element bbbb ?
                }
                element bbb ?
            }
            element bb ?
        }
        element b
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s reportcmd schema-17.13
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        set fromReportCmd ""
        lappend result [s validate $xml]
        lappend result {*}$fromReportCmd
    }
    s delete
    set result
} {0 0 1 1 aaaa b bb bbb bbbb 1 b bb bbb bbbb 1}

test schema-17.16c {info expected} {
    tdom::schema s
    s defelement doc {
        element a
        group {
            group {
                group {
                    element aaaa +
                    element bbbb ?
                }
                element bbb ?
            }
            element bb ?
        }
        element b
    }
    set result [list]
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        lappend result [s validate $xml]
    }
    s reportcmd schema-17.13
    foreach xml {
        <doc><a/></doc>
        <doc><a/><aaaa/></doc>
        <doc><a/><aaaa/><b/></doc>
    } {
        set fromReportCmd ""
        lappend result [s validate $xml]
        lappend result {*}$fromReportCmd
    }
    s delete
    set result
} {0 0 1 1 aaaa 1 aaaa b bb bbb bbbb 1}

proc schema-18 {args} {
    lappend ::result {*}$args
}
test schema-18.1 {reportcmd} {
    tdom::schema s
    s define {
        defelement doc {