tDOM

Check-in [3ce85f17a5]
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Save work.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | localkey
Files: files | file ages | folders
SHA3-256: 3ce85f17a5decf7eb1c966bb89593f53ed26f2384acfa06d2e26c871015adb87
User & Date: rolf 2019-05-11 01:41:47
Original Comment: Save wprk.
Context
2019-05-14
20:04
Merge from schema. check-in: dc36b35000 user: rolf tags: localkey
2019-05-11
01:41
Save work. check-in: 3ce85f17a5 user: rolf tags: localkey
2019-05-10
16:05
Save work. check-in: 2596c19c35 user: rolf tags: localkey
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

3372
3373
3374
3375
3376
3377
3378

3379
3380
3381
3382
3383
3384
3385
3386
3387
3388



3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400



3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431

3432
3433
3434















3435
3436
3437
3438
3439
3440
3441

3442
3443
3444
3445
3446





3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
....
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
}

extern void printAst (int depth, ast t);

static int
processSchemaXPath (
    Tcl_Interp *interp,

    KeyConstraint *kc,
    KeyStep *lastStep,
    StepType nextType,
    ast t,
    int field,
    int toplevel
    )
{
    ast child;
    KeyStep *step;



    
    printAst (0, t);
    while (t) {
        switch (t->type) {
        case GetContextNode:
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            t = t->next;
            continue;
        case CombineSets:



            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            for (child = t->child; child != NULL; child = child->next) {
                if (processSchemaXPath (interp, kc, NULL, SCHEMA_STEP_NONE,
                                        child, field, 0)
                    != TCL_OK) {
                    return TCL_ERROR;
                }
            }
            break;
        case AxisDescendant:
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            nextType = SCHEMA_STEP_DESCENDANT_ELEMENT;
            
            break;
        case IsNSAttr:
        case IsAttr:
            if (!field) {
                SetResult ("Attribute selection is only possible in reduced "
                           "XPath expression for field selectors.");
                return TCL_ERROR;
            }
            /* Fall through */
        case IsElement:
        case IsFQElement:
        case IsNSElement:

            step = TMALLOC (KeyStep);
            memset (step, 0, sizeof (KeyStep));
            step->type = nextType;















            if (lastStep) {
                lastStep->next = step;
            } else {
                if (field) kc->fieldSteps = step;
                else kc->selectSteps = step;
            }
            lastStep = step;

            break;
        case AxisChild:
            nextType = SCHEMA_STEP_ELEMENT;
            break;
        case AxisAttribute:





            nextType = SCHEMA_STEP_ATTRIBUTE;
            break;
        default:
            SetResult ("Not a reduced XPath expression.");
            return TCL_ERROR;
        }
        if (t->child) {
            if (processSchemaXPath (interp, kc, lastStep, nextType,
                                    t->child, field, 0)
                != TCL_OK) {
                return TCL_ERROR;
            }
        }
        toplevel = 0;
        t = t->next;
    }
    return TCL_OK;
}

static int
................................................................................
                    sdata->prefixns, NULL, &f, &errMsg) < 0) {
        SetResult3 ("Error in field xpath: '", errMsg, "");
        FREE (errMsg);
        return TCL_ERROR;
    }
    kc = TMALLOC (KeyConstraint);
    memset (kc, 0, sizeof (KeyConstraint));
    if (processSchemaXPath (interp, kc, NULL, SCHEMA_STEP_NONE, s, 0, 1)
        != TCL_OK) {
        xpathFreeAst (s);
        xpathFreeAst (f);
        freeKeyConstraints (kc);
        return TCL_ERROR;
    }
    if (processSchemaXPath (interp, kc, NULL, SCHEMA_STEP_NONE, f, 1, 1)
        != TCL_OK) {
        xpathFreeAst (s);
        xpathFreeAst (f);
        freeKeyConstraints (kc);
        return TCL_ERROR;
    }
    xpathFreeAst (s);






>








