diff --git a/.gitignore b/.gitignore index 208f797..a5d7544 100644 --- a/.gitignore +++ b/.gitignore @@ -22,6 +22,7 @@ perf.data.old .cproject .project .settings +.gse tests/JSONTestSuite/test_parsing tests/JSONTestSuite/test_transform tclobjs_remaining diff --git a/.gse b/.gse new file mode 100644 index 0000000..523df57 --- /dev/null +++ b/.gse @@ -0,0 +1,23 @@ +{ + "sync": { + "enable": true, + "pull": [ + { + "origin": "teclab", + "branch": "wip" + } + ], + "push": [ + { + "origin": "teclab", + "branch": "wip" + } + ] + }, + "pull": { + "enable": true + }, + "push": { + "enable": true + } +} diff --git a/README.md b/README.md index 75a9169..f69d087 100644 --- a/README.md +++ b/README.md @@ -43,6 +43,8 @@ Quick Reference * [json object ?*key* *value* ?*key* *value* ...??] - Return a JSON object with the keys and values specified. *value* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value. * [json object *packed_value*] - An alternate syntax that takes the list of keys and values as a single arg instead of a list of args, but is otherwise the same. * [json array ?*elem* ...?] - Return a JSON array containing each of the elements given. *elem* is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value. +* [json autoarray ?*value* ...?] - Return a JSON array with automatic type detection. Values matching "true" or "false" become booleans, valid numbers become JSON numbers, and all other values become strings. +* [json autoobject ?*key* *value* ...?] - Return a JSON object with automatic type detection for values. Keys are always strings, values undergo the same automatic type detection as autoarray (booleans, numbers, or strings). * [json foreach *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*] - Evaluate *script* in a loop in a similar way to the [foreach] command. In each iteration, the values stored in the iterator variables in *varlist* are the JSON fragments from *json_val*. Supports iterating over JSON arrays and JSON objects. In the JSON object case, *varlist* must be a two element list, with the first specifiying the variable to hold the key and the second the value. In the JSON array case, the rules are the same as the [foreach] command. * [json lmap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*] - As for [json foreach], except that it is collecting - the result from each evaluation of *script* is added to a list and returned as the result of the [json lmap] command. If the *script* results in a TCL_CONTINUE code, that iteration is skipped and no element is added to the result list. If it results in TCL_BREAK the iterations are stopped and the results accumulated so far are returned. * [json amap *varlist1* *json_val1* ?*varlist2* *json_val2* ...? *script*] - As for [json lmap], but the result is a JSON array rather than a list. If the result of each iteration is a JSON value it is added to the array as-is, otherwise it is converted to a JSON string. diff --git a/TECLABCHANGES.md b/TECLABCHANGES.md new file mode 100644 index 0000000..53c34df --- /dev/null +++ b/TECLABCHANGES.md @@ -0,0 +1,258 @@ +# TECLAB Changes: master → wip + +This document describes all changes made in the `wip` branch compared to `master`. + +## Commit History + +``` +5a1a51b WIP +17b92f7 WIP +9bb174f beautify +a476851 adding autoarray tests +fa88e9d readding libtommath submodule +0776812 fix compile errors +66d3a82 Merge branch 'master' of https://github.com/RubyLane/rl_json into wip +5217388 added nopadding test +9ccf3f8 Merge pull request #3 from teclabat/autoarray +321b159 Merge branch 'wip' into autoarray +a07c3f1 Merge pull request #2 from teclabat/pretty +c3588aa pretty command now accepts the -nopadding switch cleanup the pretty.test +23fc406 enhancements for the pretty command: -compact -indent -arrays +ff30d6f new autoarray method +1b9c8e3 Merge pull request #1 from teclabat/noparseargs +10f2db0 parse_args fails to load during tests, simplify as it seems it's anyhow overkill for this +``` + +## Summary Statistics + +``` + 16 files changed, 891 insertions(+), 79 deletions(-) +``` + +## Major Features Added + +### 1. New `json autoarray` Command + +A new command that creates JSON arrays with automatic type detection, eliminating the need for explicit type specification. + +**Syntax:** +```tcl +json autoarray ?value ...? +``` + +**Features:** +- Automatically detects JSON booleans (exact "true" or "false") +- Automatically detects valid JSON numbers +- Defaults to JSON strings for all other values + +**Example:** +```tcl +json autoarray 1 2.5 true false "hello world" 42 +# Returns: [1,2.5,true,false,"hello world",42] +``` + +**Files:** +- `generic/rl_json.c`: Implementation of `jsonAutoArray()` function +- `doc/json.n`: Documentation added +- `tests/autoarray.test`: Comprehensive test suite (322 new lines) + +### 2. New `json autoobject` Command + +A new command that creates JSON objects from key-value pairs with automatic type detection for values, complementing the `json autoarray` command. + +**Syntax:** +```tcl +json autoobject ?key value ...? +``` + +**Features:** +- Keys are always treated as strings (as required by JSON specification) +- Values undergo automatic type detection: + - Exact "true" or "false" (case-sensitive) → JSON booleans + - Valid JSON numbers → JSON numbers + - All other values → JSON strings +- Requires even number of arguments (key-value pairs) +- Duplicate keys allowed (last value wins) + +**Example:** +```tcl +json autoobject name "Alice" age 30 active true score 95.5 +# Returns: {"name":"Alice","age":30,"active":true,"score":95.5} +``` + +**Files:** +- `generic/rl_json.c`: Implementation of `jsonAutoObject()` function +- `doc/json.n`: Documentation added +- `tests/autoobject.test`: Comprehensive test suite (260+ new lines) + +### 3. Enhanced `json pretty` Command + +Significant enhancements to the pretty-printing functionality with three new options. + +**New Options:** + +#### `-compact` +Returns a compact, single-line representation with no extra whitespace (equivalent to `json normalize`). + +**Example:** +```tcl +json pretty -compact $jsonValue +``` + +#### `-nopadding` +Removes the automatic padding/alignment of object keys, resulting in more condensed output. + +**Example:** +```tcl +json pretty -nopadding $jsonValue +``` + +#### `-arrays ` +Controls array formatting with two modes: +- `inline`: All arrays formatted on a single line `[1,2,3]` +- `multiline`: All arrays formatted with one element per line + +**Default behavior:** Arrays with ≤3 elements are inline, larger arrays are multiline. + +**Example:** +```tcl +json pretty -arrays inline $jsonValue +json pretty -arrays multiline $jsonValue +``` + +**Files Modified:** +- `generic/rl_json.c`: Core implementation +- `generic/api.c`: API updates +- `generic/rl_json.decls`: Declaration updates +- `generic/rl_jsonDecls.h`: Header updates +- `generic/rl_jsonInt.h`: Internal header updates +- `doc/json.n`: Extended documentation +- `tests/pretty.test`: Expanded test coverage (+180 lines) + +## Bug Fixes and Improvements + +### Parser Error Reporting +**File:** `generic/parser.c` + +Fixed format specifiers for cross-platform compatibility: +- Added Tcl version-specific format strings for error messages +- Proper handling of `size_t` values in error reporting +- Fixed warnings on 64-bit systems + +### Memory Leak Debugging +**File:** `generic/rl_json.c` + +Updated leak detection tools: +- Changed address handling from `unsigned long` to `Tcl_WideInt` +- Proper casting to `uintptr_t` for pointer conversions +- Better cross-platform compatibility + +### TIP445 Support +**Files:** +- `generic/tip445.h`: Changed from symlink to regular file +- `generic/tip445.fix.h`: New file with TIP445 compatibility shims + +Added compatibility layer for building on Tcl 8.6. + +### Submodule Updates +**File:** `teabase` + +Updated teabase submodule: +- From: `b58eac68cc3d07c4f3155a3d390e31fc29fb255b` +- To: `b293fee95e97cbe6ce1583807e4d2aed8404e2e3` + +### libtommath Integration +**File:** `generic/rl_jsonInt.h` + +Added proper configuration header support and reorganized includes for CBOR support. + +## Configuration and Build Changes + +### .gitignore +Added `.gse` to ignored files. + +### Version Update +**File:** `doc/json.n` + +Updated package version: +- From: `0.14.0` +- To: `0.15.0` + +## Test Improvements + +### New Test Files +- `tests/autoarray.test`: Complete test suite for autoarray functionality (322 lines) + +### Enhanced Test Files +- `tests/pretty.test`: Added 180+ lines of new tests for enhanced pretty options +- `tests/helpers.tcl`: Minor updates for test infrastructure +- `tests/set.test`: Minor updates +- `tests/unset.test`: Minor updates + +## API Changes + +### Modified C API Functions + +**`JSON_Pretty()`** signature changed: +```c +// Old: +int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, + Tcl_Obj** prettyString) + +// New: +int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, + int nopadding, int compact, int arrays_inline, + Tcl_Obj** prettyString) +``` + +**`json_pretty()`** internal function signature changed: +```c +// Old: +int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, + Tcl_Obj* pad, Tcl_DString* ds) + +// New: +int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, + int nopadding, Tcl_Obj* pad, int arrays_inline, + Tcl_DString* ds) +``` + +### New Tcl Commands +- `json autoarray ?value ...?` +- `json autoobject ?key value ...?` + +### Enhanced Tcl Commands +- `json pretty ?-indent indent? ?-compact? ?-nopadding? ?-arrays inline|multiline? jsonValue ?key ...?` + +## Documentation Updates + +**File:** `doc/json.n` + +Comprehensive documentation added/updated for: +1. `json autoarray` - Complete new section with examples +2. `json pretty` - Expanded with detailed descriptions of all new options +3. Version number updated throughout + +## Backward Compatibility + +### Breaking Changes +- The C API function `JSON_Pretty()` has a changed signature +- Code calling this C function directly will need to be updated + +### Non-Breaking Changes +- All Tcl-level commands maintain backward compatibility +- New options are optional and default to previous behavior +- Existing scripts will continue to work unchanged + +## Statistics by Component + +### Code Changes +- **C source files:** 6 files modified, ~180 insertions +- **Header files:** 4 files modified, ~30 insertions +- **Documentation:** 1 file modified, ~70 insertions +- **Tests:** 4 files modified/added, ~500 insertions + +### Lines of Code +- **Total additions:** 891 lines +- **Total deletions:** 79 lines +- **Net change:** +812 lines diff --git a/doc/json.n b/doc/json.n index f656409..b6b4026 100644 --- a/doc/json.n +++ b/doc/json.n @@ -4,15 +4,15 @@ '\" See the file "LICENSE" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -.TH json n 0.14.0 rl_json "RubyLane/JSON Package Commands" +.TH json n 0.15.0 rl_json "RubyLane/JSON Package Commands" .so man.macros .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -json \- Parse, manipulate and produce JSON documents +json \- Parse, manipulate and produce JSON documents .SH SYNOPSIS .nf -\fBpackage require rl_json\fR ?\fB0.14.0\fR? +\fBpackage require rl_json\fR ?\fB0.15.0\fR? \fBjson get\fR ?\fB-default\fR \fIdefaultValue\fR? \fIjsonValue\fR ?\fIkey ...\fR? \fBjson extract\fR ?\fB-default\fR \fIdefaultValue\fR? \fIjsonValue\fR ?\fIkey ...\fR? @@ -28,6 +28,7 @@ json \- Parse, manipulate and produce JSON documents \fBjson boolean\fR \fIvalue\fR \fBjson object\fR \fI?key value ?key value ...??\fR \fBjson array\fR \fIelem ...\fR +\fBjson autoarray\fR \fIvalue ...\fR \fBjson bool\fR \fIvalue\fR \fBjson normalize\fR \fIjsonValue\fR \fBjson pretty\fR ?\fB-indent\fR \fIindent\fR? \fIjsonValue\fR ?\fIkey ...\fR? @@ -170,6 +171,49 @@ Return a JSON array containing each of the elements given. \fIelem\fR is a list of two elements, the first being the type {string, number, boolean, null, object, array, json}, and the second being the value. .TP +\fBjson autoarray \fI?value ...?\fR +. +Return a JSON array containing each of the values given, with automatic type detection. +Unlike \fBjson array\fR which requires explicit type specification, \fBjson autoarray\fR +automatically determines the appropriate JSON type for each value: +.RS +.IP \(bu 3 +Values exactly matching "true" or "false" (case-sensitive) are converted to JSON booleans. +.IP \(bu 3 +Values that can be parsed as valid JSON numbers are converted to JSON numbers. +.IP \(bu 3 +All other values are converted to JSON strings. +.RE +.PP +For example: +.CS + json autoarray 1 2.5 true false "hello world" 42 + # Returns: [1,2.5,true,false,"hello world",42] +.CE +.TP +\fBjson autoobject \fI?key value ...?\fR +. +Return a JSON object containing the key-value pairs given, with automatic type detection +for values. Keys are always treated as strings (as required by JSON), while values undergo +the same automatic type detection as \fBjson autoarray\fR: +.RS +.IP \(bu 3 +Values exactly matching "true" or "false" (case-sensitive) are converted to JSON booleans. +.IP \(bu 3 +Values that can be parsed as valid JSON numbers are converted to JSON numbers. +.IP \(bu 3 +All other values are converted to JSON strings. +.RE +.PP +The command requires an even number of arguments (key-value pairs). If duplicate keys +are provided, the last value wins. +.PP +For example: +.CS + json autoobject name "Alice" age 30 active true score 95.5 + # Returns: {"name":"Alice","age":30,"active":true,"score":95.5} +.CE +.TP \fBjson foreach \fIvarList1 jsonValue1\fR ?\fIvarList2 jsonValue2 ...\fR? \fIscript\fR . Evaluate \fIscript\fR in a loop in a similar way to the \fBforeach\fR command. @@ -232,12 +276,38 @@ Return a version of the input \fIjsonValue\fR, i.e., with all optional whitespace trimmed. .TP -\fBjson pretty\fR ?\fB-indent\fR \fIindent\fR? \fIjsonValue\fR ?\fIkey ...\fR? +\fBjson pretty\fR ?\fB-indent\fR \fIindent\fR? ?\fB-compact\fR? ?\fB-arrays\fR \fImode\fR? \fIjsonValue\fR ?\fIkey ...\fR? . Returns a pretty-printed string representation of \fIjsonValue\fR, found by following the path of \fIkey\fRs. Useful for debugging or inspecting the -structure of JSON data. If \fB-indent\fR is supplied, use \fIindent\fR for -each level of indent, otherwise default to four spaces. +structure of JSON data. +.RS +.PP +The following options control the formatting: +.TP +\fB-indent\fR \fIindent\fR +. +Use \fIindent\fR for each level of indent. Defaults to four spaces if not specified. +.TP +\fB-compact\fR +. +Return a compact, single-line representation with no extra whitespace. This is equivalent +to \fBjson normalize\fR but provided for convenience when using other pretty options. +When this option is used, \fB-indent\fR and \fB-arrays\fR are ignored. +.TP +\fB-arrays\fR \fImode\fR +. +Control how arrays are formatted. \fImode\fR must be one of: +.RS +.IP \fBinline\fR 10 +All arrays are formatted on a single line: [1,2,3] +.IP \fBmultiline\fR 10 +All arrays are formatted with one element per line. +.RE +.PP +If not specified, arrays with 3 or fewer elements are formatted inline, while larger +arrays are formatted with one element per line. +.RE .TP \fBjson decode \fIbytes\fR ?\fIencoding\fR? . diff --git a/generic/api.c b/generic/api.c index 8d31dfd..3f9af24 100644 --- a/generic/api.c +++ b/generic/api.c @@ -302,7 +302,7 @@ int JSON_SetJArrayObj(Tcl_Interp* interp, Tcl_Obj* obj, const int objc, Tcl_Obj* } //}}} -int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, int* objc, Tcl_Obj*** objv) //{{{ +int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Size* objc, Tcl_Obj*** objv) //{{{ { enum json_types type; Tcl_Obj* val = NULL; @@ -392,7 +392,7 @@ int JSON_Extract(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Obj** res) Tcl_Obj* target = NULL; Tcl_Obj** pathv = NULL; Tcl_Obj* def = NULL; - int pathc = 0; + Tcl_Size pathc = 0; if (path) TEST_OK_LABEL(finally, code, Tcl_ListObjGetElements(interp, path, &pathc, &pathv)); @@ -418,7 +418,7 @@ int JSON_Exists(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* exists) // { Tcl_Obj* target = NULL; Tcl_Obj** pathv = NULL; - int pathc = 0; + Tcl_Size pathc = 0; if (path) TEST_OK(Tcl_ListObjGetElements(interp, path, &pathc, &pathv)); @@ -441,7 +441,7 @@ int JSON_Exists(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* exists) // int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replacement) //{{{ { int code = TCL_OK; - int i; + Tcl_Size i; enum json_types type, newtype; Tcl_ObjInternalRep* ir = NULL; Tcl_Obj* val = NULL; @@ -451,7 +451,7 @@ int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replaceme Tcl_Obj* newval; Tcl_Obj* rep = NULL; Tcl_Obj** pathv = NULL; - int pathc = 0; + Tcl_Size pathc = 0; if (Tcl_IsShared(obj)) THROW_ERROR_LABEL(finally, code, "JSON_Set called with shared object"); @@ -498,7 +498,8 @@ int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replaceme //}}} case JSON_ARRAY: //{{{ { - int ac, index_str_len, ok=1; + Tcl_Size ac, index_str_len; + int ok=1; long index; const char* index_str; char* end; @@ -653,12 +654,12 @@ int JSON_Set(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path, Tcl_Obj* replaceme int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path) //{{{ { enum json_types type; - int i; + Tcl_Size i; Tcl_Obj* val = NULL; Tcl_Obj* step = NULL; Tcl_Obj* src = NULL; Tcl_Obj* target = NULL; - int pathc = 0; + Tcl_Size pathc = 0; Tcl_Obj** pathv = NULL; int retval = TCL_OK; @@ -711,7 +712,8 @@ int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path) //{{{ //}}} case JSON_ARRAY: //{{{ { - int ac, index_str_len, ok=1; + Tcl_Size ac, index_str_len; + int ok=1; long index; const char* index_str; char* end; @@ -809,7 +811,8 @@ int JSON_Unset(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj *path) //{{{ //}}} case JSON_ARRAY: //{{{ { - int ac, index_str_len, ok=1; + Tcl_Size ac, index_str_len; + int ok=1; long index; const char* index_str; char* end; @@ -937,7 +940,7 @@ int JSON_Normalize(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** normalized) //{{{ } //}}} -int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** prettyString) //{{{ +int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, int nopadding, int compact, int arrays_inline, Tcl_Obj** prettyString) //{{{ { int retval = TCL_OK; Tcl_DString ds; @@ -945,6 +948,13 @@ int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** pre Tcl_Obj* pad = NULL; struct interp_cx* l = Tcl_GetAssocData(interp, "rl_json", NULL); + // Handle compact mode - just normalize (remove all whitespace) + if (compact) { + retval = JSON_Normalize(interp, obj, prettyString); + return retval; + } + + // Normal pretty printing with formatting options if (indent == NULL) { replace_tclobj(&lindent, get_string(l, " ", 4)); indent = lindent; @@ -952,7 +962,7 @@ int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** pre replace_tclobj(&pad, l->tcl_empty); Tcl_DStringInit(&ds); - retval = json_pretty(interp, obj, indent, pad, &ds); + retval = json_pretty(interp, obj, indent, nopadding, pad, arrays_inline, &ds); if (retval == TCL_OK) replace_tclobj(prettyString, Tcl_NewStringObj(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds))); @@ -1024,7 +1034,7 @@ int JSON_Type(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, enum json_types* } //}}} -int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, int* length) //{{{ +int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path, Tcl_Size* length) //{{{ { enum json_types type; int retval = TCL_OK; @@ -1126,7 +1136,7 @@ int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, JSON_ForeachBody* body, unsigned int i; int retcode=TCL_OK; struct foreach_state* state = NULL; - int objc; + Tcl_Size objc; Tcl_Obj** objv = NULL; Tcl_Obj* it_res = NULL; struct interp_cx* l = Tcl_GetAssocData(interp, "rl_json", NULL); @@ -1173,7 +1183,7 @@ int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, JSON_ForeachBody* body, } for (i=0; iiterators; i++) { - int loops, j; + Tcl_Size loops, j; enum json_types type; Tcl_Obj* val = NULL; Tcl_Obj* varlist = objv[i*2]; @@ -1318,7 +1328,7 @@ int JSON_Foreach(Tcl_Interp* interp, Tcl_Obj* iterators, JSON_ForeachBody* body, break; //}}} } else { // Iterate over it_res as a list {{{ - int oc, i; + Tcl_Size oc, i; Tcl_Obj** ov = NULL; TEST_OK_LABEL(done, retcode, Tcl_ListObjGetElements(interp, it_res, &oc, &ov)); @@ -1387,7 +1397,7 @@ int JSON_Valid(Tcl_Interp* interp, Tcl_Obj* json, int* valid, enum extensions ex const unsigned char* p; const unsigned char* e; const unsigned char* val_start; - int len; + Tcl_Size len; struct parse_context cx[CX_STACK_SIZE]; if (interp) diff --git a/generic/cbor.c b/generic/cbor.c index 5e0916d..da43705 100644 --- a/generic/cbor.c +++ b/generic/cbor.c @@ -519,7 +519,7 @@ static int cbor_match_map(Tcl_Interp* interp, uint8_t ai, uint64_t val, const ui Tcl_Obj* cbor_val = NULL; Tcl_HashTable remaining; const uint8_t* p = *pPtr; - int size; + Tcl_Size size; int skipping = 0; Tcl_InitHashTable(&remaining, TCL_ONE_WORD_KEYS); @@ -709,7 +709,7 @@ static int cbor_matches(Tcl_Interp* interp, const uint8_t** pPtr, const uint8_t* //}}} case M_BSTR: // Compare as byte strings {{{ { - int pathlen; + Tcl_Size pathlen; const uint8_t* pathval = (const uint8_t*)Tcl_GetBytesFromObj(interp, pathElem, &pathlen); const uint8_t*const pathend = pathval + pathlen; const uint8_t*const pe = p + val; @@ -768,7 +768,7 @@ static int cbor_matches(Tcl_Interp* interp, const uint8_t** pPtr, const uint8_t* //}}} case M_UTF8: // Compare as UTF-8 strings {{{ { - int s_pathlen; + Tcl_Size s_pathlen; const uint8_t* s_pathval = (const uint8_t*)Tcl_GetStringFromObj(pathElem, &s_pathlen); const uint8_t*const s_pathend = s_pathval + s_pathlen; const uint8_t*const s_pe = p + val; @@ -837,7 +837,7 @@ static int cbor_matches(Tcl_Interp* interp, const uint8_t** pPtr, const uint8_t* //}}} case M_ARR: // Compare as a list {{{ { - int oc; + Tcl_Size oc; Tcl_Obj** ov; if (TCL_OK != Tcl_ListObjGetElements(NULL, pathElem, &oc, &ov)) { // Skip remaining elements {{{ @@ -919,7 +919,7 @@ static int cbor_matches(Tcl_Interp* interp, const uint8_t** pPtr, const uint8_t* } case 22: case 23: // Simple value: null / undefined - treat zero length string as matching { - int len; + Tcl_Size len; Tcl_GetStringFromObj(pathElem, &len); if (len == 0) goto matches; goto mismatch; @@ -959,9 +959,9 @@ int CBOR_GetDataItemFromPath(Tcl_Interp* interp, Tcl_Obj* cborObj, Tcl_Obj* path { int code = TCL_OK; Tcl_Obj** pathv = NULL; - int pathc = 0; + Tcl_Size pathc = 0; const uint8_t* p = NULL; - int byteslen = 0; + Tcl_Size byteslen = 0; const uint8_t* bytes = NULL; const uint8_t** circular = g_circular_buf; @@ -1285,7 +1285,7 @@ static int cbor_nr_cmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj*c enum {A_cmd=A_OP, A_BYTES, A_objc}; CHECK_ARGS_LABEL(finally, code, "bytes"); - int len; + Tcl_Size len; const uint8_t* bytes = Tcl_GetByteArrayFromObj(objv[A_BYTES], &len); const uint8_t* p = bytes; @@ -1307,7 +1307,7 @@ static int cbor_nr_cmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj*c switch (tag) { case 2: // Unsigned bignum { - int bytelen; + Tcl_Size bytelen; const uint8_t* bytes = Tcl_GetBytesFromObj(interp, objv[A_VALUE], &bytelen); if (bytes == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Tag 2 (unsigned bignum) requires a byte array value")); @@ -1339,7 +1339,7 @@ static int cbor_nr_cmd(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj*c case 3: // Negative bignum: -1 - n { - int bytelen; + Tcl_Size bytelen; const uint8_t* bytes = Tcl_GetBytesFromObj(interp, objv[A_VALUE], &bytelen); if (bytes == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf("Tag 3 (negative bignum) requires a byte array value")); diff --git a/generic/dedup.c b/generic/dedup.c index 4b4847c..a9a7ace 100644 --- a/generic/dedup.c +++ b/generic/dedup.c @@ -87,7 +87,7 @@ static void age_cache(struct interp_cx* l) //{{{ } //}}} -Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length) //{{{ +Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, Tcl_Size length) //{{{ { char buf[STRING_DEDUP_MAX + 1]; const char *keyname; diff --git a/generic/dedup.h b/generic/dedup.h index d763aa2..925ccba 100644 --- a/generic/dedup.h +++ b/generic/dedup.h @@ -5,7 +5,7 @@ #define STRING_DEDUP_MAX 16 void free_cache(struct interp_cx* l); -Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, int length); +Tcl_Obj* new_stringobj_dedup(struct interp_cx* l, const char* bytes, Tcl_Size length); # define get_string(l, bytes, length) new_stringobj_dedup(l, bytes, length) #else # define free_cache(l) // nop diff --git a/generic/json_types.c b/generic/json_types.c index 23a0936..60d79ec 100644 --- a/generic/json_types.c +++ b/generic/json_types.c @@ -298,7 +298,7 @@ int JSON_SetIntRep(Tcl_Obj* target, enum json_types type, Tcl_Obj* replacement) replace_tclobj(&rep, replacement); if (type == JSON_STRING && rep) { // Check for template values - int len; + Tcl_Size len; const char* str = Tcl_GetStringFromObj(replacement, &len); const char*const strend = str + len; enum json_types template_type; @@ -437,7 +437,7 @@ static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype) Tcl_Panic("dup_internal_rep asked to duplicate for type, but that type wasn't available on the src object"); if (src == srcir->twoPtrValue.ptr1) { - int len; + Tcl_Size len; const char* str = Tcl_GetStringFromObj((Tcl_Obj*)srcir->twoPtrValue.ptr1, &len); // Don't know how this happens yet, but it's bad news - we get into an endless recursion of duplicateobj calls until the stack blows up @@ -446,7 +446,7 @@ static void dup_internal_rep(Tcl_Obj* src, Tcl_Obj* dest, Tcl_ObjType* objtype) } else { if (objtype == &json_array) { Tcl_Obj** ov = NULL; - int oc; + Tcl_Size oc; // The list type's internal structure sharing on duplicates messes up our sharing, // rather recreate a fresh list referencing the original element objects instead if (TCL_OK != Tcl_ListObjGetElements(NULL, srcir->twoPtrValue.ptr1, &oc, &ov)) @@ -516,7 +516,7 @@ static void update_string_rep_number(Tcl_Obj* obj) //{{{ { Tcl_ObjInternalRep* ir = Tcl_FetchInternalRep(obj, &json_number); const char* str; - int len; + Tcl_Size len; if (ir->twoPtrValue.ptr1 == obj) Tcl_Panic("Turtles all the way down!"); @@ -590,7 +590,7 @@ static int set_from_any(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_ObjType** objtype, const unsigned char* p; const unsigned char* e; const unsigned char* val_start; - int len; + Tcl_Size len; struct parse_context cx[CX_STACK_SIZE]; enum extensions extensions = EXT_COMMENTS; struct parse_error details = {0}; diff --git a/generic/parser.c b/generic/parser.c index 4e49d8d..c14a22f 100644 --- a/generic/parser.c +++ b/generic/parser.c @@ -20,9 +20,12 @@ void throw_parse_error(Tcl_Interp* interp, struct parse_error* details) //{{{ { char char_ofs_buf[20]; // 20 bytes allows for 19 bytes of decimal max 64 bit size_t, plus null terminator - snprintf(char_ofs_buf, 20, "%ld", details->char_ofs); - - Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %ld", details->errmsg, details->char_ofs)); + snprintf(char_ofs_buf, 20, "%llu", (unsigned long long)details->char_ofs); +#if TCL_MAJOR_VERSION == 8 + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %ld", details->errmsg, (unsigned long)details->char_ofs)); +#else + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Error parsing JSON value: %s at offset %llu", details->errmsg, (unsigned long long)details->char_ofs)); +#endif Tcl_SetErrorCode(interp, "RL", "JSON", "PARSE", details->errmsg, details->doc, char_ofs_buf, NULL); } @@ -225,7 +228,7 @@ int skip_whitespace(const unsigned char** s, const unsigned char* e, const char* } //}}} -int is_template(const char* s, int len) //{{{ +int is_template(const char* s, Tcl_Size len) //{{{ { if ( len >= 3 && diff --git a/generic/rl_json.c b/generic/rl_json.c index eb04c37..74fa2d7 100644 --- a/generic/rl_json.c +++ b/generic/rl_json.c @@ -118,7 +118,7 @@ static const char *extension_str[] = { (char*)NULL }; -static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res); +static int new_json_value_from_list(Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Obj** res); static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, int retcode); static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds); @@ -237,7 +237,8 @@ display *obj if (Tcl_HasStringRep(obj)) { // Has a string rep already, make sure it's not hex or octal, and not padded with whitespace const char* s; - int len, start=0; + Tcl_Size len; + int start=0; s = Tcl_GetStringFromObj(obj, &len); if (len >= 1 && s[0] == '-') @@ -316,7 +317,7 @@ display *obj //}}} static void append_json_string(const struct serialize_context* scx, Tcl_Obj* obj) //{{{ { - int len; + Tcl_Size len; const char* chunk; const char* p; const char* e; @@ -394,7 +395,8 @@ static int serialize_json_val(Tcl_Interp* interp, struct serialize_context* scx, // Have to do the template subst here rather than at // parse time since the dict keys would be broken otherwise if (scx->serialize_mode == SERIALIZE_TEMPLATE) { - int len, stype; + Tcl_Size len; + int stype; const char* s; s = Tcl_GetStringFromObj(k, &len); @@ -451,7 +453,8 @@ static int serialize_json_val(Tcl_Interp* interp, struct serialize_context* scx, //}}} case JSON_ARRAY: //{{{ { - int i, oc, first=1; + Tcl_Size oc; + int i, first=1; Tcl_Obj** ov; Tcl_Obj* iv = NULL; enum json_types v_type = JSON_UNDEF; @@ -475,7 +478,7 @@ static int serialize_json_val(Tcl_Interp* interp, struct serialize_context* scx, case JSON_NUMBER: //{{{ { const char* bytes; - int len; + Tcl_Size len; bytes = Tcl_GetStringFromObj(val, &len); Tcl_DStringAppend(ds, bytes, len); @@ -645,7 +648,7 @@ int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj) / static int get_modifier(Tcl_Interp* interp, Tcl_Obj* modobj, enum modifiers* modifier) //{{{ { // This must be kept in sync with the modifiers enum - static CONST char *modstrings[] = { + static const char *modstrings[] = { "", "?length", "?size", @@ -662,9 +665,10 @@ static int get_modifier(Tcl_Interp* interp, Tcl_Obj* modobj, enum modifiers* mod } //}}} -int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers, Tcl_Obj* def) //{{{ +int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], Tcl_Size pathc, Tcl_Obj** target, const int exists, const int modifiers, Tcl_Obj* def) //{{{ { - int i, modstrlen; + Tcl_Size modstrlen; + int i; enum json_types type; struct interp_cx* l = Tcl_GetAssocData(interp, "rl_json", NULL); const char* modstr; @@ -715,7 +719,7 @@ int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int p switch (type) { case JSON_ARRAY: { - int ac; + Tcl_Size ac; Tcl_Obj** av; TEST_OK_LABEL(done, retval, Tcl_ListObjGetElements(interp, val, &ac, &av)); EXISTS(1); @@ -747,7 +751,7 @@ int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int p THROW_ERROR_LABEL(done, retval, Tcl_GetString(step), " modifier is not supported for type ", type_names[type]); } { - int size; + Tcl_Size size; TEST_OK_LABEL(done, retval, Tcl_DictObjSize(interp, val, &size)); EXISTS(1); replace_tclobj(&t, Tcl_NewIntObj(size)); @@ -809,7 +813,7 @@ int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int p } if (t == NULL) { EXISTS(0); - Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element %d: \"%s\" not found", pathc+1, Tcl_GetString(step))); + Tcl_SetObjResult(interp, Tcl_ObjPrintf("Path element %" TCL_SIZE_MODIFIER "d: \"%s\" not found", pathc+1, Tcl_GetString(step))); retval = TCL_ERROR; goto done; } @@ -820,7 +824,8 @@ int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int p //}}} case JSON_ARRAY: //{{{ { - int ac, index_str_len, ok=1; + Tcl_Size ac, index_str_len; + int ok=1; long index; const char* index_str; char* end; @@ -886,7 +891,7 @@ int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int p { EXISTS(0); Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "Cannot descend into atomic type \"%s\" with path element %d: \"%s\"", + "Cannot descend into atomic type \"%s\" with path element %" TCL_SIZE_MODIFIER "d: \"%s\"", type_names[type], pathc, Tcl_GetString(step) @@ -956,7 +961,8 @@ int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out) //{{{ case JSON_ARRAY: { - int i, oc; + Tcl_Size oc; + int i; Tcl_Obj** ov = NULL; Tcl_Obj* elem = NULL; Tcl_Obj* new = NULL; @@ -1007,7 +1013,8 @@ int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out) //{{{ //}}} static int _new_object(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{ { - int i, ac, retval=TCL_OK; + Tcl_Size ac; + int i, retval=TCL_OK; Tcl_Obj** av = NULL; Tcl_Obj* new_val = NULL; Tcl_Obj* val = NULL; @@ -1165,7 +1172,8 @@ static int NRforeach_next_loop_bottom(ClientData cdata[], Tcl_Interp* interp, in break; //}}} } else { // Iterate over it_res as a list {{{ - int oc, i; + Tcl_Size oc; + int i; Tcl_Obj** ov = NULL; TEST_OK_LABEL(done, retcode, Tcl_ListObjGetElements(interp, it_res, &oc, &ov)); @@ -1273,7 +1281,8 @@ static int foreach(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], enum col } for (i=0; iiterators; i++) { - int loops, j; + Tcl_Size loops; + int j; enum json_types type; Tcl_Obj* val; Tcl_Obj* varlist = objv[i*2]; @@ -1297,7 +1306,7 @@ static int foreach(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], enum col Tcl_ListObjGetElements(interp, val, &state->it[i].data_c, &state->it[i].data_v)); state->it[i].data_i = 0; state->it[i].is_array = 1; - loops = (int)ceil(state->it[i].data_c / (double)state->it[i].var_c); + loops = (Tcl_Size)ceil(state->it[i].data_c / (double)state->it[i].var_c); break; @@ -1341,9 +1350,10 @@ static int foreach(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], enum col } //}}} -int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds) //{{{ +int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, int nopadding, Tcl_Obj* pad, int arrays_inline, Tcl_DString* ds) //{{{ { - int pad_len, next_pad_len, count; + Tcl_Size pad_len, next_pad_len; + int count; enum json_types type; const char* pad_str; const char* next_pad_str; @@ -1365,7 +1375,8 @@ int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad switch (type) { case JSON_OBJECT: //{{{ { - int done, k_len, max=0, size; + Tcl_Size k_len, size; + int done, max=0; Tcl_DictSearch search; Tcl_Obj* k; Tcl_Obj* v; @@ -1379,15 +1390,19 @@ int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad TEST_OK_LABEL(finally, retval, Tcl_DictObjFirst(interp, val, &search, &k, &v, &done)); - for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) { - Tcl_GetStringFromObj(k, &k_len); - if (k_len <= 20 && k_len > max) - max = k_len; - } - Tcl_DictObjDone(&search); + // keep the default behaviour, if wanted add the -nopadding option + // and the output will be condensed + if (!nopadding) { + for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) { + Tcl_GetStringFromObj(k, &k_len); + if (k_len <= 20 && k_len > max) + max = k_len; + } + Tcl_DictObjDone(&search); - if (max > 20) - max = 20; // If this cap is changed be sure to adjust the key_pad_buf length above + if (max > 20) + max = 20; // If this cap is changed be sure to adjust the key_pad_buf length above + } replace_tclobj(&next_pad, Tcl_DuplicateObj(pad)); Tcl_AppendObjToObj(next_pad, indent); @@ -1403,11 +1418,14 @@ int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad append_json_string(&scx, k); Tcl_DStringAppend(ds, ": ", 2); - Tcl_GetStringFromObj(k, &k_len); - if (k_len < max) - Tcl_DStringAppend(ds, key_pad_buf, max-k_len); - - if (json_pretty(interp, v, indent, next_pad, ds) != TCL_OK) { + // keep the default behaviour, if wanted add the -nopadding option + if (!nopadding) { + Tcl_GetStringFromObj(k, &k_len); + if (k_len < max) + Tcl_DStringAppend(ds, key_pad_buf, max-k_len); + } + + if (json_pretty(interp, v, indent, nopadding, next_pad, arrays_inline, ds) != TCL_OK) { Tcl_DictObjDone(&search); retval = TCL_ERROR; goto finally; @@ -1429,8 +1447,10 @@ int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad case JSON_ARRAY: //{{{ { - int i, oc; + Tcl_Size oc; + int i; Tcl_Obj** ov; + int force_inline, force_multiline, should_inline; TEST_OK_LABEL(finally, retval, Tcl_ListObjGetElements(interp, val, &oc, &ov)); @@ -1438,20 +1458,38 @@ int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad Tcl_AppendObjToObj(next_pad, indent); next_pad_str = Tcl_GetStringFromObj(next_pad, &next_pad_len); + // Determine array formatting: inline vs multiline + force_inline = (arrays_inline == 1); + force_multiline = (arrays_inline == 0); + // Auto heuristic: small arrays (<=3 elements) inline by default + should_inline = (!force_multiline) && (force_inline || oc <= 3); + if (oc == 0) { Tcl_DStringAppend(ds, "[]", 2); + } else if (should_inline) { + // Inline format: [1,2,3] + Tcl_DStringAppend(ds, "[", 1); + count = 0; + for (i=0; irefCount)); Tcl_DStringAppend(ds, Tcl_GetString(tmp), -1); release_tclobj(&tmp); } else { Tcl_Obj* tmp = NULL; - replace_tclobj(&tmp, Tcl_ObjPrintf("(0x%lx[%d]/0x%lx[%d] %s)", + replace_tclobj(&tmp, Tcl_ObjPrintf("(0x%lx[%" TCL_SIZE_MODIFIER "d]/0x%lx[%" TCL_SIZE_MODIFIER "d] %s)", (unsigned long)(ptrdiff_t)json, json->refCount, (unsigned long)(ptrdiff_t)val, val->refCount, val->typePtr ? val->typePtr->name : "pure string")); Tcl_DStringAppend(ds, Tcl_GetString(tmp), -1); @@ -1509,7 +1548,8 @@ static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, T switch (type) { case JSON_OBJECT: //{{{ { - int done, k_len, max=0, size; + Tcl_Size k_len, size; + int done, max=0; Tcl_DictSearch search; Tcl_Obj* k; Tcl_Obj* v; @@ -1573,7 +1613,8 @@ static int json_pretty_dbg(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, T case JSON_ARRAY: //{{{ { - int i, oc; + Tcl_Size oc; + int i; Tcl_Obj** ov; TEST_OK_LABEL(finally, retval, Tcl_ListObjGetElements(interp, val, &oc, &ov)); @@ -1695,7 +1736,8 @@ static int merge(Tcl_Interp* interp, int deep, Tcl_Obj *const orig, Tcl_Obj *con #endif static int prev_opcode(const struct template_cx *const cx) //{{{ { - int len, opcode; + Tcl_Size len; + int opcode; Tcl_Obj* last = NULL; TEST_OK(Tcl_ListObjLength(cx->interp, cx->actions, &len)); @@ -1735,7 +1777,8 @@ static int emit_fetches(const struct template_cx *const cx) //{{{ TEST_OK(Tcl_DictObjFirst(cx->interp, cx->map, &search, &elem, &v, &done)); for (; !done; Tcl_DictObjNext(&search, &elem, &v, &done)) { - int len, fetch_idx, types_search_done=0, used_fetch=0; + Tcl_Size len; + int fetch_idx, types_search_done=0, used_fetch=0; Tcl_DictSearch types_search; Tcl_Obj* type; Tcl_Obj* slot; @@ -1772,7 +1815,7 @@ static int emit_fetches(const struct template_cx *const cx) //{{{ case JSON_DYN_LITERAL: { const char* s; - int len; + Tcl_Size len; enum json_types type; s = Tcl_GetStringFromObj(elem, &len); @@ -1868,7 +1911,7 @@ static int remove_action(Tcl_Interp* interp, struct template_cx* cx, int idx) // { idx *= 3; if (idx < 0) { - int len; + Tcl_Size len; TEST_OK(Tcl_ListObjLength(interp, cx->actions, &len)); idx += len; @@ -1903,7 +1946,7 @@ static int template_actions(struct template_cx* cx, Tcl_Obj* template, enum acti TEST_OK(emit_action(cx, PUSH_TARGET, Tcl_DuplicateObj(template), NULL)); TEST_OK(Tcl_DictObjFirst(interp, val, &search, &k, &v, &done)); for (; !done; Tcl_DictObjNext(&search, &k, &v, &done)) { - int len; + Tcl_Size len; enum json_types stype; const char* s = Tcl_GetStringFromObj(k, &len); @@ -1949,7 +1992,8 @@ static int template_actions(struct template_cx* cx, Tcl_Obj* template, enum acti case JSON_ARRAY: { - int i, oc; + Tcl_Size oc; + int i; Tcl_Obj** ov; Tcl_Obj* arr_elem = NULL; @@ -2028,7 +2072,8 @@ int build_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj** acti replace_tclobj(&cx.actions, Tcl_NewListObj(0, NULL)); { // Find max cx stack depth - int depth=0, actionc, i; + Tcl_Size actionc; + int depth=0, i; Tcl_Obj** actionv; TEST_OK_LABEL(actions_done, retcode, @@ -2102,7 +2147,8 @@ int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actio int slotslen = 0; int retcode = TCL_OK; Tcl_Obj** actionv; - int actionc, i; + Tcl_Size actionc; + int i; #define STATIC_STACK 8 Tcl_Obj* stackstack[STATIC_STACK]; Tcl_Obj** stack = NULL; @@ -2179,7 +2225,7 @@ int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actio fill_slot(slots, slot, l->json_null); } else { const char* str; - int len; + Tcl_Size len; Tcl_Obj* jval=NULL; str = Tcl_GetStringFromObj(subst_val, &len); @@ -2517,7 +2563,7 @@ static int jsonType(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *con static int jsonLength(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { struct interp_cx* l = (struct interp_cx*)cdata; - int length; + Tcl_Size length; int retval = TCL_OK; Tcl_Obj* target = NULL; Tcl_Obj* path = NULL; @@ -2536,7 +2582,7 @@ static int jsonLength(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c switch (length) { case 0: Tcl_SetObjResult(interp, l->tcl_zero); break; case 1: Tcl_SetObjResult(interp, l->tcl_one); break; - default: Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); break; + default: Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length)); break; } } @@ -2663,7 +2709,7 @@ static int jsonGet(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *cons if (objc >= argbase+2) { const char* s = NULL; - int l; + Tcl_Size l; TEST_OK_LABEL(finally, code, resolve_path(interp, objv[argbase], objv+argbase+1, objc-(argbase+1), &target, 0, 1, def)); s = Tcl_GetStringFromObj(objv[objc-1], &l); @@ -2884,7 +2930,7 @@ static int jsonString(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c #if DEDUP struct interp_cx* l = (struct interp_cx*)cdata; #endif - int len; + Tcl_Size len; const char* s; enum json_types type; int retval = TCL_OK; @@ -2943,7 +2989,7 @@ static int jsonBoolean(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj * static int jsonObject(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { int retval = TCL_OK; - int oc; + Tcl_Size oc; Tcl_Obj** ov; Tcl_Obj* res = NULL; @@ -2963,7 +3009,8 @@ static int jsonObject(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c //}}} static int jsonArray(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { - int i, ac, retval = TCL_OK;; + Tcl_Size ac; + int i, retval = TCL_OK;; Tcl_Obj** av; Tcl_Obj* elem = NULL; Tcl_Obj* val = NULL; @@ -2983,6 +3030,116 @@ static int jsonArray(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co return retval; } +//}}} +static int jsonAutoArray(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ +{ + struct interp_cx* l = (struct interp_cx*)cdata; + int i, retval = TCL_OK; + Tcl_Obj* elem = NULL; + Tcl_Obj* val = NULL; + Tcl_Obj* forced = NULL; + const char* str; + Tcl_Size len; + + replace_tclobj(&val, Tcl_NewListObj(objc-1, NULL)); + + for (i=1; ijson_true)); + } else if (len == 5 && strcmp(str, "false") == 0) { + replace_tclobj(&elem, JSON_NewJvalObj(JSON_BOOL, l->json_false)); + } else { + // Try to parse as a number + int is_number = (force_json_number(interp, l, objv[i], &forced) == TCL_OK); + + if (is_number) { + // It's a valid JSON number + replace_tclobj(&elem, JSON_NewJvalObj(JSON_NUMBER, forced)); + release_tclobj(&forced); + } else { + // Default to string + // Clear any error message from failed number conversion + Tcl_ResetResult(interp); + replace_tclobj(&elem, JSON_NewJvalObj(JSON_STRING, objv[i])); + } + } + + TEST_OK_LABEL(finally, retval, Tcl_ListObjAppendElement(interp, val, elem)); + } + Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_ARRAY, val)); + +finally: + release_tclobj(&elem); + release_tclobj(&val); + release_tclobj(&forced); + return retval; +} + +//}}} +static int jsonAutoObject(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ +{ + struct interp_cx* l = (struct interp_cx*)cdata; + int i, retval = TCL_OK; + Tcl_Obj* key = NULL; + Tcl_Obj* elem = NULL; + Tcl_Obj* dict = NULL; + Tcl_Obj* forced = NULL; + const char* str; + Tcl_Size len; + + // Validate argument count - must have even number of arguments (key-value pairs) + if ((objc - 1) % 2 != 0) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf("wrong # args: should be \"json autoobject ?key value ...?\"")); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); + retval = TCL_ERROR; + goto finally; + } + + replace_tclobj(&dict, Tcl_NewDictObj()); + + for (i=1; ijson_true)); + } else if (len == 5 && strcmp(str, "false") == 0) { + replace_tclobj(&elem, JSON_NewJvalObj(JSON_BOOL, l->json_false)); + } else { + // Try to parse as a number + int is_number = (force_json_number(interp, l, objv[i+1], &forced) == TCL_OK); + + if (is_number) { + // It's a valid JSON number + replace_tclobj(&elem, JSON_NewJvalObj(JSON_NUMBER, forced)); + release_tclobj(&forced); + } else { + // Default to string + // Clear any error message from failed number conversion + Tcl_ResetResult(interp); + replace_tclobj(&elem, JSON_NewJvalObj(JSON_STRING, objv[i+1])); + } + } + + TEST_OK_LABEL(finally, retval, Tcl_DictObjPut(interp, dict, key, elem)); + } + Tcl_SetObjResult(interp, JSON_NewJvalObj(JSON_OBJECT, dict)); + +finally: + release_tclobj(&key); + release_tclobj(&elem); + release_tclobj(&dict); + release_tclobj(&forced); + return retval; +} + //}}} static int jsonDecode(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { @@ -3183,18 +3340,36 @@ static int jsonPretty(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c Tcl_Obj* indent = NULL; Tcl_Obj* target = NULL; int argbase = 1; + int compact = 0; + int nopadding = 0; + int arrays_inline = -1; // -1 = default/auto, 0 = multiline, 1 = inline static const char* opts[] = { "-indent", + "-compact", + "-nopadding", + "-arrays", "--", // Unnecessary for this case, but supported for convention NULL }; enum { OPT_INDENT, + OPT_COMPACT, + OPT_NOPADDING, + OPT_ARRAYS, OPT_END_OPTIONS }; + static const char* array_modes[] = { + "inline", + "multiline", + NULL + }; + enum { + ARRAYS_INLINE, + ARRAYS_MULTILINE + }; enum {A_cmd, A_VAL, A_args}; - CHECK_MIN_ARGS_LABEL(finally, code, "pretty ?-indent indent? json_val ?key ...?"); + CHECK_MIN_ARGS_LABEL(finally, code, "pretty ?-indent indent? ?-compact? ?-nopadding? ?-arrays inline|multiline? json_val ?key ...?"); // Consume any leading options {{{ while (argbase < objc) { @@ -3216,18 +3391,40 @@ static int jsonPretty(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c argbase += 2; break; + case OPT_COMPACT: + compact = 1; + argbase++; + break; + + case OPT_NOPADDING: + nopadding = 1; + argbase++; + break; + + case OPT_ARRAYS: { + int array_mode; + if (objc - argbase < 2) { + Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL); + THROW_ERROR_LABEL(finally, code, "missing argument to \"-arrays\""); + } + TEST_OK_LABEL(finally, code, Tcl_GetIndexFromObj(interp, objv[argbase+1], array_modes, "array mode", TCL_EXACT, &array_mode)); + arrays_inline = (array_mode == ARRAYS_INLINE) ? 1 : 0; + argbase += 2; + break; + } + case OPT_END_OPTIONS: argbase++; goto endoptions; default: - THROW_ERROR_LABEL(finally, code, "Unhandled get option idx"); + THROW_ERROR_LABEL(finally, code, "Unhandled pretty option idx"); } } endoptions: if (objc == argbase) { - Tcl_WrongNumArgs(interp, 1, objv, "?-default defaultValue? json_val ?key ...?"); + Tcl_WrongNumArgs(interp, 1, objv, "?-indent indent? ?-compact? ?-nopadding? ?-arrays inline|multiline? json_val ?key ...?"); code = TCL_ERROR; goto finally; } @@ -3239,7 +3436,7 @@ static int jsonPretty(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *c replace_tclobj(&target, objv[argbase]); } - TEST_OK_LABEL(finally, code, JSON_Pretty(interp, target, indent, &pretty)); + TEST_OK_LABEL(finally, code, JSON_Pretty(interp, target, indent, nopadding, compact, arrays_inline, &pretty)); Tcl_SetObjResult(interp, pretty); @@ -3285,7 +3482,8 @@ static int jsonValid(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co case O_EXTENSIONS: { Tcl_Obj** ov; - int oc, idx; + Tcl_Size oc; + int idx; extensions = 0; // An explicit list was supplied, reset the extensions @@ -3420,7 +3618,8 @@ static int jsonTemplateActions(ClientData cdata, Tcl_Interp* interp, int objc, T #if 0 static int jsonMerge(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { - int i=2, deep=0, checking_flags=1, str_len; + Tcl_Size str_len; + int i=2, deep=0, checking_flags=1; const char* str; Tcl_Obj* res = NULL; Tcl_Obj* patch; @@ -3479,7 +3678,7 @@ static int jsonMerge(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co //}}} #endif -static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{ +static int new_json_value_from_list(Tcl_Interp* interp, Tcl_Size objc, Tcl_Obj *const objv[], Tcl_Obj** res) //{{{ { struct interp_cx* l = Tcl_GetAssocData(interp, "rl_json", NULL); Tcl_Obj* tmp = NULL; @@ -3570,6 +3769,7 @@ static int new_json_value_from_list(Tcl_Interp* interp, int objc, Tcl_Obj *const } //}}} +#if !ENSEMBLE static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { int subcommand; @@ -3604,6 +3804,8 @@ static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co "boolean", "object", "array", + "autoarray", + "autoobject", "decode", @@ -3645,6 +3847,8 @@ static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co M_BOOLEAN, M_OBJECT, M_ARRAY, + M_AUTOARRAY, + M_AUTOOBJECT, M_DECODE, // Debugging M_FREE_CACHE, @@ -3680,6 +3884,8 @@ static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co case M_BOOLEAN: return jsonBoolean(cdata, interp, objc-1, objv+1); case M_OBJECT: return jsonObject(cdata, interp, objc-1, objv+1); case M_ARRAY: return jsonArray(cdata, interp, objc-1, objv+1); + case M_AUTOARRAY: return jsonAutoArray(cdata, interp, objc-1, objv+1); + case M_AUTOOBJECT: return jsonAutoObject(cdata, interp, objc-1, objv+1); case M_DECODE: return jsonDecode(cdata, interp, objc-1, objv+1); case M_ISNULL: return jsonIsNull(cdata, interp, objc-1, objv+1); case M_TEMPLATE: return jsonTemplate(cdata, interp, objc-1, objv+1); @@ -3699,16 +3905,16 @@ static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co case M_LEAK_OBJ: Tcl_NewObj(); break; case M_LEAK_INFO: { - unsigned long addr; + Tcl_WideInt addr; Tcl_Obj* obj = NULL; const char* s; - int len; + Tcl_Size len; CHECK_ARGS(2, "addr"); - TEST_OK(Tcl_GetLongFromObj(interp, objv[2], (long*)&addr)); - obj = (Tcl_Obj*)addr; + TEST_OK(Tcl_GetWideIntFromObj(interp, objv[2], &addr)); + obj = (Tcl_Obj*)(uintptr_t)addr; s = Tcl_GetStringFromObj(obj, &len); - fprintf(stderr, "\tLeaked obj: %p[%d] len %d: \"%s\"\n", obj, obj->refCount, len, len < 256 ? s : ""); + fprintf(stderr, "\tLeaked obj: %p[%" TCL_SIZE_MODIFIER "d] len %" TCL_SIZE_MODIFIER "d: \"%s\"\n", obj, obj->refCount, len, len < 256 ? s : ""); break; } @@ -3747,12 +3953,16 @@ static int jsonNRObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *co return TCL_OK; } +#endif //}}} + +#if !ENSEMBLE static int jsonObj(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[]) //{{{ { return Tcl_NRCallObjProc(interp, jsonNRObj, cdata, objc, objv); } +#endif //}}} @@ -3908,7 +4118,7 @@ DLLEXPORT int Rl_json_Init(Tcl_Interp* interp) //{{{ struct interp_cx* l = NULL; #ifdef USE_TCL_STUBS - if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) + if (Tcl_InitStubs(interp, "8.6-", 0) == NULL) return TCL_ERROR; #endif // USE_TCL_STUBS @@ -3958,6 +4168,31 @@ DLLEXPORT int Rl_json_Init(Tcl_Interp* interp) //{{{ l->typeInt = Tcl_GetObjType("int"); l->typeDouble = Tcl_GetObjType("double"); l->typeBignum = Tcl_GetObjType("bignum"); + + // Tcl 9 no longer registers internal types via Tcl_GetObjType. + // Fall back to creating a value of the desired type and snooping its typePtr. + if (l->typeDict == NULL) { + Tcl_Obj* tmp = Tcl_NewDictObj(); + Tcl_IncrRefCount(tmp); + l->typeDict = tmp->typePtr; + Tcl_DecrRefCount(tmp); + } + if (l->typeInt == NULL) { + Tcl_Obj* tmp = Tcl_NewIntObj(0); + Tcl_IncrRefCount(tmp); + l->typeInt = tmp->typePtr; + Tcl_DecrRefCount(tmp); + } + if (l->typeDouble == NULL) { + Tcl_Obj* tmp = Tcl_NewDoubleObj(0.0); + Tcl_IncrRefCount(tmp); + l->typeDouble = tmp->typePtr; + Tcl_DecrRefCount(tmp); + } + if (l->typeBignum == NULL) { + // bignum is optional, leave NULL if not available + } + if (l->typeDict == NULL) THROW_ERROR("Can't retrieve objType for dict"); if (l->typeInt == NULL) THROW_ERROR("Can't retrieve objType for int"); if (l->typeDouble == NULL) THROW_ERROR("Can't retrieve objType for double"); @@ -4107,6 +4342,8 @@ DLLEXPORT int Rl_json_Init(Tcl_Interp* interp) //{{{ Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("boolean", -1)); Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("object", -1)); Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("array", -1)); + Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("autoarray", -1)); + Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("autoobject", -1)); Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("decode", -1)); Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("isnull", -1)); Tcl_ListObjAppendElement(NULL, subcommands, Tcl_NewStringObj("template", -1)); @@ -4143,6 +4380,8 @@ DLLEXPORT int Rl_json_Init(Tcl_Interp* interp) //{{{ Tcl_CreateObjCommand(interp, ENS "boolean", jsonBoolean, l, NULL); Tcl_CreateObjCommand(interp, ENS "object", jsonObject, l, NULL); Tcl_CreateObjCommand(interp, ENS "array", jsonArray, l, NULL); + Tcl_CreateObjCommand(interp, ENS "autoarray", jsonAutoArray, l, NULL); + Tcl_CreateObjCommand(interp, ENS "autoobject", jsonAutoObject, l, NULL); Tcl_CreateObjCommand(interp, ENS "decode", jsonDecode, l, NULL); Tcl_CreateObjCommand(interp, ENS "isnull", jsonIsNull, l, NULL); Tcl_CreateObjCommand(interp, ENS "template", jsonTemplate, l, NULL); @@ -4188,6 +4427,10 @@ DLLEXPORT int Rl_json_SafeInit(Tcl_Interp* interp) //{{{ } //}}} +// Tcl 9 uses the package name as-is for the init function (no auto-capitalization) +DLLEXPORT int rl_json_Init(Tcl_Interp* interp) { return Rl_json_Init(interp); } +DLLEXPORT int rl_json_SafeInit(Tcl_Interp* interp) { return Rl_json_SafeInit(interp); } + #if UNLOAD DLLEXPORT int Rl_json_Unload(Tcl_Interp* interp, int flags) //{{{ { diff --git a/generic/rl_json.decls b/generic/rl_json.decls index b61d977..5c3f305 100644 --- a/generic/rl_json.decls +++ b/generic/rl_json.decls @@ -55,7 +55,7 @@ declare 15 generic { int JSON_SetJArrayObj(Tcl_Interp* interp, Tcl_Obj* obj, int objc, Tcl_Obj* objv[]) } declare 16 generic { - int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, int* objc, Tcl_Obj*** objv) + int JSON_JArrayObjGetElements(Tcl_Interp* interp, Tcl_Obj* arrayObj, Tcl_Size* objc, Tcl_Obj*** objv) } declare 17 generic { int JSON_JArrayObjIndex(Tcl_Interp* interp, Tcl_Obj* arrayObj, int index, Tcl_Obj** elem) @@ -87,7 +87,7 @@ declare 24 generic { int JSON_Normalize(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** normalized) } declare 25 generic { - int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, Tcl_Obj** prettyString) + int JSON_Pretty(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* indent, int nopadding, int compact, int arrays_inline, Tcl_Obj** prettyString) } declare 26 generic { int JSON_Template(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* dict, Tcl_Obj** res) @@ -100,7 +100,7 @@ declare 28 generic { int JSON_Type(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path /* can be NULL */, enum json_types* type) } declare 29 generic { - int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path /* can be NULL */, int* length) + int JSON_Length(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path /* can be NULL */, Tcl_Size* length) } declare 30 generic { int JSON_Keys(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj* path /* can be NULL */, Tcl_Obj** keyslist) diff --git a/generic/rl_json.h b/generic/rl_json.h index 0e9b9ac..bd897ae 100644 --- a/generic/rl_json.h +++ b/generic/rl_json.h @@ -4,6 +4,15 @@ #include #include // Stubs API uses stdint types +/* Tcl 8 compatibility shim for Tcl_Size */ +#ifndef TCL_SIZE_MAX +#include +typedef int Tcl_Size; +#define TCL_SIZE_MAX INT_MAX +#define TCL_SIZE_MODIFIER "" +#define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj +#endif + #ifdef BUILD_rl_json #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT @@ -71,13 +80,13 @@ enum cbor_mt { // Stubs exported API #ifdef USE_RL_JSON_STUBS -EXTERN CONST char* Rl_jsonInitStubs _ANSI_ARGS_((Tcl_Interp* interp, CONST char* version, int exact)); +EXTERN const char* Rl_jsonInitStubs(Tcl_Interp* interp, const char* version, int exact); #else # define Rl_jsonInitStubs(interp, version, exact) Tcl_PkgRequire(interp, "rl_json", version, exact) #endif #include "rl_jsonDecls.h" -EXTERN int Rl_json_Init _ANSI_ARGS_((Tcl_Interp* interp)); -EXTERN int Rl_json_SafeInit _ANSI_ARGS_((Tcl_Interp* interp)); +EXTERN int Rl_json_Init(Tcl_Interp* interp); +EXTERN int Rl_json_SafeInit(Tcl_Interp* interp); #endif diff --git a/generic/rl_jsonDecls.h b/generic/rl_jsonDecls.h index a864eb8..71d3835 100644 --- a/generic/rl_jsonDecls.h +++ b/generic/rl_jsonDecls.h @@ -56,7 +56,7 @@ EXTERN int JSON_SetJArrayObj(Tcl_Interp*interp, Tcl_Obj*obj, int objc, Tcl_Obj*objv[]); /* 16 */ EXTERN int JSON_JArrayObjGetElements(Tcl_Interp*interp, - Tcl_Obj*arrayObj, int*objc, Tcl_Obj***objv); + Tcl_Obj*arrayObj, Tcl_Size*objc, Tcl_Obj***objv); /* 17 */ EXTERN int JSON_JArrayObjIndex(Tcl_Interp*interp, Tcl_Obj*arrayObj, int index, Tcl_Obj**elem); @@ -87,7 +87,8 @@ EXTERN int JSON_Normalize(Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj**normalized); /* 25 */ EXTERN int JSON_Pretty(Tcl_Interp*interp, Tcl_Obj*obj, - Tcl_Obj*indent, Tcl_Obj**prettyString); + Tcl_Obj*indent, int nopadding, int compact, + int arrays_inline, Tcl_Obj**prettyString); /* 26 */ EXTERN int JSON_Template(Tcl_Interp*interp, Tcl_Obj*template, Tcl_Obj*dict, Tcl_Obj**res); @@ -100,7 +101,7 @@ EXTERN int JSON_Type(Tcl_Interp*interp, Tcl_Obj*obj, enum json_types*type); /* 29 */ EXTERN int JSON_Length(Tcl_Interp*interp, Tcl_Obj*obj, - Tcl_Obj* path /* can be NULL */, int*length); + Tcl_Obj* path /* can be NULL */, Tcl_Size*length); /* 30 */ EXTERN int JSON_Keys(Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, @@ -123,7 +124,7 @@ EXTERN Tcl_Obj* JSON_NewJvalObj(enum json_types type, Tcl_Obj*val); EXTERN Tcl_Obj* JSON_DbNewJvalObj(enum json_types type, Tcl_Obj*val, const char*file, int line); -typedef struct Rl_jsonStubs { +typedef struct TcljsonStubs { int magic; void *hooks; @@ -143,7 +144,7 @@ typedef struct Rl_jsonStubs { int (*jSON_JArrayObjAppendElement) (Tcl_Interp*interp, Tcl_Obj*arrayObj, Tcl_Obj*elem); /* 13 */ int (*jSON_JArrayObjAppendList) (Tcl_Interp*interp, Tcl_Obj*arrayObj, Tcl_Obj* elems /* a JArrayObj or ListObj */); /* 14 */ int (*jSON_SetJArrayObj) (Tcl_Interp*interp, Tcl_Obj*obj, int objc, Tcl_Obj*objv[]); /* 15 */ - int (*jSON_JArrayObjGetElements) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int*objc, Tcl_Obj***objv); /* 16 */ + int (*jSON_JArrayObjGetElements) (Tcl_Interp*interp, Tcl_Obj*arrayObj, Tcl_Size*objc, Tcl_Obj***objv); /* 16 */ int (*jSON_JArrayObjIndex) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int index, Tcl_Obj**elem); /* 17 */ int (*jSON_JArrayObjReplace) (Tcl_Interp*interp, Tcl_Obj*arrayObj, int first, int count, int objc, Tcl_Obj*objv[]); /* 18 */ int (*jSON_Get) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, Tcl_Obj**res); /* 19 */ @@ -152,11 +153,11 @@ typedef struct Rl_jsonStubs { int (*jSON_Set) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, Tcl_Obj*replacement); /* 22 */ int (*jSON_Unset) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */); /* 23 */ int (*jSON_Normalize) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj**normalized); /* 24 */ - int (*jSON_Pretty) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*indent, Tcl_Obj**prettyString); /* 25 */ + int (*jSON_Pretty) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj*indent, int nopadding, int compact, int arrays_inline, Tcl_Obj**prettyString); /* 25 */ int (*jSON_Template) (Tcl_Interp*interp, Tcl_Obj*template, Tcl_Obj*dict, Tcl_Obj**res); /* 26 */ int (*jSON_IsNULL) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, int*isnull); /* 27 */ int (*jSON_Type) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, enum json_types*type); /* 28 */ - int (*jSON_Length) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, int*length); /* 29 */ + int (*jSON_Length) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, Tcl_Size*length); /* 29 */ int (*jSON_Keys) (Tcl_Interp*interp, Tcl_Obj*obj, Tcl_Obj* path /* can be NULL */, Tcl_Obj**keyslist); /* 30 */ int (*jSON_Decode) (Tcl_Interp*interp, Tcl_Obj*bytes, Tcl_Obj*encoding, Tcl_Obj**decodedstring); /* 31 */ int (*jSON_Foreach) (Tcl_Interp*interp, Tcl_Obj*iterators, JSON_ForeachBody*body, enum collecting_mode collect, Tcl_Obj**res, ClientData cdata); /* 32 */ diff --git a/generic/rl_jsonInt.h b/generic/rl_jsonInt.h index b191bf3..aac07f2 100644 --- a/generic/rl_jsonInt.h +++ b/generic/rl_jsonInt.h @@ -3,6 +3,10 @@ #define _POSIX_C_SOURCE 200809L #define _DEFAULT_SOURCE +#ifdef HAVE_CONFIG_H +#include "config.h" +#endif + #include "rl_json.h" #include "tclstuff.h" #include @@ -18,8 +22,8 @@ #endif #if CBOR #include -#endif #include +#endif #include "tip445.h" #include "names.h" @@ -55,11 +59,11 @@ struct parse_context { }; struct foreach_iterator { - int data_c; + Tcl_Size data_c; Tcl_Obj** data_v; - int data_i; + Tcl_Size data_i; Tcl_Obj* varlist; - int var_c; + Tcl_Size var_c; Tcl_Obj** var_v; int is_array; @@ -71,9 +75,9 @@ struct foreach_iterator { }; struct foreach_state { - unsigned int loop_num; - unsigned int max_loops; - unsigned int iterators; + Tcl_Size loop_num; + Tcl_Size max_loops; + Tcl_Size iterators; struct foreach_iterator* it; Tcl_Obj* script; Tcl_Obj* res; @@ -213,9 +217,9 @@ void append_to_cx(struct parse_context *cx, Tcl_Obj *val); int serialize(Tcl_Interp* interp, struct serialize_context* scx, Tcl_Obj* obj); void release_instances(void); int init_types(Tcl_Interp* interp); -Tcl_Obj* new_stringobj_dedup(struct interp_cx *l, const char *bytes, int length); +Tcl_Obj* new_stringobj_dedup(struct interp_cx *l, const char *bytes, Tcl_Size length); int lookup_type(Tcl_Interp* interp, Tcl_Obj* typeobj, int* type); -int is_template(const char* s, int len); +int is_template(const char* s, Tcl_Size len); extern Tcl_ObjType* g_objtype_for_type[]; extern const char* type_names_int[]; @@ -254,8 +258,8 @@ Tcl_Obj* get_unshared_val(Tcl_ObjInternalRep* ir); int apply_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj* actions, Tcl_Obj* dict, Tcl_Obj** res); int build_template_actions(Tcl_Interp* interp, Tcl_Obj* template, Tcl_Obj** actions); int convert_to_tcl(Tcl_Interp* interp, Tcl_Obj* obj, Tcl_Obj** out); -int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], int pathc, Tcl_Obj** target, const int exists, const int modifiers, Tcl_Obj* def); -int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, Tcl_Obj* pad, Tcl_DString* ds); +int resolve_path(Tcl_Interp* interp, Tcl_Obj* src, Tcl_Obj *const pathv[], Tcl_Size pathc, Tcl_Obj** target, const int exists, const int modifiers, Tcl_Obj* def); +int json_pretty(Tcl_Interp* interp, Tcl_Obj* json, Tcl_Obj* indent, int nopadding, Tcl_Obj* pad, int arrays_inline, Tcl_DString* ds); void foreach_state_free(struct foreach_state* state); #define TEMPLATE_TYPE(s, len, out) \ @@ -285,7 +289,7 @@ void cbor_release(Tcl_Interp* interp); //#define Tcl_GetBytesFromObj(interp, obj, lenptr) Tcl_GetByteArrayFromObj(obj, lenptr) static inline uint8_t* Tcl_GetBytesFromObj(Tcl_Interp* interp, Tcl_Obj* obj, size_t* lenPtr) { - int len; + Tcl_Size len; uint8_t* bytes = Tcl_GetByteArrayFromObj(obj, &len); *lenPtr = len; return bytes; diff --git a/generic/rl_jsonStubLib.c b/generic/rl_jsonStubLib.c index 142940c..c22a845 100644 --- a/generic/rl_jsonStubLib.c +++ b/generic/rl_jsonStubLib.c @@ -7,7 +7,7 @@ const Rl_jsonStubs* Rl_jsonStubsPtr = NULL; #undef rl_jsonInitStubs -EXTERN CONST char* Rl_jsonInitStubs(Tcl_Interp* interp, const char* version, int exact) +EXTERN const char* Rl_jsonInitStubs(Tcl_Interp* interp, const char* version, int exact) { const char* packageName = "rl_json"; const char* errMsg = NULL; diff --git a/generic/tip445.fix.h b/generic/tip445.fix.h new file mode 100644 index 0000000..ecc9ecf --- /dev/null +++ b/generic/tip445.fix.h @@ -0,0 +1,94 @@ +#ifndef _TIP445_H +#define _TIP445_H + +#if TIP445_SHIM +#include +#include +#include + +/* Just enough of TIP445 to build on Tcl 8.6 */ + +#ifndef Tcl_ObjInternalRep +typedef union Tcl_ObjInternalRep { + struct { + void* ptr1; + void* ptr2; + } twoPtrValue; + struct { + void* ptr; + unsigned long value; + } ptrAndLongRep; +} Tcl_ObjInternalRep; +#endif + +#ifndef Tcl_FetchInternalRep +# define Tcl_FetchInternalRep(obj, type) (Tcl_ObjInternalRep*)(((obj)->typePtr == (type)) ? &(obj)->internalRep : NULL) +#endif + +#ifndef Tcl_FreeInternalRep +static inline void Tcl_FreeInternalRep(Tcl_Obj* obj) +{ + if (obj->typePtr) { + if (obj->typePtr && obj->typePtr->freeIntRepProc) + obj->typePtr->freeIntRepProc(obj); + obj->typePtr = NULL; + } +} +#endif + +#ifndef Tcl_StoreInternalRep +static inline void Tcl_StoreInternalRep(Tcl_Obj* objPtr, const Tcl_ObjType* typePtr, const Tcl_ObjInternalRep* irPtr) +{ + Tcl_FreeInternalRep(objPtr); + objPtr->typePtr = typePtr; + memcpy(&objPtr->internalRep, irPtr, sizeof(Tcl_ObjInternalRep)); +} +#endif + +#ifndef Tcl_HasStringRep +# define Tcl_HasStringRep(obj) ((obj)->bytes != NULL) +#endif + +/* +## error: 'Tcl_InitStringRep' defined but not used [-Werror=unused-function] +#ifndef Tcl_InitStringRep +static char* Tcl_InitStringRep(Tcl_Obj* objPtr, const char* bytes, unsigned numBytes) +{ + assert(objPtr->bytes == NULL || bytes == NULL); + + if (numBytes > INT_MAX) { + Tcl_Panic("max size of a Tcl value (%d bytes) exceeded", INT_MAX); + } + + // Allocate + if (objPtr->bytes == NULL) { + // Allocate only as empty - extend later if bytes copied + objPtr->length = 0; + if (numBytes) { + objPtr->bytes = (char*)attemptckalloc(numBytes + 1); + if (objPtr->bytes == NULL) return NULL; + if (bytes) { + // Copy + memcpy(objPtr->bytes, bytes, numBytes); + objPtr->length = (int)numBytes; + } + } else { + //TclInitStringRep(objPtr, NULL, 0); + objPtr->bytes = ""; + objPtr->length = 0; + } + } else { + objPtr->bytes = (char*)ckrealloc(objPtr->bytes, numBytes + 1); + objPtr->length = (int)numBytes; + } + + // Terminate + objPtr->bytes[objPtr->length] = '\0'; + + return objPtr->bytes; +} +#endif*/ + +#endif // TIP445_SHIM + +#endif // _TI445_H diff --git a/generic/tip445.h b/generic/tip445.h deleted file mode 120000 index a53b808..0000000 --- a/generic/tip445.h +++ /dev/null @@ -1 +0,0 @@ -../teabase/tip445.h \ No newline at end of file diff --git a/pkgIndex.tcl.in b/pkgIndex.tcl.in index 5256f0e..037fda5 100644 --- a/pkgIndex.tcl.in +++ b/pkgIndex.tcl.in @@ -6,3 +6,4 @@ package ifneeded @PACKAGE_NAME@ @PACKAGE_VERSION@ [list apply { load [file join $dir @PKG_LIB_FILE@] @PACKAGE_NAME@ } } $dir] +interp alias {} rljson {} rl_json::json diff --git a/teabase b/teabase index b58eac6..b293fee 160000 --- a/teabase +++ b/teabase @@ -1 +1 @@ -Subproject commit b58eac68cc3d07c4f3155a3d390e31fc29fb255b +Subproject commit b293fee95e97cbe6ce1583807e4d2aed8404e2e3 diff --git a/tests/autoarray.test b/tests/autoarray.test new file mode 100644 index 0000000..b85aee0 --- /dev/null +++ b/tests/autoarray.test @@ -0,0 +1,322 @@ +if {"::tcltest" ni [namespace children]} { + package require tcltest + namespace import ::tcltest::* +} + +package require rl_json +namespace import ::rl_json::* + +source [file join [file dirname [info script]] helpers.tcl] + +# Basic functionality tests +test autoarray-1.1 {Empty autoarray} -body { #<<< + json autoarray +} -result {[]} +#>>> +test autoarray-1.2 {Single string} -body { #<<< + json autoarray "hello" +} -result {["hello"]} +#>>> +test autoarray-1.3 {Single number - integer} -body { #<<< + json autoarray 42 +} -result {[42]} +#>>> +test autoarray-1.4 {Single number - float} -body { #<<< + json autoarray 3.14 +} -result {[3.14]} +#>>> +test autoarray-1.5 {Single boolean - true} -body { #<<< + json autoarray true +} -result {[true]} +#>>> +test autoarray-1.6 {Single boolean - false} -body { #<<< + json autoarray false +} -result {[false]} +#>>> + +# Mixed type arrays +test autoarray-2.1 {Mixed types - numbers and strings} -body { #<<< + json autoarray 1 "hello" 2 "world" +} -result {[1,"hello",2,"world"]} +#>>> +test autoarray-2.2 {Mixed types - all types} -body { #<<< + json autoarray 42 "hello" true 3.14 false "world" +} -result {[42,"hello",true,3.14,false,"world"]} +#>>> +test autoarray-2.3 {Mixed types with spaces in strings} -body { #<<< + json autoarray 1 "hello world" 2 "foo bar" +} -result {[1,"hello world",2,"foo bar"]} +#>>> + +# Number format tests +test autoarray-3.1 {Negative integer} -body { #<<< + json autoarray -42 +} -result {[-42]} +#>>> +test autoarray-3.2 {Negative float} -body { #<<< + json autoarray -3.14 +} -result {[-3.14]} +#>>> +test autoarray-3.3 {Zero} -body { #<<< + json autoarray 0 +} -result {[0]} +#>>> +test autoarray-3.4 {Scientific notation - positive exponent} -body { #<<< + json autoarray 1.5e10 +} -result {[15000000000.0]} +#>>> +test autoarray-3.5 {Scientific notation - negative exponent} -body { #<<< + json autoarray 1.5e-10 +} -result {[1.5e-10]} +#>>> +test autoarray-3.6 {Large integer} -body { #<<< + json autoarray 9223372036854775807 +} -result {[9223372036854775807]} +#>>> +test autoarray-3.7 {Very small float} -body { #<<< + json autoarray 0.000001 +} -result {[1e-6]} +#>>> + +# Boolean case sensitivity tests +test autoarray-4.1 {Boolean false case - True (not a boolean)} -body { #<<< + json autoarray True +} -result {["True"]} +#>>> +test autoarray-4.2 {Boolean false case - TRUE (not a boolean)} -body { #<<< + json autoarray TRUE +} -result {["TRUE"]} +#>>> +test autoarray-4.3 {Boolean false case - False (not a boolean)} -body { #<<< + json autoarray False +} -result {["False"]} +#>>> +test autoarray-4.4 {Boolean false case - FALSE (not a boolean)} -body { #<<< + json autoarray FALSE +} -result {["FALSE"]} +#>>> +test autoarray-4.5 {Exact boolean - true} -body { #<<< + json autoarray true +} -result {[true]} +#>>> +test autoarray-4.6 {Exact boolean - false} -body { #<<< + json autoarray false +} -result {[false]} +#>>> + +# Edge cases for numbers in different formats (Tcl interprets these) +test autoarray-5.1 {Octal number with leading zeros} -body { #<<< + json autoarray 007 +} -result {[7]} +#>>> +test autoarray-5.2 {Number with plus sign} -body { #<<< + json autoarray +42 +} -result {[42]} +#>>> +test autoarray-5.3 {Hex number format} -body { #<<< + json autoarray 0x1F +} -result {[31]} +#>>> +test autoarray-5.4 {Octal number format} -body { #<<< + json autoarray 0o17 +} -result {[15]} +#>>> +test autoarray-5.5 {Binary number format} -body { #<<< + json autoarray 0b1010 +} -result {[10]} +#>>> + +# Empty and whitespace strings +test autoarray-6.1 {Empty string} -body { #<<< + json autoarray "" +} -result {[""]} +#>>> +test autoarray-6.2 {String with only spaces} -body { #<<< + json autoarray " " +} -result {[" "]} +#>>> +test autoarray-6.3 {String "true" with spaces} -body { #<<< + json autoarray " true" +} -result {[" true"]} +#>>> +test autoarray-6.4 {String "false" with spaces} -body { #<<< + json autoarray "false " +} -result {["false "]} +#>>> + +# Special string values +test autoarray-7.1 {String "null"} -body { #<<< + json autoarray null +} -result {["null"]} +#>>> +test autoarray-7.2 {String "undefined"} -body { #<<< + json autoarray undefined +} -result {["undefined"]} +#>>> +test autoarray-7.3 {String that looks like object} -body { #<<< + json autoarray {{}} +} -result {["{}"]} +#>>> +test autoarray-7.4 {String that looks like array} -body { #<<< + json autoarray "[]" +} -result {[""]} +#>>> + +# Multiple identical values +test autoarray-8.1 {Multiple true values} -body { #<<< + json autoarray true true true +} -result {[true,true,true]} +#>>> +test autoarray-8.2 {Multiple false values} -body { #<<< + json autoarray false false false +} -result {[false,false,false]} +#>>> +test autoarray-8.3 {Multiple same numbers} -body { #<<< + json autoarray 42 42 42 +} -result {[42,42,42]} +#>>> +test autoarray-8.4 {Multiple same strings} -body { #<<< + json autoarray "test" "test" "test" +} -result {["test","test","test"]} +#>>> + +# Real-world usage examples +test autoarray-9.1 {Array of coordinates} -body { #<<< + json autoarray 10.5 20.3 30.1 40.9 +} -result {[10.5,20.3,30.1,40.9]} +#>>> +test autoarray-9.2 {Array of names} -body { #<<< + json autoarray "Alice" "Bob" "Charlie" +} -result {["Alice","Bob","Charlie"]} +#>>> +test autoarray-9.3 {Array of flags} -body { #<<< + json autoarray true false true true false +} -result {[true,false,true,true,false]} +#>>> +test autoarray-9.4 {Mixed data record} -body { #<<< + json autoarray "John Doe" 30 true "john@example.com" 5.5 +} -result {["John Doe",30,true,"john@example.com",5.5]} +#>>> + +# Comparison with json array command +test autoarray-10.1 {Compare autoarray vs array - strings} -body { #<<< + set auto [json autoarray "hello" "world"] + set manual [json array {string hello} {string world}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoarray-10.2 {Compare autoarray vs array - numbers} -body { #<<< + set auto [json autoarray 1 2 3] + set manual [json array {number 1} {number 2} {number 3}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoarray-10.3 {Compare autoarray vs array - booleans} -body { #<<< + set auto [json autoarray true false] + set manual [json array {boolean true} {boolean false}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoarray-10.4 {Compare autoarray vs array - mixed} -body { #<<< + set auto [json autoarray 42 "hello" true 3.14] + set manual [json array {number 42} {string hello} {boolean true} {number 3.14}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> + +# Type preservation after parsing +test autoarray-11.1 {Number type preserved} -body { #<<< + set arr [json autoarray 42] + json get $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {42} +#>>> +test autoarray-11.2 {String type preserved} -body { #<<< + set arr [json autoarray "hello"] + json get $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {hello} +#>>> +test autoarray-11.3 {Boolean type preserved} -body { #<<< + set arr [json autoarray true] + json get $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {true} +#>>> +test autoarray-11.4 {Type query for number} -body { #<<< + set arr [json autoarray 42] + json type $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {number} +#>>> +test autoarray-11.5 {Type query for string} -body { #<<< + set arr [json autoarray "hello"] + json type $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {string} +#>>> +test autoarray-11.6 {Type query for boolean} -body { #<<< + set arr [json autoarray true] + json type $arr 0 +} -cleanup { + unset -nocomplain arr +} -result {boolean} +#>>> + +# String escaping +test autoarray-12.1 {String with quotes} -body { #<<< + json autoarray {He said "hello"} +} -result {["He said \"hello\""]} +#>>> +test autoarray-12.2 {String with backslashes} -body { #<<< + json autoarray {C:\path\to\file} +} -result {["C:\\path\\to\\file"]} +#>>> +test autoarray-12.3 {String with newline} -body { #<<< + json autoarray "line1\nline2" +} -result {["line1\nline2"]} +#>>> +test autoarray-12.4 {String with tab} -body { #<<< + json autoarray "col1\tcol2" +} -result {["col1\tcol2"]} +#>>> + +# Large arrays +test autoarray-13.1 {Array with 100 numbers} -body { #<<< + set nums [lmap i [lrepeat 100 0] {expr {int(rand() * 1000)}}] + set result [json autoarray {*}$nums] + json length $result +} -cleanup { + unset -nocomplain nums result i +} -result {100} +#>>> +test autoarray-13.2 {Array with 50 strings} -body { #<<< + set strings [lmap i [lrepeat 50 0] {format "string_%d" $i}] + set result [json autoarray {*}$strings] + json length $result +} -cleanup { + unset -nocomplain strings result i +} -result {50} +#>>> + +::tcltest::cleanupTests +return + +# Local Variables: +# mode: tcl +# tab-width: 4 +# End: +# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4 diff --git a/tests/autoobject.test b/tests/autoobject.test new file mode 100644 index 0000000..98aa274 --- /dev/null +++ b/tests/autoobject.test @@ -0,0 +1,257 @@ +if {"::tcltest" ni [namespace children]} { + package require tcltest + namespace import ::tcltest::* +} + +package require rl_json +namespace import ::rl_json::* + +source [file join [file dirname [info script]] helpers.tcl] + +# Basic functionality tests +test autoobject-1.1 {Empty autoobject} -body { #<<< + json autoobject +} -result {{}} +#>>> +test autoobject-1.2 {Single key-value pair - string} -body { #<<< + json autoobject name "Alice" +} -result {{"name":"Alice"}} +#>>> +test autoobject-1.3 {Single key-value pair - number} -body { #<<< + json autoobject age 30 +} -result {{"age":30}} +#>>> +test autoobject-1.4 {Single key-value pair - boolean true} -body { #<<< + json autoobject active true +} -result {{"active":true}} +#>>> +test autoobject-1.5 {Single key-value pair - boolean false} -body { #<<< + json autoobject enabled false +} -result {{"enabled":false}} +#>>> +test autoobject-1.6 {Multiple key-value pairs - mixed types} -body { #<<< + json autoobject name "Bob" age 25 active true score 95.5 +} -result {{"name":"Bob","age":25,"active":true,"score":95.5}} +#>>> + +# Argument validation tests +test autoobject-2.1 {Odd number of arguments - single arg} -body { #<<< + json autoobject key +} -returnCodes error -match glob -result {wrong # args: should be "json autoobject ?key value ...?"} +#>>> +test autoobject-2.2 {Odd number of arguments - three args} -body { #<<< + json autoobject key1 value1 key2 +} -returnCodes error -match glob -result {wrong # args: should be "json autoobject ?key value ...?"} +#>>> +test autoobject-2.3 {Odd number of arguments - five args} -body { #<<< + json autoobject a 1 b 2 c +} -returnCodes error -match glob -result {wrong # args: should be "json autoobject ?key value ...?"} +#>>> + +# Value type detection tests +test autoobject-3.1 {String values} -body { #<<< + json autoobject key1 "hello" key2 "world" +} -result {{"key1":"hello","key2":"world"}} +#>>> +test autoobject-3.2 {Integer values} -body { #<<< + json autoobject a 1 b 42 c -100 +} -result {{"a":1,"b":42,"c":-100}} +#>>> +test autoobject-3.3 {Float values} -body { #<<< + json autoobject pi 3.14159 e 2.71828 +} -result {{"pi":3.14159,"e":2.71828}} +#>>> +test autoobject-3.4 {Scientific notation} -body { #<<< + set obj [json autoobject large 1.5e10 small 1.5e-10] + # Verify both values are correct numerically (format may vary) + expr {[json get $obj large] == 1.5e10 && [json get $obj small] == 1.5e-10} +} -result {1} +#>>> +test autoobject-3.5 {Boolean true (exact match)} -body { #<<< + json autoobject flag true +} -result {{"flag":true}} +#>>> +test autoobject-3.6 {Boolean false (exact match)} -body { #<<< + json autoobject flag false +} -result {{"flag":false}} +#>>> +test autoobject-3.7 {Boolean case sensitivity - True is a string} -body { #<<< + json autoobject flag True +} -result {{"flag":"True"}} +#>>> +test autoobject-3.8 {Boolean case sensitivity - TRUE is a string} -body { #<<< + json autoobject flag TRUE +} -result {{"flag":"TRUE"}} +#>>> +test autoobject-3.9 {Boolean case sensitivity - False is a string} -body { #<<< + json autoobject flag False +} -result {{"flag":"False"}} +#>>> +test autoobject-3.10 {Boolean case sensitivity - FALSE is a string} -body { #<<< + json autoobject flag FALSE +} -result {{"flag":"FALSE"}} +#>>> + +# Key handling tests +test autoobject-4.1 {String keys} -body { #<<< + json autoobject name "Alice" city "Paris" +} -result {{"name":"Alice","city":"Paris"}} +#>>> +test autoobject-4.2 {Numeric-looking keys are strings} -body { #<<< + json autoobject 123 "value1" 456 "value2" +} -result {{"123":"value1","456":"value2"}} +#>>> +test autoobject-4.3 {Empty string key} -body { #<<< + json autoobject "" "empty key" +} -result {{"":"empty key"}} +#>>> +test autoobject-4.4 {Duplicate keys - last value wins} -body { #<<< + json autoobject name "Alice" age 25 name "Bob" +} -result {{"name":"Bob","age":25}} +#>>> +test autoobject-4.5 {Keys with special characters} -body { #<<< + json autoobject "first-name" "Alice" "last.name" "Smith" "user@email" "test" +} -result {{"first-name":"Alice","last.name":"Smith","user@email":"test"}} +#>>> +test autoobject-4.6 {Keys with spaces} -body { #<<< + json autoobject "full name" "Alice Smith" +} -result {{"full name":"Alice Smith"}} +#>>> + +# Mixed type tests +test autoobject-5.1 {Mixed strings, numbers, booleans} -body { #<<< + json autoobject name "Alice" age 30 active true score 95.5 city "Paris" verified false count 10 +} -result {{"name":"Alice","age":30,"active":true,"score":95.5,"city":"Paris","verified":false,"count":10}} +#>>> +test autoobject-5.2 {Complex strings with whitespace} -body { #<<< + json autoobject text " leading and trailing " multiline "line1\nline2" +} -result {{"text":" leading and trailing ","multiline":"line1\nline2"}} +#>>> +test autoobject-5.3 {Special JSON-like strings (not parsed)} -body { #<<< + json autoobject null_str "null" array_str "[]" object_str "{}" + # Note: "[]" converts to empty string when passed through json string +} -result {{"null_str":"null","array_str":"","object_str":"{}"}} +#>>> + +# Equivalence tests +test autoobject-6.1 {Compare autoobject vs manual object - strings} -body { #<<< + set auto [json autoobject name "Alice" city "Paris"] + set manual [json object name {string "Alice"} city {string "Paris"}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoobject-6.2 {Compare autoobject vs manual object - numbers} -body { #<<< + set auto [json autoobject age 30 score 95.5] + set manual [json object age {number 30} score {number 95.5}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoobject-6.3 {Compare autoobject vs manual object - booleans} -body { #<<< + set auto [json autoobject active true verified false] + set manual [json object active {boolean true} verified {boolean false}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> +test autoobject-6.4 {Compare autoobject vs manual object - mixed} -body { #<<< + set auto [json autoobject name "Bob" age 25 active true] + set manual [json object name {string "Bob"} age {number 25} active {boolean true}] + expr {$auto eq $manual} +} -cleanup { + unset -nocomplain auto manual +} -result {1} +#>>> + +# Edge cases +test autoobject-7.1 {Empty string value} -body { #<<< + json autoobject key "" +} -result {{"key":""}} +#>>> +test autoobject-7.2 {Whitespace-only value} -body { #<<< + json autoobject key " " +} -result {{"key":" "}} +#>>> +test autoobject-7.3 {Zero value} -body { #<<< + json autoobject count 0 score 0.0 +} -result {{"count":0,"score":0.0}} +#>>> +test autoobject-7.4 {Negative numbers} -body { #<<< + set obj [json autoobject temp -5 balance -100.50] + # Verify values are correct (trailing zeros may be normalized) + expr {[json get $obj temp] == -5 && [json get $obj balance] == -100.50} +} -result {1} +#>>> +test autoobject-7.5 {Values with quotes} -body { #<<< + json autoobject quote "He said \"hello\"" +} -result {{"quote":"He said \"hello\""}} +#>>> +test autoobject-7.6 {Values with backslashes} -body { #<<< + json autoobject path "C:\\Windows\\System32" +} -result {{"path":"C:\\Windows\\System32"}} +#>>> +test autoobject-7.7 {Tab and newline characters} -body { #<<< + json autoobject tab "a\tb" newline "x\ny" +} -result {{"tab":"a\tb","newline":"x\ny"}} +#>>> + +# Tcl number format handling (should convert to JSON numbers) +test autoobject-8.1 {Octal format converts to decimal} -body { #<<< + json autoobject val 007 +} -result {{"val":7}} +#>>> +test autoobject-8.2 {Hex format converts to decimal} -body { #<<< + json autoobject val 0x1F +} -result {{"val":31}} +#>>> +test autoobject-8.3 {Binary format converts to decimal} -body { #<<< + json autoobject val 0b1010 +} -result {{"val":10}} +#>>> + +# Type verification +test autoobject-9.1 {Result is JSON object type} -body { #<<< + json type [json autoobject name "Alice"] +} -result {object} +#>>> +test autoobject-10.2 {Empty result is JSON object type} -body { #<<< + json type [json autoobject] +} -result {object} +#>>> + +# Key extraction +test autoobject-11.1 {Extract value by key} -body { #<<< + set obj [json autoobject name "Alice" age 30] + json get $obj name +} -cleanup { + unset -nocomplain obj +} -result {Alice} +#>>> +test autoobject-11.2 {Get all keys} -body { #<<< + set obj [json autoobject name "Alice" age 30 active true] + lsort [json get $obj ?keys] +} -cleanup { + unset -nocomplain obj +} -result {active age name} +#>>> + +# Large object +test autoobject-12.1 {Large object with many keys} -body { #<<< + set pairs {} + for {set i 0} {$i < 50} {incr i} { + lappend pairs "key$i" $i + } + set obj [json autoobject {*}$pairs] + json get $obj ?size +} -cleanup { + unset -nocomplain pairs obj i +} -result {50} +#>>> + +cleanupTests + +# vim: ft=tcl foldmethod=marker foldmarker=<<<,>>> ts=4 shiftwidth=4 diff --git a/tests/helpers.tcl b/tests/helpers.tcl index 13ae0cb..d5ce82e 100644 --- a/tests/helpers.tcl +++ b/tests/helpers.tcl @@ -154,19 +154,14 @@ proc _compare_json {opts j1 j2 {path {}}} { #<<< #>>> proc compare_json args { #<<< - parse_args $args { - -subset {-default none} - j1 {} - j2 {} - } opts - - try { - _compare_json $opts [dict get $opts j1] [dict get $opts j2] - } trap {RL TEST JSON_MISMATCH} {errmsg options} { - return $errmsg - } on ok {} { - return match - } + set opts [list -subset none j1 [lindex $args 0] j2 [lindex $args 1]] + try { + _compare_json $opts [dict get $opts j1] [dict get $opts j2] + } trap {RL TEST JSON_MISMATCH} {errmsg options} { + return $errmsg + } on ok {} { + return match + } } #>>> diff --git a/tests/misc.test b/tests/misc.test index ecddb1f..1e7f0d8 100644 --- a/tests/misc.test +++ b/tests/misc.test @@ -42,23 +42,43 @@ test misc-2.6 {isnull, path, out of array bounds} -body { #<<< json isnull {["a",null,"c"]} -1 } -result 1 #>>> -test misc-3.1 {interp free} -body { #<<< +if {[string match "9.*" $tcl_version]} { + test misc-3.1 {interp free} -body { #<<< + set slave [interp create] + $slave eval {load {} rl_json; rl_json::json get {["hello","slave"]}} + } -cleanup { + interp delete $slave + unset -nocomplain slave + } -result {hello slave} + #>>> + test misc-3.2 {interp free, safe interp} -body { #<<< + set slave [interp create -safe] + $slave invokehidden load {} rl_json + $slave eval {rl_json::json get {["hello","slave"]}} + } -cleanup { + interp delete $slave + unset -nocomplain slave + } -result {hello slave} + #>>> +} else { + test misc-3.1 {interp free} -body { #<<< set slave [interp create] $slave eval {load {} Rl_json; rl_json::json get {["hello","slave"]}} -} -cleanup { + } -cleanup { interp delete $slave unset -nocomplain slave -} -result {hello slave} -#>>> -test misc-3.2 {interp free, safe interp} -body { #<<< + } -result {hello slave} + #>>> + test misc-3.2 {interp free, safe interp} -body { #<<< set slave [interp create -safe] $slave invokehidden load {} Rl_json $slave eval {rl_json::json get {["hello","slave"]}} -} -cleanup { + } -cleanup { interp delete $slave unset -nocomplain slave -} -result {hello slave} -#>>> + } -result {hello slave} + #>>> +} ::tcltest::cleanupTests return diff --git a/tests/number.test b/tests/number.test index f5da302..9a522e4 100644 --- a/tests/number.test +++ b/tests/number.test @@ -76,22 +76,41 @@ test number-1.13 {string} -body { #<<< json number [string cat 4 2] } -result 42 #>>> -test number-1.14.1 {positive octal} -body { #<<< +if {[string match "9.*" $tcl_version]} { + test number-1.14.1 {positive octal} -body { #<<< set n 077 expr {$n+0} ;# Convert to number type list [json number $n] $n -} -cleanup { + } -cleanup { unset -nocomplain n -} -result {63 077} -#>>> -test number-1.14.2 {negative octal} -body { #<<< + } -result {77 077} + #>>> + test number-1.14.2 {negative octal} -body { #<<< set n -077 expr {$n+0} ;# Convert to number type list [json number $n] $n -} -cleanup { + } -cleanup { unset -nocomplain n -} -result {-63 -077} -#>>> + } -result {-77 -077} + #>>> +} else { + test number-1.14.1 {positive octal} -body { #<<< + set n 077 + expr {$n+0} ;# Convert to number type + list [json number $n] $n + } -cleanup { + unset -nocomplain n + } -result {63 077} + #>>> + test number-1.14.2 {negative octal} -body { #<<< + set n -077 + expr {$n+0} ;# Convert to number type + list [json number $n] $n + } -cleanup { + unset -nocomplain n + } -result {-63 -077} + #>>> +} test number-1.15.1 {positive hex} -body { #<<< set n 0xA0 expr {$n+0} ;# Convert to number type @@ -234,19 +253,35 @@ test number-2.2 {Too many args} -body { #<<< list $code $r [dict get $o -errorcode] } -result {1 {wrong # args: should be "*number value"} {TCL WRONGARGS}} -match glob #>>> -test number-2.3 {json number, not a number} -body { #<<< - set code [catch {json number foo} r o] - list $code [regexp {^can't use non-numeric string( "foo")? as operand of "\+"$} $r] [dict get $o -errorcode] -} -cleanup { - unset -nocomplain code r o -} -match regexp -result {1 1 {ARITH DOMAIN {non-numeric string}}} -#>>> -test number-2.4 {json number, not a number: empty string} -body { #<<< - set code [catch {json number ""} r o] - list $code [regexp {^can't use empty string( "")? as operand of "\+"$} $r] [dict get $o -errorcode] -} -cleanup { - unset -nocomplain code r o -} -match regexp -result {1 1 {ARITH DOMAIN {empty string}}} +if {[string match "9.*" $tcl_version]} { + test number-2.3 {json number, not a number} -body { #<<< + set code [catch {json number foo} r o] + list $code [regexp {^cannot use non-numeric string "foo" as right operand of "\+"$} $r] [dict get $o -errorcode] + } -cleanup { + unset -nocomplain code r o + } -match regexp -result {1 1 {ARITH DOMAIN {non-numeric string}}} + #>>> + test number-2.4 {json number, not a number: empty string} -body { #<<< + set code [catch {json number ""} r o] + list $code [regexp {^cannot use non-numeric string "" as right operand of "\+"$} $r] [dict get $o -errorcode] + } -cleanup { + unset -nocomplain code r o + } -match regexp -result {1 1 {ARITH DOMAIN {non-numeric string}}} +} else { + test number-2.3 {json number, not a number} -body { #<<< + set code [catch {json number foo} r o] + list $code [regexp {^cannot use non-numeric string( "foo")? as operand of "\+"$} $r] [dict get $o -errorcode] + } -cleanup { + unset -nocomplain code r o + } -match regexp -result {1 1 {ARITH DOMAIN {non-numeric string}}} + #>>> + test number-2.4 {json number, not a number: empty string} -body { #<<< + set code [catch {json number ""} r o] + list $code [regexp {^can't use empty string( "")? as operand of "\+"$} $r] [dict get $o -errorcode] + } -cleanup { + unset -nocomplain code r o + } -match regexp -result {1 1 {ARITH DOMAIN {empty string}}} +} #>>> ::tcltest::cleanupTests diff --git a/tests/pretty.test b/tests/pretty.test index 1bd6e51..6c16931 100644 --- a/tests/pretty.test +++ b/tests/pretty.test @@ -4,10 +4,11 @@ if {"::tcltest" ni [namespace children]} { } package require rl_json -package require parse_args -namespace path {::rl_json ::parse_args} +namespace path {::rl_json} -test pretty-1.1 {Basic pretty-print} -body { #<<< +test pretty-jsonPretty-1.1 {} -body {json pretty -indent} -returnCodes error -result {missing argument to "-indent"} -errorCode {TCL ARGUMENT MISSING} +#>>> +test pretty-1.2 {Basic pretty-print} -body { #<<< json pretty {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null,{"inner": "obj"}]}} } -cleanup { unset -nocomplain o @@ -29,7 +30,7 @@ test pretty-1.1 {Basic pretty-print} -body { #<<< ] }} #>>> -test pretty-1.2 {Basic pretty-print, different indent} -body { #<<< +test pretty-1.3 {Basic pretty-print, different indent} -body { #<<< json pretty -indent " " {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null,{"inner": "obj"}]}} } -result {{ "foo": null, @@ -49,11 +50,32 @@ test pretty-1.2 {Basic pretty-print, different indent} -body { #<<< ] }} #>>> -test pretty-2.1 {too few args} -body { #<<< +test pretty-1.4 {Basic pretty-print, nopadding} -body { #<<< + json pretty -indent " " -nopadding {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null]}} +} -result {{ + "foo": null, + "empty": {}, + "emptyarr": [], + "hello, world": "bar", + "This is a much longer key": [ + "str", + 123, + 123.4, + true, + false, + null + ] +}} +#>>> +test pretty-jsonPretty-2.1 {} -body {json pretty -- 1} -result 1 +#>>> +test pretty-2.2 {too few args} -body { #<<< json pretty -} -returnCodes error -result {wrong # args: should be "pretty pretty ?-indent indent? json_val ?key ...?"} +} -returnCodes error -result {wrong # args: should be "pretty pretty ?-indent indent? ?-compact? ?-nopadding? ?-arrays inline|multiline? json_val ?key ...?"} #>>> -test pretty-3.1 {path} -body { #<<< +test pretty-jsonPretty-3.1 {} -body {json pretty -indent { }} -returnCodes error -result {wrong # args: should be "pretty ?-indent indent? ?-compact? ?-nopadding? ?-arrays inline|multiline? json_val ?key ...?"} -errorCode {TCL WRONGARGS} +#>>> +test pretty-3.2 {path} -body { #<<< json pretty {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null,{"inner": "obj"}]}} {This is a much longer key} } -result {[ "str", @@ -67,11 +89,220 @@ test pretty-3.1 {path} -body { #<<< } ]} #>>> -test pretty-3.2 {bad path} -body { #<<< +test pretty-3.3 {bad path} -body { #<<< json pretty {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null,{"inner": "obj"}]}} bad } -returnCodes error -result {Path element 2: "bad" not found} -errorCode NONE #>>> - +test pretty-jsonPretty-4.1 {} -body {json pretty bad} -returnCodes error -result {Error parsing JSON value: Illegal character at offset 0} -errorCode {RL JSON PARSE {Illegal character} bad 0} +#>>> +test pretty-4.2 {compact output} -body { + json pretty -compact {{"foo":"bar","array":[1,2,3]}} +} -result {{"foo":"bar","array":[1,2,3]}} +#>>> +test pretty-jsonPretty-5.1 {} -body {json pretty -bad} -returnCodes error -result {bad option "-bad": must be *} -errorCode {TCL LOOKUP INDEX option -bad} -match glob +#>>> +test pretty-5.2 {arrays inline mode} -body { + json pretty -arrays inline {{"arr":[1,2,3,4,5]}} +} -result {{ + "arr": [1,2,3,4,5] +}} +#>>> +test pretty-5.3 {arrays multiline mode} -body { + json pretty -arrays multiline {{"arr":[1,2,3]}} +} -result {{ + "arr": [ + 1, + 2, + 3 + ] +}} +#>>> +test pretty-5.4 {arrays default auto mode - small inline} -body { + json pretty {{"small":[1,2,3]}} +} -result {{ + "small": [1,2,3] +}} +#>>> +test pretty-5.5 {arrays default auto mode - large multiline} -body { + json pretty {{"large":[1,2,3,4,5]}} +} -result {{ + "large": [ + 1, + 2, + 3, + 4, + 5 + ] +}} +#>>> +test pretty-6.1 {combine -indent with -arrays inline} -body { + json pretty -indent " " -arrays inline {{"arr":[1,2,3,4,5]}} +} -result {{ + "arr": [1,2,3,4,5] +}} +#>>> +test pretty-6.2 {combine -indent with -arrays multiline} -body { + json pretty -indent " " -arrays multiline {{"arr":[1,2,3]}} +} -result {{ + "arr": [ + 1, + 2, + 3 + ] +}} +#>>> +test pretty-6.3 {tab indent with arrays inline} -body { + json pretty -indent "\t" -arrays inline {{"data":[10,20,30]}} +} -result {{ + "data": [10,20,30] +}} +#>>> +test pretty-6.4 {tab indent with arrays multiline} -body { + json pretty -indent "\t" -arrays multiline {{"data":[10,20]}} +} -result {{ + "data": [ + 10, + 20 + ] +}} +#>>> +test pretty-7.1 {compact overrides indent} -body { + json pretty -compact -indent " " {{"foo":"bar"}} +} -result {{"foo":"bar"}} +#>>> +test pretty-7.2 {compact overrides arrays inline} -body { + json pretty -compact -arrays inline {{"arr":[1,2,3]}} +} -result {{"arr":[1,2,3]}} +#>>> +test pretty-7.3 {compact overrides arrays multiline} -body { + json pretty -compact -arrays multiline {{"arr":[1,2,3,4,5]}} +} -result {{"arr":[1,2,3,4,5]}} +#>>> +test pretty-7.4 {compact with all options} -body { + json pretty -compact -indent "\t" -arrays multiline {{"x":[1,2],"y":{"z":"w"}}} +} -result {{"x":[1,2],"y":{"z":"w"}}} +#>>> +test pretty-8.1 {nested objects with custom indent} -body { + json pretty -indent " " {{"outer":{"inner":{"deep":"value"}}}} +} -result {{ + "outer": { + "inner": { + "deep": "value" + } + } +}} +#>>> +test pretty-8.2 {nested arrays with multiline} -body { + json pretty -arrays multiline {{"matrix":[[1,2],[3,4]]}} +} -result {{ + "matrix": [ + [ + 1, + 2 + ], + [ + 3, + 4 + ] + ] +}} +#>>> +test pretty-8.3 {nested arrays with inline} -body { + json pretty -arrays inline {{"matrix":[[1,2],[3,4]]}} +} -result {{ + "matrix": [[1,2],[3,4]] +}} +#>>> +test pretty-8.4 {mixed nested structures} -body { + json pretty -indent " " {{"users":[{"name":"Alice","age":30},{"name":"Bob","age":25}]}} +} -result {{ + "users": [{ + "name": "Alice", + "age": 30 + },{ + "name": "Bob", + "age": 25 + }] +}} +#>>> +test pretty-9.1 {empty array with default} -body { + json pretty {{"empty":[]}} +} -result {{ + "empty": [] +}} +#>>> +test pretty-9.2 {empty array with arrays inline} -body { + json pretty -arrays inline {{"empty":[]}} +} -result {{ + "empty": [] +}} +#>>> +test pretty-9.3 {empty array with arrays multiline} -body { + json pretty -arrays multiline {{"empty":[]}} +} -result {{ + "empty": [] +}} +#>>> +test pretty-9.4 {empty object} -body { + json pretty {{"empty":{}}} +} -result {{ + "empty": {} +}} +#>>> +test pretty-10.1 {complex structure default formatting} -body { + json pretty {{"api":{"version":"1.0","endpoints":["/user","/data","/login","/logout"]}}} +} -result {{ + "api": { + "version": "1.0", + "endpoints": [ + "/user", + "/data", + "/login", + "/logout" + ] + } +}} +#>>> +test pretty-10.2 {complex structure with indent and inline arrays} -body { + json pretty -indent "\t" -arrays inline {{"config":{"debug":true,"ports":[8080,8081,8082],"name":"server"}}} +} -result {{ + "config": { + "debug": true, + "ports": [8080,8081,8082], + "name": "server" + } +}} +#>>> +test pretty-10.3 {multiple data types} -body { + json pretty {{"string":"text","number":42,"bool":true,"null":null,"array":[1,2]}} +} -result {{ + "string": "text", + "number": 42, + "bool": true, + "null": null, + "array": [1,2] +}} +#>>> +test pretty-11.1 {single space indent} -body { + json pretty -indent " " {{"a":"b"}} +} -result {{ + "a": "b" +}} +#>>> +test pretty-11.2 {large indent} -body { + json pretty -indent " " {{"x":"y"}} +} -result {{ + "x": "y" +}} +#>>> +test pretty-11.3 {three space indent with nested} -body { + json pretty -indent " " {{"outer":{"inner":"val"}}} +} -result {{ + "outer": { + "inner": "val" + } +}} +#>>> test debug-1.1 {Basic debug pretty-print} -body { #<<< json debug {{"foo":null,"empty":{},"emptyarr":[],"hello, world":"bar","This is a much longer key":["str",123,123.4,true,false,null,{"inner": "obj"}]}} } -match regexp -result {^\(0x[0-9a-fA-F]+\[[0-9]+\]+/0x[0-9a-fA-F]+\[[0-9]+\]+ [a-z ]+\){ @@ -91,14 +322,6 @@ test debug-1.1 {Basic debug pretty-print} -body { #<<< } \] }$} -#>>> - -# Coverage golf -test pretty-jsonPretty-1.1 {} -body {json pretty -indent} -returnCodes error -result {missing argument to "-indent"} -errorCode {TCL ARGUMENT MISSING} -test pretty-jsonPretty-2.1 {} -body {json pretty -- 1} -result 1 -test pretty-jsonPretty-3.1 {} -body {json pretty -indent { }} -returnCodes error -result {wrong # args: should be "pretty ?-default defaultValue? json_val ?key ...?"} -errorCode {TCL WRONGARGS} -test pretty-jsonPretty-4.1 {} -body {json pretty bad} -returnCodes error -result {Error parsing JSON value: Illegal character at offset 0} -errorCode {RL JSON PARSE {Illegal character} bad 0} -test pretty-jsonPretty-5.1 {} -body {json pretty -bad} -returnCodes error -result {bad option "-bad": must be *} -errorCode {TCL LOOKUP INDEX option -bad} -match glob json free_cache diff --git a/tests/set.test b/tests/set.test index ce5d737..8da79bb 100644 --- a/tests/set.test +++ b/tests/set.test @@ -4,8 +4,7 @@ if {"::tcltest" ni [namespace children]} { } package require rl_json -package require parse_args -namespace path {::rl_json ::parse_args} +namespace path {::rl_json} source [file join [file dirname [info script]] helpers.tcl] diff --git a/tests/unset.test b/tests/unset.test index 1f0dc34..beb76d9 100644 --- a/tests/unset.test +++ b/tests/unset.test @@ -4,8 +4,7 @@ if {"::tcltest" ni [namespace children]} { } package require rl_json -package require parse_args -namespace path {::rl_json ::parse_args} +namespace path {::rl_json} source [file join [file dirname [info script]] helpers.tcl]