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

Overview
Comment:wip
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | wip
Files: files | file ages | folders
SHA3-256: d10c95ec067e8f60c4674daae348898f8f2a3c4ac088faf6769e250ca21269f2
User & Date: rolf 2019-11-09 16:56:53
Context
2019-11-13
17:02
Added info line and info column to retrieve parsing position information. Made the interfaces for position information using a long for this. Tried to prevent concurrent use of a schema command - a schema command may be busy. Added book-keeping code to prevent seg fault, if a schema command is configured as validation command for a SAX parser or DOM building and the schema command is deleted on the way at script level. Closed-Leaf check-in: d3e7475b85 user: rolf tags: wip
2019-11-09
16:56
wip check-in: d10c95ec06 user: rolf tags: wip
00:54
Plugged obscure mem leak. check-in: 8b0f0e9ecc user: rolf tags: schema
Changes

Changes to generic/schema.c.

2591
2592
2593
2594
2595
2596
2597

2598
2599
2600
2601
2602
2603
2604
....
2619
2620
2621
2622
2623
2624
2625

2626
2627
2628
2629
2630
2631
2632
....
2977
2978
2979
2980
2981
2982
2983


2984
2985
2986
2987
2988
2989
2990
....
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362

3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
....
3562
3563
3564
3565
3566
3567
3568




















3569
3570
3571
3572
3573
3574
3575
    char sl[50], sc[50];
    int result;

    parser = XML_ParserCreate_MM (NULL, MEM_SUITE, &sep);
    vdata.interp = interp;
    vdata.sdata = sdata;
    vdata.parser = parser;

    Tcl_DStringInit (&cdata);
    vdata.cdata = &cdata;
    vdata.onlyWhiteSpace = 1;
    vdata.uri = (char *) MALLOC (URI_BUFFER_LEN_INIT);
    vdata.maxUriLen = URI_BUFFER_LEN_INIT;
    XML_SetUserData (parser, &vdata);
    XML_SetElementHandler (parser, startElement, endElement);
................................................................................
                                    "\" at line ", sl, " character ", sc, NULL);
        }
        Tcl_SetObjResult (interp, resultObj);
        result = TCL_ERROR;
    } else {
        result = TCL_OK;
    }

    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    while (sdata->stack) popStack (sdata);
    return result;
}

................................................................................
                Tcl_DeleteHashTable (&ks->ids);
                Tcl_InitHashTable (&ks->ids, TCL_STRING_KEYS);
            }
            ks->unknownIDrefs = 0;
            ks->active = 0;
        }
    }


}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
................................................................................
schemaInstanceInfoCmd (
    SchemaData *sdata,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int methodIndex;
    Tcl_HashEntry *h;
    SchemaCP *cp;
    SchemaValidationStack *se;
    void *ns;
    Tcl_Obj *rObj;
    
    static const char *schemaInstanceInfoMethods[] = {
        "validationstate", "vstate", "definedElements", "stack", "toplevel",
        "expected", "definition", "validationaction", "vaction", NULL

    };
    enum schemaInstanceInfoMethod {
        m_validationstate, m_vstate, m_definedElements, m_stack, m_toplevel,
        m_expected, m_definition, m_validationaction,
        m_vaction
    };

    static const char *schemaInstanceInfoStackMethods[] = {
        "top", "inside", NULL
    };
    enum schemaInstanceInfoStackMethod {
        m_top, m_inside
................................................................................
            SetResult (sdata->vns);
            break;
        case m_text:
            SetResult (sdata->vtext);
            break;
        }
        break;




















    }
    return TCL_OK;
}

