diff options
-rw-r--r-- | jim.c | 20 | ||||
-rw-r--r-- | tests/errors.tcl | 33 |
2 files changed, 35 insertions, 18 deletions
@@ -1694,6 +1694,9 @@ int JimParseListSep(struct JimParserCtx *pc) pc->tstart = pc->p; pc->tline = pc->linenr; while (*pc->p == ' ' || *pc->p == '\t' || *pc->p == '\r' || *pc->p == '\n') { + if (*pc->p == '\n') { + pc->linenr++; + } pc->p++; pc->len--; } @@ -5541,6 +5544,14 @@ int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) struct JimParserCtx parser; const char *str; int strLen; + char *filename = NULL; + int linenr = 1; + + /* Try to preserve information about filename / line number */ + if (objPtr->typePtr == &sourceObjType) { + filename = Jim_StrDup(objPtr->internalRep.sourceValue.fileName); + linenr = objPtr->internalRep.sourceValue.lineNumber; + } /* Get the string representation */ str = Jim_GetString(objPtr, &strLen); @@ -5554,19 +5565,24 @@ int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) objPtr->internalRep.listValue.ele = NULL; /* Convert into a list */ - JimParserInit(&parser, str, strLen, 1); + JimParserInit(&parser, str, strLen, linenr); while (!JimParserEof(&parser)) { char *token; int tokenLen, type; Jim_Obj *elementPtr; + int line; JimParseList(&parser); if (JimParserTtype(&parser) != JIM_TT_STR && JimParserTtype(&parser) != JIM_TT_ESC) continue; - token = JimParserGetToken(&parser, &tokenLen, &type, NULL); + token = JimParserGetToken(&parser, &tokenLen, &type, &line); elementPtr = Jim_NewStringObjNoAlloc(interp, token, tokenLen); + if (filename) { + JimSetSourceInfo(interp, elementPtr, filename, line); + } ListAppendElement(objPtr, elementPtr); } + free(filename); return JIM_OK; } diff --git a/tests/errors.tcl b/tests/errors.tcl index 7f5cdc8..1105dfa 100644 --- a/tests/errors.tcl +++ b/tests/errors.tcl @@ -1,58 +1,59 @@ # Package which can generate a variety of errors at known locations proc error_generator {type} { - switch $type \ + switch $type { badcmd { bogus command called - } \ + } badvar { set bogus - } \ + } error { error bogus - } \ + } interpbadvar { set x "some $bogus text" - } \ + } interpbadcmd { set x "some $bogus text" - } \ + } package { package require dummy - } \ + } source { source dummy.tcl - } \ + } badpackage { package require bogus - } \ + } returncode { return -code error failure - } \ + } default { puts "Unknown type=$type" } + } } - # line 40: Some empty lines above so that line numbers don't change proc error_caller {type {method call}} { - switch $method \ + switch $method { call { error_generator $type - } \ + } uplevel { uplevel 1 [list error_generator $type] - } \ + } eval { eval [list error_generator $type] - } \ + } evalstr { eval error_generator $type - } \ + } default { puts "Unknown method=$method" } + } } |