tDOM

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

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

Overview
Comment:Code gardening.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | schema
Files: files | file ages | folders
SHA3-256: e7f010f104ecd22d26ab0534dd67be7b924994176540e11e6af281f652a89879
User & Date: rolf 2020-02-12 00:39:21
Context
2020-02-13
01:19
Fixed internal clean up after error in a content definition script with local defined elements. check-in: 8d564a17c0 user: rolf tags: schema
2020-02-12
00:39
Code gardening. check-in: e7f010f104 user: rolf tags: schema
2020-02-11
20:02
Enforce that only an element defined by defelement can be document element of the xml to validate. Added documentation for the content definition command "elementtype". check-in: f84ee35226 user: rolf tags: schema
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/schema.c.

1567
1568
1569
1570
1571
1572
1573
1574

1575
1576
1577
1578




1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
....
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
4437
4438
4439
4440
                        return TCL_OK;
                    }
                    SetResult ("Root element namespace doesn't match");
                    return TCL_ERROR;
                }
            }
        }
    }

    if (h) {
        pattern = (SchemaCP *) Tcl_GetHashValue (h);
        while (pattern) {
            if (pattern->namespace == namespacePtr) {




                break;
            }
            pattern = pattern->next;
        }
    } else {
        pattern = NULL;
    }

    if (!sdata->stack) {
        sdata->validationState = VALIDATION_STARTED;
        reportError = 0;
        if (pattern) {
            if (pattern->flags & PLACEHOLDER_PATTERN_DEF
                || pattern->flags & FORWARD_PATTERN_DEF) {
                reportError = 1;
            }
        } else {
            reportError = 1;
        }
        if (reportError) {
            if (recover (interp, sdata, UNKNOWN_ROOT_ELEMENT, name, namespace,
                         NULL, 0)) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            SetResult ("Unknown element");
            return TCL_ERROR;
................................................................................
            node = tcldom_getNodeFromObj (interp, objv[2]);
            if (!node) {
                SetResult ("The second argument must be either a "
                           "document or a element node");
                return TCL_ERROR;
            }
        }
        sdata->validationState = VALIDATION_STARTED;
        if (validateDOM (interp, sdata, node) == TCL_OK) {
            SetBooleanResult (1);
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
            }
        } else {
            if (objc == 4) {






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

<
<
<
<
<
<
<
<
<
|







 







<







1567
1568
1569
1570
1571
1572
1573

1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589


1590









1591
1592
1593
1594
1595
1596
1597
1598
....
4419
4420
4421
4422
4423
4424
4425

4426
4427
4428
4429
4430
4431
4432
                        return TCL_OK;
                    }
                    SetResult ("Root element namespace doesn't match");
                    return TCL_ERROR;
                }
            }
        }

        reportError = 0;
        if (h) {
            pattern = (SchemaCP *) Tcl_GetHashValue (h);
            while (pattern) {
                if (pattern->namespace == namespacePtr) {
                    if (pattern->flags & PLACEHOLDER_PATTERN_DEF
                        || pattern->flags & FORWARD_PATTERN_DEF) {
                        reportError = 1;
                    }
                    break;
                }
                pattern = pattern->next;
            }
        } else {
            pattern = NULL;
        }


        sdata->validationState = VALIDATION_STARTED;









        if (reportError || pattern == NULL) {
            if (recover (interp, sdata, UNKNOWN_ROOT_ELEMENT, name, namespace,
                         NULL, 0)) {
                sdata->skipDeep = 1;
                return TCL_OK;
            }
            SetResult ("Unknown element");
            return TCL_ERROR;
................................................................................
            node = tcldom_getNodeFromObj (interp, objv[2]);
            if (!node) {
                SetResult ("The second argument must be either a "
                           "document or a element node");
                return TCL_ERROR;
            }
        }

        if (validateDOM (interp, sdata, node) == TCL_OK) {
            SetBooleanResult (1);
            if (objc == 4) {
                Tcl_SetVar (interp, Tcl_GetString (objv[3]), "", 0);
            }
        } else {
            if (objc == 4) {

Changes to generic/tclexpat.c.

843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
....
2368
2369
2370
2371
2372
2373
2374

2375
2376
2377
2378
2379
2380
2381
2382
        if (expat->final || result != TCL_OK) {
#ifndef TDOM_NO_SCHEMA
            resetsdata = 1;
#endif
            expat->final = 1;
            expat->finished = 1;
        }
#ifndef TDOM_NO_SCHEMA
        if (expat->sdata
            && expat->final == 0
            && expat->sdata->validationState == VALIDATION_READY) {
            expat->sdata->validationState = VALIDATION_STARTED;
        }
#endif
        break;
        
    case EXPAT_PARSECHANNEL:

        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
................................................................................
  }

#ifndef TDOM_NO_SCHEMA
  if (expat->sdata) {
      if (probeElement (expat->interp, expat->sdata, name, NULL) != TCL_OK) {
          TclExpatHandlerResult (expat, NULL, TCL_ERROR);
      }

      if (atts[0] || expat->sdata->stack->pattern->attrs) {
          if (probeAttributes (expat->interp, expat->sdata, atts)
              != TCL_OK) {
              expat->sdata->validationState = VALIDATION_ERROR;
              TclExpatHandlerResult (expat, NULL, TCL_ERROR);
          }
      }
  }






<
<
<
<
<
<
<







 







>
|







843
844
845
846
847
848
849







850
851
852
853
854
855
856
....
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
        if (expat->final || result != TCL_OK) {
#ifndef TDOM_NO_SCHEMA
            resetsdata = 1;
#endif
            expat->final = 1;
            expat->finished = 1;
        }







        break;
        
    case EXPAT_PARSECHANNEL:

        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
................................................................................
  }