|

>
>
>

|










>
>
>





|
|











<












>



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







>





>
>
>
>
>






<
<
<
<
<
<
<







 







|






|







3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425

3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480







3481
3482
3483
3484
3485
3486
3487
....
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
}

extern void printAst (int depth, ast t);

static int
processSchemaXPath (
    Tcl_Interp *interp,
    SchemaData *sdata,
    KeyConstraint *kc,
    KeyStep *lastStep,
    StepType nextType,
    ast t,
    int field,
    int toplevel
    )
{
    ast child, savedt;
    KeyStep *step;
    Tcl_HashEntry *h;
    int hnew;
    SchemaCP *cp;
    
    /* if (toplevel) printAst (0, t); */
    while (t) {
        switch (t->type) {
        case GetContextNode:
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            t = t->next;
            continue;
        case CombineSets:
            SetResult ("CombineSets to be done.");
            return TCL_ERROR;
                
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            for (child = t->child; child != NULL; child = child->next) {
                if (processSchemaXPath (interp, sdata, kc, NULL,
                                        SCHEMA_STEP_NONE, child, field, 0)
                    != TCL_OK) {
                    return TCL_ERROR;
                }
            }
            break;
        case AxisDescendant:
            if (!toplevel) {
                SetResult ("Not a reduced XPath expression.");
                return TCL_ERROR;
            }
            nextType = SCHEMA_STEP_DESCENDANT_ELEMENT;

            break;
        case IsNSAttr:
        case IsAttr:
            if (!field) {
                SetResult ("Attribute selection is only possible in reduced "
                           "XPath expression for field selectors.");
                return TCL_ERROR;
            }
            /* Fall through */
        case IsElement:
        case IsFQElement:
        case IsNSElement:
            savedt = t;
            step = TMALLOC (KeyStep);
            memset (step, 0, sizeof (KeyStep));
            step->type = nextType;
            if (t->type == IsFQElement || t->type == IsNSAttr) {
                h = Tcl_CreateHashEntry (&sdata->namespace, t->strvalue,
                                         &hnew);
                step->ns = Tcl_GetHashKey (&sdata->namespace, h);
                t = t->child;
            }
            h = Tcl_CreateHashEntry (&sdata->element, t->strvalue, &hnew);
            if (hnew) {
                cp = initSchemaCP (SCHEMA_CTYPE_NAME, step->ns,
                                   Tcl_GetHashKey (&sdata->element, h));
                cp->flags |= PLACEHOLDER_PATTERN_DEF;
                REMEMBER_PATTERN (cp);
                Tcl_SetHashValue (h, cp);
            }
            step->name = Tcl_GetHashKey (&sdata->element, h);
            if (lastStep) {
                lastStep->next = step;
            } else {
                if (field) kc->fieldSteps = step;
                else kc->selectSteps = step;
            }
            lastStep = step;
            t = savedt;
            break;
        case AxisChild:
            nextType = SCHEMA_STEP_ELEMENT;
            break;
        case AxisAttribute:
            if (!field) {
                SetResult ("Attribute selection is only possible in reduced "
                           "XPath expression for field selectors.");
                return TCL_ERROR;
            }
            nextType = SCHEMA_STEP_ATTRIBUTE;
            break;
        default:
            SetResult ("Not a reduced XPath expression.");
            return TCL_ERROR;
        }







        toplevel = 0;
        t = t->next;
    }
    return TCL_OK;
}

static int
................................................................................
                    sdata->prefixns, NULL, &f, &errMsg) < 0) {
        SetResult3 ("Error in field xpath: '", errMsg, "");
        FREE (errMsg);
        return TCL_ERROR;
    }
    kc = TMALLOC (KeyConstraint);
    memset (kc, 0, sizeof (KeyConstraint));
    if (processSchemaXPath (interp, sdata, kc, NULL, SCHEMA_STEP_NONE, s, 0, 1)
        != TCL_OK) {
        xpathFreeAst (s);
        xpathFreeAst (f);
        freeKeyConstraints (kc);
        return TCL_ERROR;
    }
    if (processSchemaXPath (interp, sdata, kc, NULL, SCHEMA_STEP_NONE, f, 1, 1)
        != TCL_OK) {
        xpathFreeAst (s);
        xpathFreeAst (f);
        freeKeyConstraints (kc);
        return TCL_ERROR;
    }
    xpathFreeAst (s);