/* This implements the script interface to the created schema commands.

   Since validation may call out to tcl scripts those scripts may







>







 







>







 







>
>







 







|








|
>



|
|







 







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







2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
....
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
....
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
....
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
....
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
    char sl[50], sc[50];
    int result;

    parser = XML_ParserCreate_MM (NULL, MEM_SUITE, &sep);
    vdata.interp = interp;
    vdata.sdata = sdata;
    vdata.parser = parser;
    sdata->parser = parser;
    Tcl_DStringInit (&cdata);
    vdata.cdata = &cdata;
    vdata.onlyWhiteSpace = 1;
    vdata.uri = (char *) MALLOC (URI_BUFFER_LEN_INIT);
    vdata.maxUriLen = URI_BUFFER_LEN_INIT;
    XML_SetUserData (parser, &vdata);
    XML_SetElementHandler (parser, startElement, endElement);
................................................................................
                                    "\" at line ", sl, " character ", sc, NULL);
        }
        Tcl_SetObjResult (interp, resultObj);
        result = TCL_ERROR;
    } else {
        result = TCL_OK;
    }
    sdata->parser = NULL;
    XML_ParserFree (parser);
    Tcl_DStringFree (&cdata);
    FREE (vdata.uri);
    while (sdata->stack) popStack (sdata);
    return result;
}

................................................................................
                Tcl_DeleteHashTable (&ks->ids);
                Tcl_InitHashTable (&ks->ids, TCL_STRING_KEYS);
            }
            ks->unknownIDrefs = 0;
            ks->active = 0;
        }
    }
    sdata->parser = NULL;
    sdata->node = NULL;
}

static int
evalConstraints (
    Tcl_Interp *interp,
    SchemaData *sdata,
    SchemaCP *cp,
................................................................................
schemaInstanceInfoCmd (
    SchemaData *sdata,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[]
    )
{
    int methodIndex, line, column;
    Tcl_HashEntry *h;
    SchemaCP *cp;
    SchemaValidationStack *se;
    void *ns;
    Tcl_Obj *rObj;
    
    static const char *schemaInstanceInfoMethods[] = {
        "validationstate", "vstate", "definedElements", "stack", "toplevel",
        "expected", "definition", "validationaction", "vaction", "line",
        "column", NULL
    };
    enum schemaInstanceInfoMethod {
        m_validationstate, m_vstate, m_definedElements, m_stack, m_toplevel,
        m_expected, m_definition, m_validationaction, m_vaction, m_line,
        m_column
    };

    static const char *schemaInstanceInfoStackMethods[] = {
        "top", "inside", NULL
    };
    enum schemaInstanceInfoStackMethod {
        m_top, m_inside
................................................................................
            SetResult (sdata->vns);
            break;
        case m_text:
            SetResult (sdata->vtext);
            break;
        }
        break;

    case m_line:
        if (!sdata->parser && !sdata->node) break;
        if (sdata->parser) {
            SetIntResult (XML_GetCurrentLineNumber (sdata->parser));
            break;
        }
        if (domGetLineColumn(sdata->node, &line, &column) < 0) break;
        SetIntResult (line);
        break;
        
    case m_column:
        if (!sdata->parser && !sdata->node) break;
        if (sdata->parser) {
            SetIntResult (XML_GetCurrentColumnNumber (sdata->parser));
            break;
        }
        if (domGetLineColumn(sdata->node, &line, &column) < 0) break;
        SetIntResult (column);
        break;
    }
    return TCL_OK;
}

/* This implements the script interface to the created schema commands.

   Since validation may call out to tcl scripts those scripts may

Changes to generic/schema.h.

179
180
181
182
183
184
185


186
187
188
189
190
191
192
    const char *vtext;
    unsigned int skipDeep;
    Tcl_DString *cdata;
    Tcl_HashTable ids;
    int unknownIDrefs;
    Tcl_HashTable idTables;
    Tcl_HashTable keySpaces;


} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,







>
>







179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
    const char *vtext;
    unsigned int skipDeep;
    Tcl_DString *cdata;
    Tcl_HashTable ids;
    int unknownIDrefs;
    Tcl_HashTable idTables;
    Tcl_HashTable keySpaces;
    XML_Parser parser;
    domNode *node;
} SchemaData;

int 
schemaInstanceCmd (
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,

Changes to generic/tcldom.c.

6594
6595
6596
6597
6598
6599
6600
6601




6602


6603
6604
6605
6606
6607
6608
6609
    }

#ifdef TDOM_NO_EXPAT
    Tcl_AppendResult(interp, "tDOM was compiled without Expat!", NULL);
    return TCL_ERROR;
#else
    parser = XML_ParserCreate_MM(NULL, MEM_SUITE, NULL);
    Tcl_ResetResult(interp);







    doc = domReadDocument(parser, xml_string,
                          xml_string_len,
                          ignoreWhiteSpaces,
                          keepCDATA,
                          TSD(storeLineColumn),
                          ignorexmlns,
                          feedbackAfter,







|
>
>
>
>
|
>
>







6594
6595
6596
6597
6598
6599
6600
6601
6602
6603
6604
6605
6606
6607
6608
6609
6610
6611
6612
6613
6614
6615
    }

#ifdef TDOM_NO_EXPAT
    Tcl_AppendResult(interp, "tDOM was compiled without Expat!", NULL);
    return TCL_ERROR;
#else
    parser = XML_ParserCreate_MM(NULL, MEM_SUITE, NULL);
#ifndef TDOM_NO_SCHEMA
    sdata->parser = parser;
    if (sdata->validationState != VALIDATION_READY) {
        SetResult ("The configured schema command is busy.");
        return TCL_ERROR;
    }
#endif
    Tcl_ResetResult(interp);
    doc = domReadDocument(parser, xml_string,
                          xml_string_len,
                          ignoreWhiteSpaces,
                          keepCDATA,
                          TSD(storeLineColumn),
                          ignorexmlns,
                          feedbackAfter,

Changes to generic/tclexpat.c.

811
812
813
814
815
816
817






818
819
820
821
822
823
824
...
830
831
832
833
834
835
836

837



838
839
840
841
842
843
844
        CheckArgs (3,3,2,"<XML-String>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
        data = Tcl_GetStringFromObj(objv[2], &len);






        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_STRING);
        if (expat->final || result != TCL_OK) {
#ifndef TDOM_NO_SCHEMA
            resetsdata = 1;
#endif
            expat->final = 1;
            expat->finished = 1;
................................................................................
        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
#ifndef TDOM_NO_SCHEMA

        resetsdata = 1;



#endif
        data = Tcl_GetString(objv[2]);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_CHANNEL);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }







>
>
>
>
>
>







 







>
|
>
>
>







811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
...
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
        CheckArgs (3,3,2,"<XML-String>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
        data = Tcl_GetStringFromObj(objv[2], &len);
#ifndef TDOM_NO_SCHEMA
        if (expat->sdata) {
            expat->sdata->parser = expat->parser;
        }
        break;
#endif
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_STRING);
        if (expat->final || result != TCL_OK) {
#ifndef TDOM_NO_SCHEMA
            resetsdata = 1;
#endif
            expat->final = 1;
            expat->finished = 1;
................................................................................
        CheckArgs (3,3,2,"<Tcl-Channel>");
        if (expat->parsingState > 1) {
            Tcl_SetResult (interp, "Parser already in use.", TCL_STATIC);
            result = TCL_ERROR;
            break;
        }
#ifndef TDOM_NO_SCHEMA
        if (expat->sdata) {
            resetsdata = 1;
            expat->sdata->parser = expat->parser;
        }
        break;
#endif
        data = Tcl_GetString(objv[2]);
        result = TclExpatParse(interp, expat, data, len, EXPAT_INPUT_CHANNEL);
        if (expat->final || result != TCL_OK) {
            expat->final = 1;
            expat->finished = 1;
        }