#ifndef TDOM_NO_SCHEMA
  if (expat->sdata) {
      if (probeElement (expat->interp, expat->sdata, name, NULL) != TCL_OK) {
          TclExpatHandlerResult (expat, NULL, TCL_ERROR);
      }
      if (atts[0] || (expat->sdata->stack
                      && expat->sdata->stack->pattern->attrs)) {
          if (probeAttributes (expat->interp, expat->sdata, atts)
              != TCL_OK) {
              expat->sdata->validationState = VALIDATION_ERROR;
              TclExpatHandlerResult (expat, NULL, TCL_ERROR);
          }
      }
  }

Changes to tests/schema.test.

1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
....
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
    p parse {c><e1/></doc>}
    p configure -final 1
    p reset
    lappend result [grammar validate <doc><e1/><e2/><e2/></doc>]
    grammar delete
    p delete
    set result
} {1 {The schema command is busy} VALIDATING 1}

test schema-6.4 {expat parser with -validateCmd} {
    tdom::schema create grammar
    grammar defelement doc {
        element e1
        element e2 *
    }
................................................................................
    p parse {><e1/></doc>}
    p configure -final 1
    p reset
    lappend result [grammar validate <doc><e1/><e2/><e2/></doc>]
    grammar delete
    p delete
    set result
} {1 {The schema command is busy} VALIDATING 1}

proc elementstart-6.5 {name attList} {
    lappend ::result $name
}

test schema-6.5 {expat parser with -validateCmd} {
    tdom::schema create grammar






|







 







|







1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
....
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
    p parse {c><e1/></doc>}
    p configure -final 1
    p reset
    lappend result [grammar validate <doc><e1/><e2/><e2/></doc>]
    grammar delete
    p delete
    set result
} {0 1 READY 1}

test schema-6.4 {expat parser with -validateCmd} {
    tdom::schema create grammar
    grammar defelement doc {
        element e1
        element e2 *
    }
................................................................................
    p parse {><e1/></doc>}
    p configure -final 1
    p reset
    lappend result [grammar validate <doc><e1/><e2/><e2/></doc>]
    grammar delete
    p delete
    set result
} {0 1 READY 1}

proc elementstart-6.5 {name attList} {
    lappend ::result $name
}

test schema-6.5 {expat parser with -validateCmd} {
    tdom::schema create grammar