Changes to tests/schema.test.

592
593
594
595
596
597
598











599
600
601
602
603
604
605
....
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582

4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595

4596
4597
4598
4599
4600
4601


4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
        }
    } errMsg]
    lappend result $errMsg
    s delete
    set result
} {1 {Command only allowed at lop level} 1 {Command only allowed at lop level} 1 {Method not allowed in nested schema define script} 1 {This recursive call is not allowed}}












test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {
................................................................................
    set result [list]
    foreach xml {
        <doc/>
        <doc><b/></doc>
        <doc><a/></doc>
        {<doc><a ref="1"/><a ref="foo"/></doc>}
    } {
        lappend result [s validate $xml errMsg]
        puts $errMsg
    }
    s delete
    set result
} {1 1 0 1}


test schema-19.2 {unique} {
    set schema {

        defelement doc {
            unique {${::schema-19.2}} @ref
        }
    }
    set result [list]
    foreach selector {
        a
        ./../a
        /foo
        a/b
        {a | b}
        a|b
        (a|b)

        .//a
        //a
        a/@ref
        a/b/c
        a//b/c
        (.//b|a)/c


    } {
        set ::schema-19.2 $selector
        tdom::schema s
        lappend result [catch {s define [subst $schema]} errMsg]
        #puts $errMsg
        s delete
    }
    set result
} {0 1 1 0 0 0 1 0 1 1 0 1 1}

}






>
>
>
>
>
>
>
>
>
>
>







 







|
<





<


>

|



|







>






>
>

<

|




|


592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
....
4577
4578
4579
4580
4581
4582
4583
4584

4585
4586
4587
4588
4589

4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
4612
4613
4614
4615

4616
4617
4618
4619
4620
4621
4622
4623
4624
        }
    } errMsg]
    lappend result $errMsg
    s delete
    set result
} {1 {Command only allowed at lop level} 1 {Command only allowed at lop level} 1 {Method not allowed in nested schema define script} 1 {This recursive call is not allowed}}

test schema-1.27 {define} {
    tdom::schema create s
    set result ""
    s define {
        set ::result "from inside define"
        append ::result " " [expr {2+2}]
    }
    s delete
    set result
} {from inside define 4}
    
test schema-2.1 {grammar definition: ref} {
    tdom::schema create grammar
    grammar defpattern thisPattern {
        element a
        element b
    }
    grammar defpattern thatPattern {
................................................................................
    set result [list]
    foreach xml {
        <doc/>
        <doc><b/></doc>
        <doc><a/></doc>
        {<doc><a ref="1"/><a ref="foo"/></doc>}
    } {
        lappend result [s validate $xml]

    }
    s delete
    set result
} {1 1 0 1}


test schema-19.2 {unique} {
    set schema {
        prefixns {ns1 http://tdom.org/test}
        defelement doc {
            unique ${::schema-19.2} @ref
        }
    }
    set result [list]
    foreach ::schema-19.2 {
        a
        ./../a
        /foo
        a/b
        {a | b}
        a|b
        (a|b)
        {a/b/c | b/c/d | c/d/e}
        .//a
        //a
        a/@ref
        a/b/c
        a//b/c
        (.//b|a)/c
        ns1:a
        a/.//b/c
    } {

        tdom::schema s
        lappend result [catch {s define $schema} errMsg]
        #puts $errMsg
        s delete
    }
    set result
} {0 1 1 0 1 1 1 1 0 1 1 0 1 1 0 1}

}