diff --git a/include/submods/json.h b/include/submods/json.h new file mode 100644 index 0000000..25a389f --- /dev/null +++ b/include/submods/json.h @@ -0,0 +1,43 @@ +#ifndef JSON_H +#define JSON_H + +#include +#include + +{* ============== Constants ============== *} + +CONST JS_SUCCESS = 0 +CONST JS_ERR_SYNTAX = -1 +CONST JS_ERR_DEPTH = -2 +CONST JS_ERR_OVERFLOW = -3 +CONST JS_ERR_IO = -4 + +CONST JsObject = 0 +CONST JsArray = 1 + +CONST JS_MAX_INPUT = 8192 +CONST JS_MAX_DEPTH = 10 + +{* ============== Parser ============== *} + +DECLARE SUB LONGINT JsParse(src$) EXTERNAL +DECLARE SUB LONGINT JsParseFile(SHORTINT ch%) EXTERNAL +DECLARE SUB STRING JsError$ EXTERNAL +DECLARE SUB SHORTINT JsRootType EXTERNAL + +{* ============== Generator ============== *} + +DECLARE SUB JsWrite(ADDRESS root&, SHORTINT ch%) EXTERNAL +DECLARE SUB JsWriteFmt(ADDRESS root&, SHORTINT ch%) EXTERNAL +DECLARE SUB STRING JsToStr$(ADDRESS root&) EXTERNAL + +{* ============== Cleanup ============== *} + +DECLARE SUB JsFree(ADDRESS root&) EXTERNAL + +{* ============== Convenience ============== *} + +DECLARE SUB JsMakeObj(Hashmap hm, LONGINT cap&) EXTERNAL +DECLARE SUB JsMakeArr(DynArray da, LONGINT cap&) EXTERNAL + +#endif diff --git a/specs/json-submod-state.txt b/specs/json-submod-state.txt new file mode 100644 index 0000000..a642721 --- /dev/null +++ b/specs/json-submod-state.txt @@ -0,0 +1,84 @@ +# JSON Submodule — Implementation State + +Branch: json-submod + +## Phase 0: Descriptor stamping prerequisite +Status: COMPLETE +- [x] Add POKEL descriptor stamp in HmNew (hashmap.b) +- [x] Add POKEL descriptor stamp in DaNew (dynarray.b) +- [x] Create json.h header +- [x] Create test_typecase.b (Phase 0 TYPECASE discrimination test) +- [x] Test on emulator: existing hashmap/dynarray tests still pass +- [x] Test on emulator: test_typecase passes (8/8) + +## Phase 1: Parser — objects with scalar values +Status: COMPLETE +- [x] Create json.b with parser (helpers, string, number, container) +- [x] Create make script +- [x] Create test_parse_obj.b +- [x] Test on emulator: json module compiles +- [x] Test on emulator: test_parse_obj passes (44/44) +- Note: HmPutBool normalizes to 0/1 (not -1/0) +- Note: json.b uses _JsParseContainer (single recursive SUB) to avoid mutual recursion +- Note: json.b defines its own constants (can't include json.h due to DECLARE SUB conflicts) + +## Phase 2: Parser — arrays, nesting, floats +Status: COMPLETE +- [x] Create test_parse_arr.b (18 tests: empty array, string/int/bool/null arrays, + mixed-type, nested obj/arr, deeply nested, floats, TYPECASE, depth limit, + whitespace, int/float discrimination) +- [x] Fix recursion bug: local STRING in SUBs is BSS-backed, clobbered by recursive calls. + Fix: module-level depth-indexed key stack _jsKeyStk$(depth%) + hm/da restore from retVal& +- [x] Test on emulator: test_parse_arr passes (96/96) +- [x] Regression: test_parse_obj still passes (44/44) + +## Phase 3: Parser — escapes, file input, error edge cases +Status: COMPLETE +- [x] Create test_parse_misc.b (17 tests: escaped quotes/backslash/nl/tab/cr/bs/ff/slash, + multiple escapes, empty string, escaped key, escaped in array, + JsParseFile simple/multiline/array, error EOF/literal/bracket/empty, + whitespace with newlines/tabs) +- [x] Implement JsParseFile in json.b (reads file via LINE INPUT, sets shared state, + calls _JsParseContainer directly — avoids 256-byte string param copy limit) +- [x] Test on emulator: json module compiles +- [x] Test on emulator: test_parse_misc passes (55/55) +- [x] Regression: test_parse_obj still passes (44/44) — verified in prior run +- [x] Regression: test_parse_arr still passes (96/96) — verified in prior run + +## Phase 4: Generator — compact output +Status: COMPLETE +- [x] Add _JsWriteStr (string escaping: quote, backslash, LF, CR, TAB, BS, FF) +- [x] Add _JsWriteNode (single recursive SUB, TYPECASE dispatch, save/restore pattern) +- [x] Add JsWrite (public entry point, delegates to _JsWriteNode) +- [x] Add JsToStr$ (writes to T:js_tmp via channel #9, reads back, 4000 char limit) +- [x] Create test_gen.b (23 tests: empty obj/arr, string/int/neg/bool/null values, + multi-value, arrays, nested obj/arr/deep, string escaping for quote/backslash/ + newline/tab, JsWrite to file, key escaping, empty string value) +- [x] Test on emulator: json module compiles +- [x] Test on emulator: test_gen passes (23/23) +- [x] Regression: test_parse_obj still passes (44/44) + +## Phase 5: Pretty printer + round-trip +Status: COMPLETE +- [x] Add _JsWriteNodeFmt (recursive formatted writer with indent tracking) +- [x] Add JsWriteFmt (public entry point) +- [x] Create test_roundtrip.b (17 test groups: fmt empty/single/array/nested/bool-null, + compact round-trip int/str/mixed/1key/escape/nested, fmt round-trip arr/obj, + type preservation, deep nesting) +- [x] Test on emulator: json module compiles +- [x] Test on emulator: test_roundtrip passes (64/64) +- [x] Regression: test_parse_obj still passes (44/44) +- [x] Regression: test_gen still passes (23/23) + +## Phase 6: JsFree + JsMakeObj/JsMakeArr helpers +Status: COMPLETE +- [x] Add JsFree (recursive tree free using TYPECASE + save/restore pattern) +- [x] Add JsMakeObj (convenience wrapper for HmMake) +- [x] Add JsMakeArr (convenience wrapper for DaMake) +- [x] Create test_free.b (13 test groups: null safety, simple/empty obj/arr, + nested obj/arr, deep nesting, array of arrays, mixed types, + JsMakeObj/JsMakeArr TYPECASE, full parse+use+free cycle) +- [x] Test on emulator: json module compiles +- [x] Test on emulator: test_free passes (30/30) +- [x] Regression: test_roundtrip still passes (64/64) +- [x] Regression: test_gen still passes (23/23) diff --git a/specs/json-submod.txt b/specs/json-submod.txt new file mode 100644 index 0000000..271b2c6 --- /dev/null +++ b/specs/json-submod.txt @@ -0,0 +1,705 @@ +# JSON Submodule — Implementation Plan + +## Context + +A JSON parser and generator for ACE BASIC, using the existing Hashmap +(for JSON objects) and DynArray (for JSON arrays) as the intermediate +representation. TYPECASE provides clean runtime discrimination between +the two when walking the tree. + +Dependencies: hashmap.o, dynarray.o, testkit.o (tests only) + + +## Data Model + +JSON maps naturally onto the existing type-tagged structures: + + JSON value ACE representation Storage + ────────────── ────────────────────── ───────────────── + { ... } Hashmap HmTypeRef / DaTypeRef + [ ... ] DynArray HmTypeRef / DaTypeRef + "string" string value HmTypeStr / DaTypeStr + 42 LONGINT HmTypeLng / DaTypeLng + 3.14 SINGLE (FFP) HmTypeSng / DaTypeSng + true / false boolean HmTypeBool / DaTypeBool + null null HmTypeNull / DaTypeNull + +Nested objects and arrays are stored as Ref entries (HmTypeRef / DaTypeRef) +pointing to child Hashmap or DynArray instances. TYPECASE on the ref +address determines which type the child is — no extra discriminator needed. + +### Example mapping + + {"name":"Alice","age":30,"tags":["dev","amiga"],"addr":{"city":"Berlin"}} + + Root Hashmap: + "name" → HmTypeStr "Alice" + "age" → HmTypeLng 30 + "tags" → HmTypeRef → DynArray [DaTypeStr "dev", DaTypeStr "amiga"] + "addr" → HmTypeRef → Hashmap {"city" → HmTypeStr "Berlin"} + + +## Prerequisite: CLASS Descriptor Stamping + +TYPECASE requires a valid class descriptor pointer at offset 0 of each +CLASS instance. DECLARE CLASS sets this for BSS-backed instances, but +ALLOC'd instances (from builders and from the JSON parser) get raw memory +with no descriptor. + +Fix: stamp the descriptor in HmNew and DaNew after ALLOC. + + SUB HmNew(LONGINT theCap&) EXTERNAL + SHARED _hmBldPtr + DECLARE CLASS Hashmap bld + + _hmBldPtr = ALLOC(_HM_STRUCT_SIZE) + POKEL _hmBldPtr, PEEKL(bld) ' <-- stamp descriptor + bld = _hmBldPtr + HmMake(bld, theCap&) + END SUB + +Same pattern for DaNew. This is a 1-line addition per builder and makes +all heap-allocated CLASS instances TYPECASE-compatible. The JSON parser +uses the same stamp pattern when it creates nodes directly. + +Branch for this fix: apply before or as part of json-submod branch. + + +## Files to Create + + submods/json/json.b Implementation (~400-600 lines est.) + include/submods/json.h Header: constants, DECLARE SUBs + submods/json/make AmigaDOS build script + submods/json/test_parse_obj.b Phase 1: parse objects + submods/json/test_parse_arr.b Phase 2: parse arrays + nesting + submods/json/test_parse_misc.b Phase 3: escapes, file input, errors + submods/json/test_gen.b Phase 4: generator + submods/json/test_roundtrip.b Phase 5: parse → generate → compare + submods/json/test_free.b Phase 6: recursive free + +## Files to Modify + + submods/hashmap/hashmap.b Add descriptor stamp in HmNew + submods/dynarray/dynarray.b Add descriptor stamp in DaNew + +## Files to Reference (read-only patterns) + + submods/hashmap/hashmap.b DIM...ADDRESS overlay, builder, SHARED state + submods/dynarray/dynarray.b Append, iteration, DaTypeRef + include/submods/hashmap.h Header structure + include/submods/dynarray.h Header structure + include/submods/testkit.h Test assertions + +## Branch + + json-submod + + +## Constants + + ' Error codes + CONST JS_SUCCESS = 0 + CONST JS_ERR_SYNTAX = -1 ' Unexpected character or token + CONST JS_ERR_DEPTH = -2 ' Nesting too deep + CONST JS_ERR_OVERFLOW = -3 ' Input buffer overflow + CONST JS_ERR_IO = -4 ' File read error + + ' Root type (returned by JsRootType) + CONST JsObject = 0 + CONST JsArray = 1 + + ' Parser limits + CONST JS_MAX_INPUT = 8192 ' Max input buffer size (bytes) + CONST JS_MAX_DEPTH = 10 ' Max nesting depth + + +## Public API + +### Parser + + ' Parse JSON from string. Returns ADDRESS of root (Hashmap or DynArray). + ' Returns 0 on error. Call JsError$() for message. + DECLARE SUB LONGINT JsParse(src$) EXTERNAL + + ' Parse JSON from open file channel. Reads entire file into buffer. + ' Returns ADDRESS of root, or 0 on error. + DECLARE SUB LONGINT JsParseFile(SHORTINT ch%) EXTERNAL + + ' Last parser error message (empty string if no error). + DECLARE SUB STRING JsError$ EXTERNAL + + ' Type of root returned by last successful parse. + ' JsObject (0) or JsArray (1). + DECLARE SUB SHORTINT JsRootType EXTERNAL + +### Generator + + ' Write compact JSON to open file channel. + ' root& is ADDRESS of Hashmap (object) or DynArray (array). + DECLARE SUB JsWrite(ADDRESS root&, SHORTINT ch%) EXTERNAL + + ' Write pretty-printed JSON with indentation to file channel. + DECLARE SUB JsWriteFmt(ADDRESS root&, SHORTINT ch%) EXTERNAL + + ' Generate compact JSON as string. For small documents only. + ' Returns "" on overflow (> ~4000 chars). + DECLARE SUB STRING JsToStr$(ADDRESS root&) EXTERNAL + +### Cleanup + + ' Recursively free entire JSON tree (all nested Hashmaps and DynArrays). + ' Uses TYPECASE to determine node types. Calls HmFree+FREE / DaFree+FREE. + DECLARE SUB JsFree(ADDRESS root&) EXTERNAL + +### Convenience — not strictly needed, but reduce boilerplate + + ' Initialize a DynArray as a JSON array (DaMake + stamp descriptor). + ' Caller can then DaAppend* to it and HmPutRef / DaAppendRef it. + DECLARE SUB JsMakeArr(DynArray da, LONGINT cap&) EXTERNAL + + ' Initialize a Hashmap as a JSON object (HmMake + stamp descriptor). + DECLARE SUB JsMakeObj(Hashmap hm, LONGINT cap&) EXTERNAL + + +## Parser Architecture + +Recursive descent parser operating on a string buffer via PEEK +for fast byte-level access. + +### Module-level shared state + + LONGINT _jsBase& ' SADD of input string (base for PEEK) + LONGINT _jsPos& ' Current byte offset (0-based) + LONGINT _jsLen& ' Input length + LONGINT _jsDepth% ' Current nesting depth + SHORTINT _jsRootType% ' JsObject or JsArray + DIM _jsErr$ AS STRING ' Last error message + + ' Descriptor pointers (cached once at module init) + LONGINT _jsHmDesc& ' PEEKL of a DECLARE CLASS Hashmap instance + LONGINT _jsDaDesc& ' PEEKL of a DECLARE CLASS DynArray instance + +### Internal helpers + + _JsCh% ' Return byte at current position (PEEK), or -1 at EOF + _JsAdvance ' Increment _jsPos& + _JsSkipWs ' Skip spaces, tabs, CR, LF + _JsExpect(SHORTINT ch%) ' Assert current byte matches, advance; set error if not + _JsSetError(msg$) ' Set _jsErr$ if not already set + +### Recursive descent + + JsParse(src$) + _jsBase& = SADD(src$), _jsPos& = 0, _jsLen& = LEN(src$) + _jsErr$ = "", _jsDepth% = 0 + _JsSkipWs + ch = _JsCh% + IF ch = 123 THEN ' { + result = _JsParseObject + _jsRootType% = JsObject + ELSEIF ch = 91 THEN ' [ + result = _JsParseArray + _jsRootType% = JsArray + ELSE + _JsSetError("Expected { or [") + result = 0 + END IF + JsParse = result + + _JsParseObject -> LONGINT (ADDRESS of new Hashmap) + _jsDepth% + 1, check JS_MAX_DEPTH + Allocate Hashmap (ALLOC + stamp descriptor + HmMake) + _JsAdvance (skip '{') + _JsSkipWs + IF _JsCh% <> 125 THEN ' not '}' + Loop: + key$ = _JsParseString$ + _JsSkipWs, _JsExpect(58) ' ':' + _JsSkipWs + _JsParseValue(hm, key$) + _JsSkipWs + IF _JsCh% = 44 THEN _JsAdvance ELSE exit loop ' ',' + _JsSkipWs + END IF + _JsExpect(125) ' '}' + _jsDepth% - 1 + return ADDRESS of hm + + _JsParseArray -> LONGINT (ADDRESS of new DynArray) + _jsDepth% + 1, check JS_MAX_DEPTH + Allocate DynArray (ALLOC + stamp descriptor + DaMake) + _JsAdvance (skip '[') + _JsSkipWs + IF _JsCh% <> 93 THEN ' not ']' + Loop: + _JsSkipWs + _JsParseValueArr(da) + _JsSkipWs + IF _JsCh% = 44 THEN _JsAdvance ELSE exit loop + _JsSkipWs + END IF + _JsExpect(93) ' ']' + _jsDepth% - 1 + return ADDRESS of da + + _JsParseValue(Hashmap parent, key$) + Peek at _JsCh%: + 34 (") → s$ = _JsParseString$ → HmPut$(parent, key$, s$) + 123 ({) → addr& = _JsParseObject → HmPutRef(parent, key$, addr&) + 91 ([) → addr& = _JsParseArray → HmPutRef(parent, key$, addr&) + 116 (t) → _JsExpectLiteral("true") → HmPutBool(parent, key$, -1) + 102 (f) → _JsExpectLiteral("false") → HmPutBool(parent, key$, 0) + 110 (n) → _JsExpectLiteral("null") → HmPutNull(parent, key$) + digit/- → _JsParseNumber(parent, key$) + + _JsParseValueArr(DynArray parent) + Same dispatch as above but uses DaAppend* instead of HmPut* + + _JsParseString$ -> STRING + _JsExpect(34) ' opening " + Build result string char by char: + 92 (\) → read next char for escape sequence + 34 (") → end of string + other → append to result + _JsAdvance past closing " + Return result + + _JsParseNumber(Hashmap parent, key$) + Scan digits, optional '.', optional 'e'/'E' into a buffer string + If buffer contains '.' or 'e'/'E': + val! = VAL(buffer$) + HmPut!(parent, key$, val!) + Else: + val& = VAL(buffer$) ' VAL returns SINGLE, CLNG for integer + HmPut&(parent, key$, val&) + + _JsParseNumberArr(DynArray parent) + Same logic but uses DaAppend& / DaAppend! + +### JsParseFile implementation + + Read file contents into an ALLOC'd buffer via repeated GET # or + a block read (_Read library call). Copy into module-level string. + Then call JsParse on the string. + + +## Generator Architecture + +Tree walker using TYPECASE to distinguish Hashmap (object) vs +DynArray (array) at each node. + +### Core dispatch + + SUB JsWrite(ADDRESS root&, SHORTINT ch%) EXTERNAL + TYPECASE root& + CASE Hashmap hm + _JsWriteObj(hm, ch%) + CASE DynArray da + _JsWriteArr(da, ch%) + END TYPECASE + END SUB + +### Object writer + + _JsWriteObj(Hashmap hm, SHORTINT ch%) + PRINT #ch%, "{"; + HmIterReset(hm) + SHORTINT first% = -1 + WHILE HmIterNext(hm) + IF NOT first% THEN PRINT #ch%, ","; + first% = 0 + _JsWriteStr(HmIterKey$(hm), ch%) + PRINT #ch%, ":"; + _JsWriteTypedVal(HmIterType(hm), HmIterVal$(hm), ~ + HmIterVal&(hm), ch%) + WEND + PRINT #ch%, "}"; + +### Array writer + + _JsWriteArr(DynArray da, SHORTINT ch%) + PRINT #ch%, "["; + LONGINT i& + FOR i& = 0 TO DaCount(da) - 1 + IF i& > 0 THEN PRINT #ch%, ","; + _JsWriteTypedVal(DaType(da, i&), DaGet$(da, i&), ~ + DaGet&(da, i&), ch%) + NEXT + PRINT #ch%, "]"; + +### Value writer (dispatches on type tag) + + _JsWriteTypedVal(SHORTINT typ%, val$, LONGINT valL&, SHORTINT ch%) + IF typ% = HmTypeStr THEN + _JsWriteStr(val$, ch%) + ELSEIF typ% = HmTypeLng THEN + PRINT #ch%, LTRIM$(STR$(valL&)); + ELSEIF typ% = HmTypeSng THEN + ' Convert FFP bits back to SINGLE, print + _JsWriteFloat(valL&, ch%) + ELSEIF typ% = HmTypeBool THEN + IF valL& THEN PRINT #ch%, "true"; ELSE PRINT #ch%, "false"; + ELSEIF typ% = HmTypeNull THEN + PRINT #ch%, "null"; + ELSEIF typ% = HmTypeRef THEN + ' Recurse — TYPECASE determines object vs array + JsWrite(valL&, ch%) + END IF + +### String writer (with escaping) + + _JsWriteStr(s$, ch%) + PRINT #ch%, CHR$(34); + FOR each byte in s$: + 34 (") → PRINT #ch%, "\"; CHR$(34); + 92 (\) → PRINT #ch%, "\\"; + 10 (LF) → PRINT #ch%, "\n"; + 13 (CR) → PRINT #ch%, "\r"; + 9 (TAB)→ PRINT #ch%, "\t"; + < 32 → skip or \uXXXX (v2) + other → PRINT #ch%, CHR$(byte); + NEXT + PRINT #ch%, CHR$(34); + +### Pretty printer + + JsWriteFmt uses the same structure as JsWrite but passes an indent + depth counter. Each nested object/array increases indent by 2 spaces. + Newlines after '{', '[', ',', before '}', ']'. + +### String generator (JsToStr$) + + Write to a temporary file (T:js_tmp), then read back as string. + Or: build via string concatenation with overflow check. + If result exceeds ~4000 chars, return "". + + +## Recursive Free (JsFree) + + SUB JsFree(ADDRESS root&) EXTERNAL + IF root& = 0 THEN EXIT SUB + + TYPECASE root& + CASE Hashmap hm + ' Walk all entries, recurse into Ref children + HmIterReset(hm) + WHILE HmIterNext(hm) + IF HmIterType(hm) = HmTypeRef THEN + JsFree(HmIterVal&(hm)) + END IF + WEND + HmFree(hm) + FREE root& + + CASE DynArray da + ' Walk all elements, recurse into Ref children + LONGINT i& + FOR i& = 0 TO DaCount(da) - 1 + IF DaType(da, i&) = DaTypeRef THEN + JsFree(DaGet&(da, i&)) + END IF + NEXT + DaFree(da) + FREE root& + END TYPECASE + END SUB + + +## String Escape Handling + +### Parse direction (JSON → BASIC string) + + \" → " (CHR$(34)) + \\ → \ (CHR$(92)) + \/ → / (CHR$(47)) + \n → LF (CHR$(10)) + \r → CR (CHR$(13)) + \t → TAB (CHR$(9)) + \b → BS (CHR$(8)) + \f → FF (CHR$(12)) + \uXXXX → skip for v1 (copy literally as \uXXXX) + +### Generate direction (BASIC string → JSON) + + " → \" + \ → \\ + LF → \n + CR → \r + TAB → \t + < 32 → skip (or \u00XX in v2) + + +## Number Handling + +### Parse + + Scan: optional '-', digits, optional '.'+digits, optional 'e'/'E'[+-]digits + Collect into a buffer string. + + Classification: + - Contains '.' or 'e'/'E' → SINGLE (FFP) via VAL() + - Otherwise → LONGINT via VAL() then CLNG() + - LONGINT range: -2,147,483,648 to 2,147,483,647 + - Values outside LONGINT range with no decimal → store as SINGLE + +### Generate + + - HmTypeLng → LTRIM$(STR$(val&)) (no leading space) + - HmTypeSng → LTRIM$(STR$(val!)) (ACE prints FFP with ~7 digits) + + Note: round-trip precision is limited to ~7 significant digits (FFP). + + +## Limitations + + - Input buffer: 8192 bytes max (JS_MAX_INPUT). Larger files truncated. + - String keys: 63 chars max (HM_KEY_SIZE - 1, hashmap limit) + - String values: 255 chars max (HM_VAL_SIZE - 1 / DA_VAL_SIZE - 1) + - Nesting depth: 10 levels max (JS_MAX_DEPTH, stack-limited) + - Array elements: up to 2048 (DA_MAX_CAP, with auto-growth) + - Object entries: up to ~358 (70% of HM_LARGE = 512) + - Float precision: ~7 significant digits (Amiga FFP) + - No \uXXXX Unicode escape support in v1 + - No streaming parse — entire input buffered first + - Duplicate JSON keys: last value wins (hashmap overwrites) + - JsToStr$ limited to ~4000 chars + - PRINT #n, "" writes a null byte — generator uses PRINT #n, CHR$(c); + for character-level output to avoid this + + +## Implementation Phases + +### Phase 0: Descriptor stamping prerequisite + + Files: hashmap.b, dynarray.b + Change: Add POKEL ..., PEEKL(bld) after ALLOC in HmNew and DaNew + Test: Existing hashmap/dynarray tests still pass + new TYPECASE test + +### Phase 1: Parser — objects with scalar values + + Parse: { "key": "str", "key": 42, "key": true, "key": null } + No nesting, no arrays, no floats yet. + + Internal subs: + _JsCh%, _JsAdvance, _JsSkipWs, _JsExpect + _JsSetError, JsError$, JsRootType + _JsParseString$, _JsParseObject + _JsParseValue (string, integer, bool, null paths) + JsParse + + Test: test_parse_obj.b + - Empty object {} + - Single string key-value + - Multiple key-value pairs + - Integer values (positive, negative, zero) + - Boolean true/false + - Null values + - Mixed types in one object + - Parser error cases (missing colon, missing quote, trailing comma) + +### Phase 2: Parser — arrays, nesting, floats + + Parse: [...], nested {}, nested [], float values + + Internal subs: + _JsParseArray, _JsParseValueArr + _JsParseNumber / _JsParseNumberArr (float path) + depth tracking and JS_MAX_DEPTH check + + Test: test_parse_arr.b + - Empty array [] + - Array of strings, integers, booleans, nulls + - Mixed-type array + - Nested object inside array + - Nested array inside object + - Nested array inside array + - Deeply nested structure + - Float values (positive, negative, with exponent) + - TYPECASE discrimination on nested refs + - Depth limit error + +### Phase 3: Parser — escapes, file input, error edge cases + + String escape handling in _JsParseString$ + JsParseFile implementation + Whitespace tolerance (tabs, newlines in input) + + Test: test_parse_misc.b + - Escaped quotes, backslashes, newlines, tabs in strings + - Whitespace-heavy input (newlines between tokens) + - JsParseFile from a written file + - Empty string values + - Error: unterminated string + - Error: unexpected EOF + - Error: invalid literal (e.g. "tru") + +### Phase 4: Generator — compact output + + JsWrite, JsToStr$ + _JsWriteObj, _JsWriteArr, _JsWriteTypedVal, _JsWriteStr + String escaping in output + + Test: test_gen.b + - Generate simple object + - Generate array + - Generate nested object + array + - Generate all value types + - String escaping in output (quotes, backslash, newline) + - JsToStr$ for small document + - JsToStr$ overflow returns "" + +### Phase 5: Pretty printer + round-trip + + JsWriteFmt with indentation + Round-trip: parse JSON → generate → compare output + + Test: test_roundtrip.b + - Parse then generate, compare strings + - Round-trip with nested structures + - Pretty-print output format verification + - Round-trip preserves types (int stays int, float stays float) + +### Phase 6: JsFree + JsMakeObj/JsMakeArr helpers + + Recursive free of entire tree + Convenience constructors with descriptor stamping + + Test: test_free.b + - Free simple object (no crash) + - Free nested object+array tree (no crash) + - Free empty object/array + - JsMakeObj / JsMakeArr produce TYPECASE-able instances + - Double-free safety (root& = 0 after free) + + +## Usage Examples + +### Parse and access + + REM #using ace:submods/hashmap/hashmap.o + REM #using ace:submods/dynarray/dynarray.o + REM #using ace:submods/json/json.o + #include + + DIM src$ AS STRING SIZE 4096 + src$ = "{" + CHR$(34) + "name" + CHR$(34) + ":" + CHR$(34) + "Alice" + CHR$(34) + "}" + + LONGINT root& + root& = JsParse(src$) + IF root& = 0 THEN + PRINT "Parse error: "; JsError$ + STOP + END IF + + DECLARE CLASS Hashmap doc + doc = root& + PRINT HmGet$(doc, "name") ' Alice + + JsFree(root&) + +### Parse with nested array + + src$ = ... JSON with "tags":["a","b"] ... + root& = JsParse(src$) + DECLARE CLASS Hashmap doc + doc = root& + + ' Access nested array via TYPECASE + LONGINT ref& + ref& = HmGetRef(doc, "tags") + + TYPECASE ref& + CASE DynArray tags + PRINT DaGet$(tags, 0) ' a + PRINT DaCount(tags) ' 2 + END TYPECASE + + JsFree(root&) + +### Build and generate + + DECLARE CLASS Hashmap resp + JsMakeObj(resp, HM_MEDIUM) + HmPut$(resp, "status", "ok") + HmPut&(resp, "code", 200) + + DECLARE CLASS DynArray items + JsMakeArr(items, DA_SMALL) + DaAppend$(items, "one") + DaAppend$(items, "two") + HmPutRef(resp, "items", items) + + OPEN "O", #1, "resp.json" + JsWrite(resp, 1) + CLOSE #1 + ' File: {"status":"ok","code":200,"items":["one","two"]} + + ' Manual cleanup (not JsFree — we own the structs on BSS) + DaFree(items) + HmFree(resp) + +### Round-trip + + root& = JsParse(original$) + OPEN "O", #1, "T:roundtrip.json" + JsWrite(root&, 1) + CLOSE #1 + JsFree(root&) + + +## Notes on PRINT # and Null Bytes + +ACE's PRINT #n, "" writes a null byte (0x00) before the newline. +The generator must avoid PRINT #n, "". Instead: +- Use PRINT #n, CHR$(c); for single characters +- Use PRINT #n, str$; (with semicolon, non-empty strings only) +- Newlines in pretty-print: PRINT #n, "" is acceptable there since + the null byte precedes a newline we want anyway — but test this. + Safer: use PRINT #n, CHR$(10); explicitly. + + +## Header Template (include/submods/json.h) + + #ifndef JSON_H + #define JSON_H + + #include + #include + + {* ============== Constants ============== *} + + CONST JS_SUCCESS = 0 + CONST JS_ERR_SYNTAX = -1 + CONST JS_ERR_DEPTH = -2 + CONST JS_ERR_OVERFLOW = -3 + CONST JS_ERR_IO = -4 + + CONST JsObject = 0 + CONST JsArray = 1 + + CONST JS_MAX_INPUT = 8192 + CONST JS_MAX_DEPTH = 10 + + {* ============== Parser ============== *} + + DECLARE SUB LONGINT JsParse(src$) EXTERNAL + DECLARE SUB LONGINT JsParseFile(SHORTINT ch%) EXTERNAL + DECLARE SUB STRING JsError$ EXTERNAL + DECLARE SUB SHORTINT JsRootType EXTERNAL + + {* ============== Generator ============== *} + + DECLARE SUB JsWrite(ADDRESS root&, SHORTINT ch%) EXTERNAL + DECLARE SUB JsWriteFmt(ADDRESS root&, SHORTINT ch%) EXTERNAL + DECLARE SUB STRING JsToStr$(ADDRESS root&) EXTERNAL + + {* ============== Cleanup ============== *} + + DECLARE SUB JsFree(ADDRESS root&) EXTERNAL + + {* ============== Convenience ============== *} + + DECLARE SUB JsMakeObj(Hashmap hm, LONGINT cap&) EXTERNAL + DECLARE SUB JsMakeArr(DynArray da, LONGINT cap&) EXTERNAL + + #endif diff --git a/submods/dynarray/dynarray.b b/submods/dynarray/dynarray.b index bb47032..f0cba97 100644 --- a/submods/dynarray/dynarray.b +++ b/submods/dynarray/dynarray.b @@ -604,6 +604,7 @@ SUB DaNew(LONGINT initCap&) EXTERNAL DECLARE CLASS DynArray bld _daBldPtr = ALLOC(_DA_STRUCT_SIZE) + POKEL _daBldPtr, PEEKL(bld) ' stamp class descriptor for TYPECASE bld = _daBldPtr DaMake(bld, initCap&) END SUB diff --git a/submods/dynarray/dynarray.o b/submods/dynarray/dynarray.o index 87ef6e5..339b43e 100644 Binary files a/submods/dynarray/dynarray.o and b/submods/dynarray/dynarray.o differ diff --git a/submods/hashmap/hashmap.b b/submods/hashmap/hashmap.b index f19e551..22f2109 100644 --- a/submods/hashmap/hashmap.b +++ b/submods/hashmap/hashmap.b @@ -728,6 +728,7 @@ SUB HmNew(LONGINT theCap&) EXTERNAL ' ALLOC a fresh CLASS block so each builder is independent _hmBldPtr = ALLOC(_HM_STRUCT_SIZE) + POKEL _hmBldPtr, PEEKL(bld) ' stamp class descriptor for TYPECASE bld = _hmBldPtr HmMake(bld, theCap&) END SUB diff --git a/submods/hashmap/hashmap.o b/submods/hashmap/hashmap.o index d43a9ad..02189f1 100644 Binary files a/submods/hashmap/hashmap.o and b/submods/hashmap/hashmap.o differ diff --git a/submods/json/json.b b/submods/json/json.b new file mode 100644 index 0000000..dfd4d8e --- /dev/null +++ b/submods/json/json.b @@ -0,0 +1,917 @@ +REM json.b - JSON parser and generator for ACE BASIC +REM +REM Dependencies: hashmap.o, dynarray.o +REM Uses Hashmap for JSON objects, DynArray for JSON arrays. +REM TYPECASE discriminates object vs array at each node. + +#include +#include + +{* ============== Constants ============== *} + +CONST _JS_HM_SIZE = 48 ' Hashmap CLASS struct size (4 + 6*4 + 5*4) +CONST _JS_DA_SIZE = 28 ' DynArray CLASS struct size (4 + 3*4 + 3*4) + +CONST JS_SUCCESS = 0 +CONST JS_ERR_SYNTAX = -1 +CONST JS_ERR_DEPTH = -2 +CONST JS_ERR_OVERFLOW = -3 +CONST JS_ERR_IO = -4 + +CONST JsObject = 0 +CONST JsArray = 1 + +CONST JS_MAX_INPUT = 8192 +CONST JS_MAX_DEPTH = 10 + +{* ============== Module-level shared state ============== *} + +LONGINT _jsBase& ' SADD of input string +LONGINT _jsPos& ' Current byte offset (0-based) +LONGINT _jsLen& ' Input length +SHORTINT _jsDepth% ' Current nesting depth +SHORTINT _jsRootType% ' JsObject(0) or JsArray(1) +STRING _jsErr$ SIZE 128 + +' Cached class descriptor pointers +LONGINT _jsHmDesc& +LONGINT _jsDaDesc& +SHORTINT _jsInited% + +' Number scanner results (shared between _JsScanNumber and callers) +STRING _jsNumBuf$ SIZE 32 +SHORTINT _jsNumIsFloat% +LONGINT _jsNumInt& + +' Depth-indexed key stack (avoids BSS clobbering in recursive calls) +DIM _jsKeyStk$(10) SIZE 64 + +{* ============== Internal: Descriptor cache ============== *} + +SUB _JsInitDesc + SHARED _jsHmDesc&, _jsDaDesc&, _jsInited% + IF _jsInited% THEN EXIT SUB + + DECLARE CLASS Hashmap tmpHm + DECLARE CLASS DynArray tmpDa + _jsHmDesc& = PEEKL(tmpHm) + _jsDaDesc& = PEEKL(tmpDa) + _jsInited% = -1 +END SUB + +{* ============== Internal: Scanner helpers ============== *} + +SUB SHORTINT _JsCh% + SHARED _jsBase&, _jsPos&, _jsLen& + SHORTINT retVal% + IF _jsPos& >= _jsLen& THEN + retVal% = -1 + ELSE + retVal% = PEEK(_jsBase& + _jsPos&) + END IF + _JsCh% = retVal% +END SUB + +SUB _JsSkipWs + SHARED _jsBase&, _jsPos&, _jsLen& + SHORTINT ch% + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WHILE ch% = 32 OR ch% = 9 OR ch% = 10 OR ch% = 13 + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WEND +END SUB + +SUB _JsExpect(SHORTINT expected%) + SHARED _jsBase&, _jsPos&, _jsLen&, _jsErr$ + IF LEN(_jsErr$) > 0 THEN EXIT SUB + SHORTINT ch% + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + IF ch% = expected% THEN + _jsPos& = _jsPos& + 1 + ELSE + IF LEN(_jsErr$) = 0 THEN + _jsErr$ = "Expected " + CHR$(expected%) + END IF + END IF +END SUB + +SUB _JsSetError(msg$) + SHARED _jsErr$ + IF LEN(_jsErr$) = 0 THEN + _jsErr$ = msg$ + END IF +END SUB + +{* ============== Internal: Literal matching ============== *} + +SUB SHORTINT _JsMatchLit(lit$) + SHARED _jsBase&, _jsPos&, _jsLen& + LONGINT litLen&, i& + SHORTINT retVal% + retVal% = 0 + litLen& = LEN(lit$) + + IF _jsPos& + litLen& <= _jsLen& THEN + retVal% = -1 + i& = 0 + WHILE i& < litLen& AND retVal% + IF PEEK(_jsBase& + _jsPos& + i&) <> ASC(MID$(lit$, i& + 1, 1)) THEN + retVal% = 0 + END IF + i& = i& + 1 + WEND + IF retVal% THEN + _jsPos& = _jsPos& + litLen& + END IF + END IF + + _JsMatchLit = retVal% +END SUB + +{* ============== Internal: String parsing ============== *} + +SUB STRING _JsParseString$ + SHARED _jsBase&, _jsPos&, _jsLen&, _jsErr$ + STRING retVal$ SIZE 256 + SHORTINT ch% + retVal$ = "" + + IF LEN(_jsErr$) > 0 THEN + _JsParseString$ = retVal$ + EXIT SUB + END IF + + ' Expect opening quote + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% <> 34 THEN + _JsSetError("Expected string") + _JsParseString$ = retVal$ + EXIT SUB + END IF + + _jsPos& = _jsPos& + 1 + + ' Scan string content + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + WHILE ch% <> 34 AND ch% >= 0 + IF ch% = 92 THEN + ' Backslash escape + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + IF ch% = 34 THEN + retVal$ = retVal$ + CHR$(34) + ELSEIF ch% = 92 THEN + retVal$ = retVal$ + CHR$(92) + ELSEIF ch% = 47 THEN + retVal$ = retVal$ + CHR$(47) + ELSEIF ch% = 110 THEN + retVal$ = retVal$ + CHR$(10) + ELSEIF ch% = 114 THEN + retVal$ = retVal$ + CHR$(13) + ELSEIF ch% = 116 THEN + retVal$ = retVal$ + CHR$(9) + ELSEIF ch% = 98 THEN + retVal$ = retVal$ + CHR$(8) + ELSEIF ch% = 102 THEN + retVal$ = retVal$ + CHR$(12) + ELSE + retVal$ = retVal$ + CHR$(ch%) + END IF + ELSE + retVal$ = retVal$ + CHR$(ch%) + END IF + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WEND + + IF ch% = 34 THEN + _jsPos& = _jsPos& + 1 + ELSE + _JsSetError("Unterminated string") + END IF + + _JsParseString$ = retVal$ +END SUB + +{* ============== Internal: Number scanning ============== *} + +SUB _JsScanNumber + SHARED _jsBase&, _jsPos&, _jsLen&, _jsErr$ + SHARED _jsNumBuf$, _jsNumIsFloat%, _jsNumInt& + SHORTINT ch%, hasDigit%, isNeg% + LONGINT i& + + IF LEN(_jsErr$) > 0 THEN EXIT SUB + + _jsNumBuf$ = "" + _jsNumIsFloat% = 0 + _jsNumInt& = 0 + hasDigit% = 0 + + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + ' Optional leading minus + IF ch% = 45 THEN + _jsNumBuf$ = "-" + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + END IF + + ' Digits before decimal + WHILE ch% >= 48 AND ch% <= 57 + _jsNumBuf$ = _jsNumBuf$ + CHR$(ch%) + hasDigit% = -1 + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WEND + + ' Optional decimal point + digits + IF ch% = 46 THEN + _jsNumIsFloat% = -1 + _jsNumBuf$ = _jsNumBuf$ + CHR$(46) + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WHILE ch% >= 48 AND ch% <= 57 + _jsNumBuf$ = _jsNumBuf$ + CHR$(ch%) + hasDigit% = -1 + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WEND + END IF + + ' Optional exponent + IF ch% = 101 OR ch% = 69 THEN + _jsNumIsFloat% = -1 + _jsNumBuf$ = _jsNumBuf$ + CHR$(ch%) + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + IF ch% = 43 OR ch% = 45 THEN + _jsNumBuf$ = _jsNumBuf$ + CHR$(ch%) + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + END IF + WHILE ch% >= 48 AND ch% <= 57 + _jsNumBuf$ = _jsNumBuf$ + CHR$(ch%) + _jsPos& = _jsPos& + 1 + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + WEND + END IF + + IF NOT hasDigit% THEN + _JsSetError("Invalid number") + EXIT SUB + END IF + + ' Parse integer value for non-float case + IF NOT _jsNumIsFloat% THEN + _jsNumInt& = 0 + isNeg% = 0 + i& = 1 + IF LEFT$(_jsNumBuf$, 1) = "-" THEN + isNeg% = -1 + i& = 2 + END IF + WHILE i& <= LEN(_jsNumBuf$) + _jsNumInt& = _jsNumInt& * 10 + (ASC(MID$(_jsNumBuf$, i&, 1)) - 48) + i& = i& + 1 + WEND + IF isNeg% THEN _jsNumInt& = -_jsNumInt& + END IF +END SUB + +{* ============== Internal: Recursive container parser ============== *} + +SUB LONGINT _JsParseContainer + SHARED _jsBase&, _jsPos&, _jsLen&, _jsErr$ + SHARED _jsHmDesc&, _jsDaDesc&, _jsDepth% + SHARED _jsNumBuf$, _jsNumIsFloat%, _jsNumInt& + SHARED _jsKeyStk$ + LONGINT retVal&, childAddr& + SHORTINT ch%, done% + STRING sVal$ SIZE 256 + DECLARE CLASS Hashmap hm + DECLARE CLASS DynArray da + + retVal& = 0 + + IF LEN(_jsErr$) > 0 THEN + _JsParseContainer = 0 + EXIT SUB + END IF + + _jsDepth% = _jsDepth% + 1 + IF _jsDepth% > JS_MAX_DEPTH THEN + _JsSetError("Max nesting depth exceeded") + _jsDepth% = _jsDepth% - 1 + _JsParseContainer = 0 + EXIT SUB + END IF + + ' Peek at opening character + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% = 123 THEN + {* ===== OBJECT ===== *} + + retVal& = ALLOC(_JS_HM_SIZE) + IF retVal& = 0 THEN + _JsSetError("Out of memory") + _jsDepth% = _jsDepth% - 1 + _JsParseContainer = 0 + EXIT SUB + END IF + POKEL retVal&, _jsHmDesc& + hm = retVal& + HmMake(hm, HM_MEDIUM) + + _jsPos& = _jsPos& + 1 + _JsSkipWs + + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% <> 125 THEN + done% = 0 + WHILE NOT done% AND LEN(_jsErr$) = 0 + _JsSkipWs + _jsKeyStk$(_jsDepth%) = _JsParseString$ + IF LEN(_jsErr$) > 0 THEN + done% = -1 + ELSE + _JsSkipWs + _JsExpect(58) + _JsSkipWs + + ' Dispatch object value + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% = 34 THEN + sVal$ = _JsParseString$ + IF LEN(_jsErr$) = 0 THEN + HmPut$(hm, _jsKeyStk$(_jsDepth%), sVal$) + END IF + ELSEIF ch% = 123 OR ch% = 91 THEN + childAddr& = _JsParseContainer + hm = retVal& + IF LEN(_jsErr$) = 0 THEN + HmPutRef(hm, _jsKeyStk$(_jsDepth%), childAddr&) + END IF + ELSEIF ch% = 116 THEN + IF _JsMatchLit("true") THEN + HmPutBool(hm, _jsKeyStk$(_jsDepth%), -1) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 102 THEN + IF _JsMatchLit("false") THEN + HmPutBool(hm, _jsKeyStk$(_jsDepth%), 0) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 110 THEN + IF _JsMatchLit("null") THEN + HmPutNull(hm, _jsKeyStk$(_jsDepth%)) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 45 OR (ch% >= 48 AND ch% <= 57) THEN + _JsScanNumber + IF LEN(_jsErr$) = 0 THEN + IF _jsNumIsFloat% THEN + HmPut!(hm, _jsKeyStk$(_jsDepth%), VAL(_jsNumBuf$)) + ELSE + HmPut&(hm, _jsKeyStk$(_jsDepth%), _jsNumInt&) + END IF + END IF + ELSE + _JsSetError("Unexpected character") + END IF + + _JsSkipWs + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + IF ch% = 44 THEN + _jsPos& = _jsPos& + 1 + ELSE + done% = -1 + END IF + END IF + WEND + END IF + + IF LEN(_jsErr$) = 0 THEN + _JsExpect(125) + END IF + + IF LEN(_jsErr$) > 0 THEN + HmFree(hm) + FREE retVal& + retVal& = 0 + END IF + + ELSEIF ch% = 91 THEN + {* ===== ARRAY ===== *} + + retVal& = ALLOC(_JS_DA_SIZE) + IF retVal& = 0 THEN + _JsSetError("Out of memory") + _jsDepth% = _jsDepth% - 1 + _JsParseContainer = 0 + EXIT SUB + END IF + POKEL retVal&, _jsDaDesc& + da = retVal& + DaMake(da, DA_MEDIUM) + + _jsPos& = _jsPos& + 1 + _JsSkipWs + + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% <> 93 THEN + done% = 0 + WHILE NOT done% AND LEN(_jsErr$) = 0 + _JsSkipWs + + ' Dispatch array value + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + + IF ch% = 34 THEN + sVal$ = _JsParseString$ + IF LEN(_jsErr$) = 0 THEN + DaAppend$(da, sVal$) + END IF + ELSEIF ch% = 123 OR ch% = 91 THEN + childAddr& = _JsParseContainer + da = retVal& + IF LEN(_jsErr$) = 0 THEN + DaAppendRef(da, childAddr&) + END IF + ELSEIF ch% = 116 THEN + IF _JsMatchLit("true") THEN + DaAppendBool(da, -1) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 102 THEN + IF _JsMatchLit("false") THEN + DaAppendBool(da, 0) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 110 THEN + IF _JsMatchLit("null") THEN + DaAppendNull(da) + ELSE + _JsSetError("Invalid literal") + END IF + ELSEIF ch% = 45 OR (ch% >= 48 AND ch% <= 57) THEN + _JsScanNumber + IF LEN(_jsErr$) = 0 THEN + IF _jsNumIsFloat% THEN + DaAppend!(da, VAL(_jsNumBuf$)) + ELSE + DaAppend&(da, _jsNumInt&) + END IF + END IF + ELSE + _JsSetError("Unexpected character") + END IF + + _JsSkipWs + IF _jsPos& < _jsLen& THEN + ch% = PEEK(_jsBase& + _jsPos&) + ELSE + ch% = -1 + END IF + IF ch% = 44 THEN + _jsPos& = _jsPos& + 1 + ELSE + done% = -1 + END IF + WEND + END IF + + IF LEN(_jsErr$) = 0 THEN + _JsExpect(93) + END IF + + IF LEN(_jsErr$) > 0 THEN + DaFree(da) + FREE retVal& + retVal& = 0 + END IF + + ELSE + _JsSetError("Expected { or [") + END IF + + _jsDepth% = _jsDepth% - 1 + _JsParseContainer = retVal& +END SUB + +{* ============== Public API ============== *} + +SUB LONGINT JsParse(src$) EXTERNAL + SHARED _jsBase&, _jsPos&, _jsLen&, _jsDepth%, _jsRootType%, _jsErr$ + LONGINT retVal& + SHORTINT ch% + retVal& = 0 + + _JsInitDesc + + _jsBase& = SADD(src$) + _jsPos& = 0 + _jsLen& = LEN(src$) + _jsDepth% = 0 + _jsErr$ = "" + + _JsSkipWs + ch% = _JsCh% + + IF ch% = 123 THEN + _jsRootType% = JsObject + ELSEIF ch% = 91 THEN + _jsRootType% = JsArray + ELSE + _JsSetError("Expected { or [") + JsParse = 0 + EXIT SUB + END IF + + retVal& = _JsParseContainer + + JsParse = retVal& +END SUB + +SUB LONGINT JsParseFile(SHORTINT ch%) EXTERNAL + SHARED _jsBase&, _jsPos&, _jsLen&, _jsDepth%, _jsRootType%, _jsErr$ + STRING buf$ SIZE 8192 + STRING ln$ SIZE 1024 + LONGINT retVal& + SHORTINT c% + + _JsInitDesc + + buf$ = "" + _jsErr$ = "" + retVal& = 0 + + WHILE NOT EOF(ch%) + LINE INPUT #ch%, ln$ + IF LEN(buf$) = 0 THEN + buf$ = ln$ + ELSEIF LEN(buf$) + LEN(ln$) + 1 <= JS_MAX_INPUT THEN + buf$ = buf$ + " " + ln$ + ELSE + _JsSetError("Input too large") + END IF + WEND + + IF LEN(_jsErr$) > 0 THEN + JsParseFile = 0 + EXIT SUB + END IF + + IF LEN(buf$) = 0 THEN + _JsSetError("Expected { or [") + JsParseFile = 0 + EXIT SUB + END IF + + _jsBase& = SADD(buf$) + _jsPos& = 0 + _jsLen& = LEN(buf$) + _jsDepth% = 0 + + _JsSkipWs + c% = _JsCh% + + IF c% = 123 THEN + _jsRootType% = JsObject + ELSEIF c% = 91 THEN + _jsRootType% = JsArray + ELSE + _JsSetError("Expected { or [") + JsParseFile = 0 + EXIT SUB + END IF + + retVal& = _JsParseContainer + JsParseFile = retVal& +END SUB + +{* ============== Generator: String escaping ============== *} + +SUB _JsWriteStr(s$, SHORTINT ch%) + STRING esc$ SIZE 600 + LONGINT i& + SHORTINT c% + esc$ = CHR$(34) + FOR i& = 1 TO LEN(s$) + c% = ASC(MID$(s$, i&, 1)) + IF c% = 34 THEN + esc$ = esc$ + "\" + CHR$(34) + ELSEIF c% = 92 THEN + esc$ = esc$ + "\\" + ELSEIF c% = 10 THEN + esc$ = esc$ + "\n" + ELSEIF c% = 13 THEN + esc$ = esc$ + "\r" + ELSEIF c% = 9 THEN + esc$ = esc$ + "\t" + ELSEIF c% = 8 THEN + esc$ = esc$ + "\b" + ELSEIF c% = 12 THEN + esc$ = esc$ + "\f" + ELSEIF c% < 32 THEN + ' skip other control chars + ELSE + esc$ = esc$ + CHR$(c%) + END IF + NEXT + esc$ = esc$ + CHR$(34) + PRINT #ch%, esc$; +END SUB + +{* ============== Generator: Recursive node writer ============== *} +' lvl% = -1: compact mode (no whitespace) +' lvl% >= 0: formatted mode (2-space indent at that level) + +SUB _JsWriteNode(ADDRESS addr&, SHORTINT ch%, SHORTINT lvl%) + LONGINT savedAddr&, i&, cnt&, nextLvl& + SHORTINT first%, typ%, fmt%, pad% + SINGLE fVal! + DECLARE CLASS Hashmap tcItem + + IF addr& = 0 THEN EXIT SUB + + savedAddr& = addr& + tcItem = addr& + fmt% = (lvl% >= 0) + IF fmt% THEN nextLvl& = lvl% + 1 ELSE nextLvl& = -1 + + TYPECASE tcItem + CASE Hashmap + PRINT #ch%, "{"; + HmIterReset(tcItem) + first% = -1 + WHILE HmIterNext(tcItem) + IF NOT first% THEN PRINT #ch%, ","; + IF fmt% THEN + PRINT #ch%, CHR$(10); + pad% = (lvl% + 1) * 2 + IF pad% > 0 THEN PRINT #ch%, SPACE$(pad%); + END IF + first% = 0 + _JsWriteStr(HmIterKey$(tcItem), ch%) + IF fmt% THEN PRINT #ch%, ": "; ELSE PRINT #ch%, ":"; + + typ% = HmIterType(tcItem) + IF typ% = HmTypeStr THEN + _JsWriteStr(HmIterVal$(tcItem), ch%) + ELSEIF typ% = HmTypeLng THEN + PRINT #ch%, LTRIM$(STR$(HmIterVal&(tcItem))); + ELSEIF typ% = HmTypeSng THEN + fVal! = HmIterVal!(tcItem) + PRINT #ch%, LTRIM$(STR$(fVal!)); + ELSEIF typ% = HmTypeBool THEN + IF HmIterVal&(tcItem) THEN + PRINT #ch%, "true"; + ELSE + PRINT #ch%, "false"; + END IF + ELSEIF typ% = HmTypeNull THEN + PRINT #ch%, "null"; + ELSEIF typ% = HmTypeRef THEN + _JsWriteNode(HmIterVal&(tcItem), ch%, nextLvl&) + tcItem = savedAddr& + END IF + WEND + IF fmt% AND NOT first% THEN + PRINT #ch%, CHR$(10); + pad% = lvl% * 2 + IF pad% > 0 THEN PRINT #ch%, SPACE$(pad%); + END IF + PRINT #ch%, "}"; + + CASE DynArray + cnt& = DaCount(tcItem) + PRINT #ch%, "["; + FOR i& = 0 TO cnt& - 1 + IF i& > 0 THEN PRINT #ch%, ","; + IF fmt% THEN + PRINT #ch%, CHR$(10); + pad% = (lvl% + 1) * 2 + IF pad% > 0 THEN PRINT #ch%, SPACE$(pad%); + END IF + + typ% = DaType(tcItem, i&) + IF typ% = DaTypeStr THEN + _JsWriteStr(DaGet$(tcItem, i&), ch%) + ELSEIF typ% = DaTypeLng THEN + PRINT #ch%, LTRIM$(STR$(DaGet&(tcItem, i&))); + ELSEIF typ% = DaTypeSng THEN + fVal! = DaGet!(tcItem, i&) + PRINT #ch%, LTRIM$(STR$(fVal!)); + ELSEIF typ% = DaTypeBool THEN + IF DaGet&(tcItem, i&) THEN + PRINT #ch%, "true"; + ELSE + PRINT #ch%, "false"; + END IF + ELSEIF typ% = DaTypeNull THEN + PRINT #ch%, "null"; + ELSEIF typ% = DaTypeRef THEN + _JsWriteNode(DaGet&(tcItem, i&), ch%, nextLvl&) + tcItem = savedAddr& + END IF + NEXT + IF fmt% AND cnt& > 0 THEN + PRINT #ch%, CHR$(10); + pad% = lvl% * 2 + IF pad% > 0 THEN PRINT #ch%, SPACE$(pad%); + END IF + PRINT #ch%, "]"; + END TYPECASE +END SUB + +{* ============== Public API: Generator ============== *} + +SUB JsWrite(ADDRESS root&, SHORTINT ch%) EXTERNAL + IF root& = 0 THEN EXIT SUB + _JsWriteNode(root&, ch%, -1) +END SUB + +SUB JsWriteFmt(ADDRESS root&, SHORTINT ch%) EXTERNAL + IF root& = 0 THEN EXIT SUB + _JsWriteNode(root&, ch%, 0) +END SUB + +SUB STRING JsToStr$(ADDRESS root&) EXTERNAL + STRING retVal$ SIZE 4096 + retVal$ = "" + IF root& = 0 THEN + JsToStr$ = retVal$ + EXIT SUB + END IF + + OPEN "O", #9, "T:js_tmp" + JsWrite(root&, 9) + CLOSE #9 + + OPEN "I", #9, "T:js_tmp" + LINE INPUT #9, retVal$ + CLOSE #9 + + IF LEN(retVal$) > 4000 THEN + retVal$ = "" + END IF + + JsToStr$ = retVal$ +END SUB + +{* ============== Public API: Info ============== *} + +SUB STRING JsError$ EXTERNAL + SHARED _jsErr$ + JsError$ = _jsErr$ +END SUB + +SUB SHORTINT JsRootType EXTERNAL + SHARED _jsRootType% + JsRootType = _jsRootType% +END SUB + +{* ============== Public API: Cleanup ============== *} + +SUB JsFree(ADDRESS root&) EXTERNAL + LONGINT savedAddr&, i&, cnt&, childAddr& + DECLARE CLASS Hashmap tcItem + + IF root& = 0 THEN EXIT SUB + + savedAddr& = root& + tcItem = root& + + TYPECASE tcItem + CASE Hashmap + HmIterReset(tcItem) + WHILE HmIterNext(tcItem) + IF HmIterType(tcItem) = HmTypeRef THEN + childAddr& = HmIterVal&(tcItem) + JsFree(childAddr&) + tcItem = savedAddr& + END IF + WEND + HmFree(tcItem) + FREE root& + + CASE DynArray + cnt& = DaCount(tcItem) + FOR i& = 0 TO cnt& - 1 + IF DaType(tcItem, i&) = DaTypeRef THEN + childAddr& = DaGet&(tcItem, i&) + JsFree(childAddr&) + tcItem = savedAddr& + END IF + NEXT + DaFree(tcItem) + FREE root& + END TYPECASE +END SUB + +{* ============== Public API: Convenience ============== *} + +SUB JsMakeObj(Hashmap hm, LONGINT cap&) EXTERNAL + HmMake(hm, cap&) +END SUB + +SUB JsMakeArr(DynArray da, LONGINT cap&) EXTERNAL + DaMake(da, cap&) +END SUB diff --git a/submods/json/make b/submods/json/make new file mode 100644 index 0000000..a2a896b --- /dev/null +++ b/submods/json/make @@ -0,0 +1,2 @@ +; Build json module +execute ACE:bin/bas -mO json diff --git a/submods/json/test_free.b b/submods/json/test_free.b new file mode 100644 index 0000000..50258ce --- /dev/null +++ b/submods/json/test_free.b @@ -0,0 +1,188 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_free.b - Phase 6: JsFree + JsMakeObj/JsMakeArr +** Tests: recursive free, convenience constructors, null safety +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 6: JsFree + Convenience ===" +PRINT + +TkInit + +STRING src$ SIZE 4096 +STRING q$ SIZE 4 +q$ = CHR$(34) + +LONGINT root& + +{* ============== Test 1: JsFree null safety ============== *} + +PRINT "-- Test 1: JsFree null safety" +JsFree(0) +TkAssertTrue(-1, "JsFree(0) no crash") + +{* ============== Test 2: JsFree simple object ============== *} + +PRINT "-- Test 2: JsFree simple object" +src$ = "{" + q$ + "a" + q$ + ":" + q$ + "b" + q$ + "}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free obj parse") +JsFree(root&) +TkAssertTrue(-1, "free obj no crash") + +{* ============== Test 3: JsFree simple array ============== *} + +PRINT "-- Test 3: JsFree simple array" +src$ = "[1,2,3]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free arr parse") +JsFree(root&) +TkAssertTrue(-1, "free arr no crash") + +{* ============== Test 4: JsFree empty object ============== *} + +PRINT "-- Test 4: JsFree empty object" +src$ = "{}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free {} parse") +JsFree(root&) +TkAssertTrue(-1, "free {} no crash") + +{* ============== Test 5: JsFree empty array ============== *} + +PRINT "-- Test 5: JsFree empty array" +src$ = "[]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free [] parse") +JsFree(root&) +TkAssertTrue(-1, "free [] no crash") + +{* ============== Test 6: JsFree nested object ============== *} + +PRINT "-- Test 6: JsFree nested object" +src$ = "{" + q$ + "inner" + q$ + ":{" + q$ + "x" + q$ + ":1}}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free nested parse") +JsFree(root&) +TkAssertTrue(-1, "free nested no crash") + +{* ============== Test 7: JsFree nested array in object ============== *} + +PRINT "-- Test 7: JsFree nested array in object" +src$ = "{" + q$ + "arr" + q$ + ":[10,20,30]}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free arr-in-obj parse") +JsFree(root&) +TkAssertTrue(-1, "free arr-in-obj no crash") + +{* ============== Test 8: JsFree deeply nested ============== *} + +PRINT "-- Test 8: JsFree deeply nested" +' {"d":[{"v":7,"sub":{"k":"val"}},true]} +src$ = "{" + q$ + "d" + q$ + ":[{" + q$ + "v" + q$ + ":7," +src$ = src$ + q$ + "sub" + q$ + ":{" + q$ + "k" + q$ + ":" +src$ = src$ + q$ + "val" + q$ + "}},true]}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free deep parse") +JsFree(root&) +TkAssertTrue(-1, "free deep no crash") + +{* ============== Test 9: JsFree array of arrays ============== *} + +PRINT "-- Test 9: JsFree array of arrays" +src$ = "[[1,2],[3,4]]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free arr-arr parse") +JsFree(root&) +TkAssertTrue(-1, "free arr-arr no crash") + +{* ============== Test 10: JsFree mixed types ============== *} + +PRINT "-- Test 10: JsFree mixed types" +src$ = "{" + q$ + "s" + q$ + ":" + q$ + "hi" + q$ + "," +src$ = src$ + q$ + "i" + q$ + ":42," +src$ = src$ + q$ + "b" + q$ + ":true," +src$ = src$ + q$ + "n" + q$ + ":null," +src$ = src$ + q$ + "a" + q$ + ":[1]}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "free mixed parse") +JsFree(root&) +TkAssertTrue(-1, "free mixed no crash") + +{* ============== Test 11: JsMakeObj produces TYPECASE-able instance ============== *} + +PRINT "-- Test 11: JsMakeObj TYPECASE" +DECLARE CLASS Hashmap hm +JsMakeObj(hm, HM_SMALL) +HmPut$(hm, "test", "ok") +SHORTINT isObj% +isObj% = 0 + +DECLARE CLASS Hashmap tc +tc = hm +TYPECASE tc + CASE Hashmap + isObj% = -1 +END TYPECASE + +TkAssertTrue(isObj%, "JsMakeObj typecase") +TkAssertEqStr(HmGet$(hm, "test"), "ok", "JsMakeObj val") +HmFree(hm) + +{* ============== Test 12: JsMakeArr produces TYPECASE-able instance ============== *} + +PRINT "-- Test 12: JsMakeArr TYPECASE" +DECLARE CLASS DynArray da +JsMakeArr(da, DA_SMALL) +DaAppend&(da, 77) +SHORTINT isArr% +isArr% = 0 + +tc = da +TYPECASE tc + CASE DynArray + isArr% = -1 +END TYPECASE + +TkAssertTrue(isArr%, "JsMakeArr typecase") +TkAssertEq&(DaGet&(da, 0), 77, "JsMakeArr val") +DaFree(da) + +{* ============== Test 13: Parse + use + JsFree full cycle ============== *} + +PRINT "-- Test 13: Parse + use + JsFree full cycle" +src$ = "{" + q$ + "msg" + q$ + ":" + q$ + "hello" + q$ + "," +src$ = src$ + q$ + "nums" + q$ + ":[1,2,3]}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "cycle parse") + +' Access values before freeing +DECLARE CLASS Hashmap doc +doc = root& +TkAssertEqStr(HmGet$(doc, "msg"), "hello", "cycle msg") + +LONGINT ref& +ref& = HmGetRef(doc, "nums") +TkAssertTrue(ref& <> 0, "cycle nums ref") + +DECLARE CLASS DynArray nums +nums = ref& +TkAssertEq&(DaCount(nums), 3, "cycle nums count") +TkAssertEq&(DaGet&(nums, 0), 1, "cycle nums[0]") +TkAssertEq&(DaGet&(nums, 2), 3, "cycle nums[2]") + +' Now free the entire tree +JsFree(root&) +TkAssertTrue(-1, "cycle free no crash") + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_gen.b b/submods/json/test_gen.b new file mode 100644 index 0000000..09fa664 --- /dev/null +++ b/submods/json/test_gen.b @@ -0,0 +1,290 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_gen.b - Phase 4: Generate compact JSON output +** Tests: JsWrite, JsToStr$ +** Builds data structures manually and verifies generated output. +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 4: Generate Compact JSON ===" +PRINT + +TkInit + +STRING result$ SIZE 4096 +STRING expected$ SIZE 4096 +STRING q$ SIZE 4 +q$ = CHR$(34) + +DECLARE CLASS Hashmap hm +DECLARE CLASS DynArray da + +{* ============== Test 1: Empty object ============== *} + +PRINT "-- Test 1: Empty object" +HmMake(hm, HM_SMALL) +result$ = JsToStr$(hm) +TkAssertEqStr(result$, "{}", "empty obj = {}") +HmFree(hm) + +{* ============== Test 2: Single string ============== *} + +PRINT "-- Test 2: Single string" +HmMake(hm, HM_SMALL) +HmPut$(hm, "city", "Berlin") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "city" + q$ + ":" + q$ + "Berlin" + q$ + "}" +TkAssertEqStr(result$, expected$, "single str obj") +HmFree(hm) + +{* ============== Test 3: Integer value ============== *} + +PRINT "-- Test 3: Integer value" +HmMake(hm, HM_SMALL) +HmPut&(hm, "age", 30) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "age" + q$ + ":30}" +TkAssertEqStr(result$, expected$, "int val obj") +HmFree(hm) + +{* ============== Test 4: Negative integer ============== *} + +PRINT "-- Test 4: Negative integer" +HmMake(hm, HM_SMALL) +HmPut&(hm, "n", -5) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "n" + q$ + ":-5}" +TkAssertEqStr(result$, expected$, "neg int obj") +HmFree(hm) + +{* ============== Test 5: Boolean true ============== *} + +PRINT "-- Test 5: Boolean true" +HmMake(hm, HM_SMALL) +HmPutBool(hm, "flag", -1) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "flag" + q$ + ":true}" +TkAssertEqStr(result$, expected$, "bool true obj") +HmFree(hm) + +{* ============== Test 6: Boolean false ============== *} + +PRINT "-- Test 6: Boolean false" +HmMake(hm, HM_SMALL) +HmPutBool(hm, "flag", 0) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "flag" + q$ + ":false}" +TkAssertEqStr(result$, expected$, "bool false obj") +HmFree(hm) + +{* ============== Test 7: Null value ============== *} + +PRINT "-- Test 7: Null value" +HmMake(hm, HM_SMALL) +HmPutNull(hm, "x") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "x" + q$ + ":null}" +TkAssertEqStr(result$, expected$, "null val obj") +HmFree(hm) + +{* ============== Test 8: Multiple values ============== *} + +PRINT "-- Test 8: Multiple values" +HmMake(hm, HM_SMALL) +HmPut$(hm, "a", "x") +HmPut&(hm, "b", 1) +HmPutBool(hm, "c", -1) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "a" + q$ + ":" + q$ + "x" + q$ + "," +expected$ = expected$ + q$ + "b" + q$ + ":1," +expected$ = expected$ + q$ + "c" + q$ + ":true}" +TkAssertEqStr(result$, expected$, "multi val obj") +HmFree(hm) + +{* ============== Test 9: Empty array ============== *} + +PRINT "-- Test 9: Empty array" +DaMake(da, DA_SMALL) +result$ = JsToStr$(da) +TkAssertEqStr(result$, "[]", "empty arr = []") +DaFree(da) + +{* ============== Test 10: String array ============== *} + +PRINT "-- Test 10: String array" +DaMake(da, DA_SMALL) +DaAppend$(da, "aaa") +DaAppend$(da, "bbb") +result$ = JsToStr$(da) +expected$ = "[" + q$ + "aaa" + q$ + "," + q$ + "bbb" + q$ + "]" +TkAssertEqStr(result$, expected$, "str array") +DaFree(da) + +{* ============== Test 11: Integer array ============== *} + +PRINT "-- Test 11: Integer array" +DaMake(da, DA_SMALL) +DaAppend&(da, 1) +DaAppend&(da, -2) +DaAppend&(da, 0) +result$ = JsToStr$(da) +TkAssertEqStr(result$, "[1,-2,0]", "int array") +DaFree(da) + +{* ============== Test 12: Mixed type array ============== *} + +PRINT "-- Test 12: Mixed type array" +DaMake(da, DA_SMALL) +DaAppend$(da, "hi") +DaAppend&(da, 42) +DaAppendBool(da, -1) +DaAppendNull(da) +result$ = JsToStr$(da) +expected$ = "[" + q$ + "hi" + q$ + ",42,true,null]" +TkAssertEqStr(result$, expected$, "mixed array") +DaFree(da) + +{* ============== Test 13: Nested object ============== *} + +PRINT "-- Test 13: Nested object" +DECLARE CLASS Hashmap inner +HmMake(inner, HM_SMALL) +HmPut&(inner, "x", 1) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "inner", inner) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "inner" + q$ + ":{" + q$ + "x" + q$ + ":1}}" +TkAssertEqStr(result$, expected$, "nested obj") +HmFree(inner) +HmFree(hm) + +{* ============== Test 14: Nested array in object ============== *} + +PRINT "-- Test 14: Nested array in object" +DaMake(da, DA_SMALL) +DaAppend&(da, 10) +DaAppend&(da, 20) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "nums", da) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "nums" + q$ + ":[10,20]}" +TkAssertEqStr(result$, expected$, "arr in obj") +DaFree(da) +HmFree(hm) + +{* ============== Test 15: Nested object in array ============== *} + +PRINT "-- Test 15: Nested object in array" +HmMake(inner, HM_SMALL) +HmPut$(inner, "k", "v") +DaMake(da, DA_SMALL) +DaAppendRef(da, inner) +result$ = JsToStr$(da) +expected$ = "[{" + q$ + "k" + q$ + ":" + q$ + "v" + q$ + "}]" +TkAssertEqStr(result$, expected$, "obj in arr") +HmFree(inner) +DaFree(da) + +{* ============== Test 16: String escaping - quote ============== *} + +PRINT "-- Test 16: String escaping - quote" +HmMake(hm, HM_SMALL) +HmPut$(hm, "k", "a" + CHR$(34) + "b") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "k" + q$ + ":" + q$ + "a\" + q$ + "b" + q$ + "}" +TkAssertEqStr(result$, expected$, "escape quote") +HmFree(hm) + +{* ============== Test 17: String escaping - backslash ============== *} + +PRINT "-- Test 17: String escaping - backslash" +HmMake(hm, HM_SMALL) +HmPut$(hm, "k", "a\b") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "k" + q$ + ":" + q$ + "a\\b" + q$ + "}" +TkAssertEqStr(result$, expected$, "escape backslash") +HmFree(hm) + +{* ============== Test 18: String escaping - newline ============== *} + +PRINT "-- Test 18: String escaping - newline" +HmMake(hm, HM_SMALL) +HmPut$(hm, "k", "a" + CHR$(10) + "b") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "k" + q$ + ":" + q$ + "a\nb" + q$ + "}" +TkAssertEqStr(result$, expected$, "escape newline") +HmFree(hm) + +{* ============== Test 19: String escaping - tab ============== *} + +PRINT "-- Test 19: String escaping - tab" +HmMake(hm, HM_SMALL) +HmPut$(hm, "k", "a" + CHR$(9) + "b") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "k" + q$ + ":" + q$ + "a\tb" + q$ + "}" +TkAssertEqStr(result$, expected$, "escape tab") +HmFree(hm) + +{* ============== Test 20: JsWrite to file ============== *} + +PRINT "-- Test 20: JsWrite to file" +HmMake(hm, HM_SMALL) +HmPut$(hm, "msg", "ok") +OPEN "O", #1, "T:js_test.json" +JsWrite(hm, 1) +CLOSE #1 +STRING fLine$ SIZE 1024 +OPEN "I", #1, "T:js_test.json" +LINE INPUT #1, fLine$ +CLOSE #1 +expected$ = "{" + q$ + "msg" + q$ + ":" + q$ + "ok" + q$ + "}" +TkAssertEqStr(fLine$, expected$, "JsWrite to file") +HmFree(hm) + +{* ============== Test 21: Deeply nested (obj > arr > obj) ============== *} + +PRINT "-- Test 21: Deeply nested" +DECLARE CLASS Hashmap deep +HmMake(deep, HM_SMALL) +HmPut&(deep, "v", 7) +DaMake(da, DA_SMALL) +DaAppendRef(da, deep) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "arr", da) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "arr" + q$ + ":[{" + q$ + "v" + q$ + ":7}]}" +TkAssertEqStr(result$, expected$, "deep nested") +HmFree(deep) +DaFree(da) +HmFree(hm) + +{* ============== Test 22: Key escaping ============== *} + +PRINT "-- Test 22: Key escaping" +HmMake(hm, HM_SMALL) +HmPut&(hm, "a" + CHR$(34) + "b", 1) +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "a\" + q$ + "b" + q$ + ":1}" +TkAssertEqStr(result$, expected$, "key with quote") +HmFree(hm) + +{* ============== Test 23: Empty string value ============== *} + +PRINT "-- Test 23: Empty string value" +HmMake(hm, HM_SMALL) +HmPut$(hm, "e", "") +result$ = JsToStr$(hm) +expected$ = "{" + q$ + "e" + q$ + ":" + q$ + q$ + "}" +TkAssertEqStr(result$, expected$, "empty str val") +HmFree(hm) + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_parse_arr.b b/submods/json/test_parse_arr.b new file mode 100644 index 0000000..02706c9 --- /dev/null +++ b/submods/json/test_parse_arr.b @@ -0,0 +1,535 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_parse_arr.b - Phase 2: Parse JSON arrays, nesting, floats +** Tests: arrays, nested objects/arrays, float values, TYPECASE, depth limit +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 2: Parse Arrays, Nesting, Floats ===" +PRINT + +TkInit + +STRING src$ SIZE 4096 +STRING errMsg$ SIZE 128 +STRING q$ SIZE 4 +q$ = CHR$(34) + +LONGINT root&, ref& +DECLARE CLASS Hashmap hm +DECLARE CLASS DynArray da +DECLARE CLASS DynArray innerDa +DECLARE CLASS Hashmap innerHm +SHORTINT matched% + +{* ============== Test 1: Empty array ============== *} + +PRINT "-- Test 1: Empty array" +src$ = "[]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse [] not null") +IF root& <> 0 THEN + TkAssertEq%(JsRootType, JsArray, "root type = array") + da = root& + TkAssertEq&(DaCount(da), 0, "empty count = 0") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 2: Array of strings ============== *} + +PRINT "-- Test 2: Array of strings" +src$ = "[" + q$ + "aaa" + q$ + "," + q$ + "bbb" + q$ + "," + q$ + "ccc" + q$ + "]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse str array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 3, "str arr count = 3") + TkAssertEqStr(DaGet$(da, 0), "aaa", "elem 0 = aaa") + TkAssertEqStr(DaGet$(da, 1), "bbb", "elem 1 = bbb") + TkAssertEqStr(DaGet$(da, 2), "ccc", "elem 2 = ccc") + TkAssertEq%(DaType(da, 0), DaTypeStr, "elem 0 type = str") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 3: Array of integers ============== *} + +PRINT "-- Test 3: Array of integers" +src$ = "[10, -20, 0, 999]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse int array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 4, "int arr count = 4") + TkAssertEq&(DaGet&(da, 0), 10, "elem 0 = 10") + TkAssertEq&(DaGet&(da, 1), -20, "elem 1 = -20") + TkAssertEq&(DaGet&(da, 2), 0, "elem 2 = 0") + TkAssertEq&(DaGet&(da, 3), 999, "elem 3 = 999") + TkAssertEq%(DaType(da, 0), DaTypeLng, "elem 0 type = lng") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 4: Array of booleans ============== *} + +PRINT "-- Test 4: Array of booleans" +src$ = "[true, false, true]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse bool array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 3, "bool arr count = 3") + TkAssertEq%(DaType(da, 0), DaTypeBool, "elem 0 type = bool") + TkAssertEq%(DaType(da, 1), DaTypeBool, "elem 1 type = bool") + TkAssertEq&(DaGet&(da, 0), 1, "elem 0 = 1 (true)") + TkAssertEq&(DaGet&(da, 1), 0, "elem 1 = 0 (false)") + TkAssertEq&(DaGet&(da, 2), 1, "elem 2 = 1 (true)") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 5: Array with nulls ============== *} + +PRINT "-- Test 5: Array with nulls" +src$ = "[null, null]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse null array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 2, "null arr count = 2") + TkAssertEq%(DaType(da, 0), DaTypeNull, "elem 0 type = null") + TkAssertEq%(DaType(da, 1), DaTypeNull, "elem 1 type = null") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 6: Mixed-type array ============== *} + +PRINT "-- Test 6: Mixed-type array" +src$ = "[" + q$ + "hi" + q$ + ", 42, true, null]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse mixed array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 4, "mixed arr count = 4") + TkAssertEq%(DaType(da, 0), DaTypeStr, "elem 0 type = str") + TkAssertEq%(DaType(da, 1), DaTypeLng, "elem 1 type = lng") + TkAssertEq%(DaType(da, 2), DaTypeBool, "elem 2 type = bool") + TkAssertEq%(DaType(da, 3), DaTypeNull, "elem 3 type = null") + TkAssertEqStr(DaGet$(da, 0), "hi", "elem 0 = hi") + TkAssertEq&(DaGet&(da, 1), 42, "elem 1 = 42") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 7: Nested object inside array ============== *} + +PRINT "-- Test 7: Nested object inside array" +src$ = "[{" + q$ + "nm" + q$ + ":" + q$ + "Bob" + q$ + "}]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse arr with obj") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 1, "arr count = 1") + TkAssertEq%(DaType(da, 0), DaTypeRef, "elem 0 type = ref") + ref& = DaGetRef(da, 0) + TkAssertNeq&(ref&, 0, "ref not null") + IF ref& <> 0 THEN + innerHm = ref& + TkAssertEqStr(HmGet$(innerHm, "nm"), "Bob", "nm = Bob") + HmFree(innerHm) + FREE ref& + END IF + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 8: Nested array inside object ============== *} + +PRINT "-- Test 8: Nested array inside object" +src$ = "{" + q$ + "tg" + q$ + ":[" + q$ + "dev" + q$ + "," +src$ = src$ + q$ + "amg" + q$ + "]}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse obj with arr") +IF root& <> 0 THEN + hm = root& + TkAssertEq%(HmType(hm, "tg"), HmTypeRef, "tg type = ref") + ref& = HmGetRef(hm, "tg") + TkAssertNeq&(ref&, 0, "tg ref not null") + IF ref& <> 0 THEN + innerDa = ref& + TkAssertEq&(DaCount(innerDa), 2, "inner count = 2") + TkAssertEqStr(DaGet$(innerDa, 0), "dev", "tag 0 = dev") + TkAssertEqStr(DaGet$(innerDa, 1), "amg", "tag 1 = amg") + DaFree(innerDa) + FREE ref& + END IF + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 9: Nested array inside array ============== *} + +PRINT "-- Test 9: Nested array inside array" +src$ = "[[1, 2], [3, 4]]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse nested arrays") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 2, "outer count = 2") + TkAssertEq%(DaType(da, 0), DaTypeRef, "elem 0 type = ref") + TkAssertEq%(DaType(da, 1), DaTypeRef, "elem 1 type = ref") + + ref& = DaGetRef(da, 0) + IF ref& <> 0 THEN + innerDa = ref& + TkAssertEq&(DaCount(innerDa), 2, "inner0 count = 2") + TkAssertEq&(DaGet&(innerDa, 0), 1, "inner0[0] = 1") + TkAssertEq&(DaGet&(innerDa, 1), 2, "inner0[1] = 2") + DaFree(innerDa) + FREE ref& + END IF + + ref& = DaGetRef(da, 1) + IF ref& <> 0 THEN + innerDa = ref& + TkAssertEq&(DaCount(innerDa), 2, "inner1 count = 2") + TkAssertEq&(DaGet&(innerDa, 0), 3, "inner1[0] = 3") + TkAssertEq&(DaGet&(innerDa, 1), 4, "inner1[1] = 4") + DaFree(innerDa) + FREE ref& + END IF + + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 10: Deeply nested structure ============== *} + +PRINT "-- Test 10: Deeply nested structure" +' {"a":{"b":{"c":42}}} +src$ = "{" + q$ + "a" + q$ + ":{" + q$ + "b" + q$ + ":{" + q$ + "c" + q$ + ":42}}}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse deep nested") +IF root& <> 0 THEN + hm = root& + ref& = HmGetRef(hm, "a") + TkAssertNeq&(ref&, 0, "a ref not null") + IF ref& <> 0 THEN + DECLARE CLASS Hashmap midHm + midHm = ref& + LONGINT ref2& + ref2& = HmGetRef(midHm, "b") + TkAssertNeq&(ref2&, 0, "b ref not null") + IF ref2& <> 0 THEN + DECLARE CLASS Hashmap deepHm + deepHm = ref2& + TkAssertEq&(HmGet&(deepHm, "c"), 42, "c = 42") + HmFree(deepHm) + FREE ref2& + END IF + HmFree(midHm) + FREE ref& + END IF + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 11: Float values ============== *} + +PRINT "-- Test 11: Float values" +src$ = "{" + q$ + "pi" + q$ + ":3.14," +src$ = src$ + q$ + "ng" + q$ + ":-0.5," +src$ = src$ + q$ + "ex" + q$ + ":1.5e2}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse floats") +IF root& <> 0 THEN + hm = root& + TkAssertEq%(HmType(hm, "pi"), HmTypeSng, "pi type = sng") + TkAssertEq%(HmType(hm, "ng"), HmTypeSng, "ng type = sng") + TkAssertEq%(HmType(hm, "ex"), HmTypeSng, "ex type = sng") + + ' FFP precision is ~7 digits, use approximate checks + SINGLE piVal!, ngVal!, exVal! + piVal! = HmGet!(hm, "pi") + ngVal! = HmGet!(hm, "ng") + exVal! = HmGet!(hm, "ex") + + ' Check pi is roughly 3.14 + TkAssertTrue(piVal! > 3.0 AND piVal! < 3.2, "pi ~ 3.14") + ' Check ng is roughly -0.5 + TkAssertTrue(ngVal! < 0.0, "ng < 0") + ' Check ex is roughly 150 + TkAssertTrue(exVal! > 140.0 AND exVal! < 160.0, "ex ~ 150") + + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 12: Float values in array ============== *} + +PRINT "-- Test 12: Float values in array" +src$ = "[1.5, -2.7, 0.001]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse float array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 3, "float arr count = 3") + TkAssertEq%(DaType(da, 0), DaTypeSng, "elem 0 type = sng") + TkAssertEq%(DaType(da, 1), DaTypeSng, "elem 1 type = sng") + TkAssertEq%(DaType(da, 2), DaTypeSng, "elem 2 type = sng") + + SINGLE fv! + fv! = DaGet!(da, 0) + TkAssertTrue(fv! > 1.0 AND fv! < 2.0, "elem 0 ~ 1.5") + fv! = DaGet!(da, 1) + TkAssertTrue(fv! < -2.0 AND fv! > -3.0, "elem 1 ~ -2.7") + + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 13: TYPECASE on nested refs ============== *} + +PRINT "-- Test 13: TYPECASE on nested refs" +' {"obj":{"x":1},"arr":[2]} +src$ = "{" + q$ + "obj" + q$ + ":{" + q$ + "x" + q$ + ":1}," +src$ = src$ + q$ + "arr" + q$ + ":[2]}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse for typecase") +IF root& <> 0 THEN + hm = root& + + ' Check nested object via TYPECASE + ref& = HmGetRef(hm, "obj") + matched% = 0 + DECLARE CLASS Hashmap tcHm + tcHm = ref& + TYPECASE tcHm + CASE Hashmap + matched% = 1 + CASE DynArray + matched% = 2 + CASE ELSE + matched% = -1 + END TYPECASE + TkAssertEq%(matched%, 1, "obj ref = Hashmap") + + ' Check nested array via TYPECASE + ref& = HmGetRef(hm, "arr") + matched% = 0 + DECLARE CLASS Hashmap tcProbe + tcProbe = ref& + TYPECASE tcProbe + CASE Hashmap + matched% = 1 + CASE DynArray + matched% = 2 + CASE ELSE + matched% = -1 + END TYPECASE + TkAssertEq%(matched%, 2, "arr ref = DynArray") + + ' Clean up nested refs + ref& = HmGetRef(hm, "obj") + IF ref& <> 0 THEN + innerHm = ref& + HmFree(innerHm) + FREE ref& + END IF + ref& = HmGetRef(hm, "arr") + IF ref& <> 0 THEN + innerDa = ref& + DaFree(innerDa) + FREE ref& + END IF + + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 14: TYPECASE with narrowing ============== *} + +PRINT "-- Test 14: TYPECASE with narrowing" +' [{"k":99}] +src$ = "[{" + q$ + "k" + q$ + ":99}]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse for narrowing") +IF root& <> 0 THEN + da = root& + ref& = DaGetRef(da, 0) + DECLARE CLASS Hashmap nrProbe + nrProbe = ref& + LONGINT gotK& + gotK& = 0 + + TYPECASE nrProbe + CASE Hashmap + ' Narrowed: nrProbe is treated as Hashmap here + gotK& = HmGet&(nrProbe, "k") + CASE DynArray + gotK& = -1 + END TYPECASE + + TkAssertEq&(gotK&, 99, "narrowed k = 99") + + ' Cleanup + IF ref& <> 0 THEN + innerHm = ref& + HmFree(innerHm) + FREE ref& + END IF + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 15: Complex nested structure ============== *} + +PRINT "-- Test 15: Complex nested structure" +' {"items":[{"id":1},{"id":2}],"total":2} +src$ = "{" + q$ + "items" + q$ + ":[{" +src$ = src$ + q$ + "id" + q$ + ":1},{" +src$ = src$ + q$ + "id" + q$ + ":2}]," +src$ = src$ + q$ + "total" + q$ + ":2}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse complex nested") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmGet&(hm, "total"), 2, "total = 2") + ref& = HmGetRef(hm, "items") + TkAssertNeq&(ref&, 0, "items ref not null") + IF ref& <> 0 THEN + innerDa = ref& + TkAssertEq&(DaCount(innerDa), 2, "items count = 2") + + LONGINT itemRef& + itemRef& = DaGetRef(innerDa, 0) + IF itemRef& <> 0 THEN + DECLARE CLASS Hashmap item0 + item0 = itemRef& + TkAssertEq&(HmGet&(item0, "id"), 1, "item 0 id = 1") + HmFree(item0) + FREE itemRef& + END IF + + itemRef& = DaGetRef(innerDa, 1) + IF itemRef& <> 0 THEN + DECLARE CLASS Hashmap item1 + item1 = itemRef& + TkAssertEq&(HmGet&(item1, "id"), 2, "item 1 id = 2") + HmFree(item1) + FREE itemRef& + END IF + + DaFree(innerDa) + FREE ref& + END IF + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 16: Depth limit error ============== *} + +PRINT "-- Test 16: Depth limit error" +' Build 11 levels of nesting: [[[[[[[[[[[ ]]]]]]]]]]] +src$ = "[[[[[[[[[[[" +src$ = src$ + q$ + "deep" + q$ +src$ = src$ + "]]]]]]]]]]]" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "depth limit -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "depth limit -> error msg") + +{* ============== Test 17: Whitespace in arrays ============== *} + +PRINT "-- Test 17: Whitespace in arrays" +src$ = " [ 1 , 2 , 3 ] " +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse ws array") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 3, "ws arr count = 3") + TkAssertEq&(DaGet&(da, 0), 1, "ws elem 0 = 1") + TkAssertEq&(DaGet&(da, 1), 2, "ws elem 1 = 2") + TkAssertEq&(DaGet&(da, 2), 3, "ws elem 2 = 3") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 18: Integer/float discrimination ============== *} + +PRINT "-- Test 18: Integer/float discrimination" +src$ = "[42, 3.14]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse int/float mix") +IF root& <> 0 THEN + da = root& + TkAssertEq%(DaType(da, 0), DaTypeLng, "42 type = lng") + TkAssertEq%(DaType(da, 1), DaTypeSng, "3.14 type = sng") + TkAssertEq&(DaGet&(da, 0), 42, "42 val = 42") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_parse_misc.b b/submods/json/test_parse_misc.b new file mode 100644 index 0000000..57a66d3 --- /dev/null +++ b/submods/json/test_parse_misc.b @@ -0,0 +1,352 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_parse_misc.b - Phase 3: Escapes, file input, error edge cases +** Tests: string escapes, JsParseFile, error conditions +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 3: Escapes, File Input, Errors ===" +PRINT + +TkInit + +STRING src$ SIZE 4096 +STRING errMsg$ SIZE 128 +STRING q$ SIZE 4 +q$ = CHR$(34) +STRING bsl$ SIZE 4 +bsl$ = CHR$(92) + +LONGINT root& +DECLARE CLASS Hashmap hm +DECLARE CLASS DynArray da +STRING got$ SIZE 256 +STRING exp$ SIZE 256 + +{* ============== Test 1: Escaped quotes ============== *} + +PRINT "-- Test 1: Escaped quotes in string" +' JSON: {"msg":"say \"hi\""} +src$ = "{" + q$ + "msg" + q$ + ":" + q$ + "say " + bsl$ + q$ + "hi" + bsl$ + q$ + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc quote") +IF root& <> 0 THEN + hm = root& + got$ = HmGet$(hm, "msg") + exp$ = "say " + q$ + "hi" + q$ + TkAssertEqStr(got$, exp$, "msg = say qhiq") + TkAssertEq&(LEN(got$), 8, "esc quote len = 8") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 2: Escaped backslash ============== *} + +PRINT "-- Test 2: Escaped backslash" +' JSON: {"p":"c:\\dir"} +src$ = "{" + q$ + "p" + q$ + ":" + q$ + "c:" + bsl$ + bsl$ + "dir" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc backslash") +IF root& <> 0 THEN + hm = root& + got$ = HmGet$(hm, "p") + exp$ = "c:" + bsl$ + "dir" + TkAssertEqStr(got$, exp$, "p = c bsl dir") + TkAssertEq&(LEN(got$), 6, "esc bsl len = 6") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 3: Escaped newline and tab ============== *} + +PRINT "-- Test 3: Escaped newline and tab" +' JSON: {"s":"a\nb\tc"} +src$ = "{" + q$ + "s" + q$ + ":" + q$ + "a" + bsl$ + "nb" + bsl$ + "tc" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc nl/tab") +IF root& <> 0 THEN + hm = root& + got$ = HmGet$(hm, "s") + exp$ = "a" + CHR$(10) + "b" + CHR$(9) + "c" + TkAssertEqStr(got$, exp$, "s = a LF b TAB c") + TkAssertEq&(LEN(got$), 5, "esc nl/tab len = 5") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 4: Escaped CR, BS, FF ============== *} + +PRINT "-- Test 4: Escaped CR, BS, FF" +' JSON: {"s":"x\ry\bz\fw"} +src$ = "{" + q$ + "s" + q$ + ":" + q$ + "x" + bsl$ + "r" +src$ = src$ + "y" + bsl$ + "b" + "z" + bsl$ + "f" + "w" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc cr/bs/ff") +IF root& <> 0 THEN + hm = root& + got$ = HmGet$(hm, "s") + TkAssertEq&(LEN(got$), 7, "esc cr/bs/ff len = 7") + ' Check specific bytes via PEEK + LONGINT addr& + addr& = SADD(got$) + TkAssertEq%(PEEK(addr&), 120, "byte 0 = x (120)") + TkAssertEq%(PEEK(addr& + 1), 13, "byte 1 = CR (13)") + TkAssertEq%(PEEK(addr& + 2), 121, "byte 2 = y (121)") + TkAssertEq%(PEEK(addr& + 3), 8, "byte 3 = BS (8)") + TkAssertEq%(PEEK(addr& + 4), 122, "byte 4 = z (122)") + TkAssertEq%(PEEK(addr& + 5), 12, "byte 5 = FF (12)") + TkAssertEq%(PEEK(addr& + 6), 119, "byte 6 = w (119)") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 5: Escaped slash ============== *} + +PRINT "-- Test 5: Escaped slash" +' JSON: {"u":"a\/b"} +src$ = "{" + q$ + "u" + q$ + ":" + q$ + "a" + bsl$ + "/b" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc slash") +IF root& <> 0 THEN + hm = root& + TkAssertEqStr(HmGet$(hm, "u"), "a/b", "u = a/b") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 6: Multiple escapes in one string ============== *} + +PRINT "-- Test 6: Multiple escapes" +' JSON: {"s":"a\"b\\c\/d"} +src$ = "{" + q$ + "s" + q$ + ":" + q$ +src$ = src$ + "a" + bsl$ + q$ + "b" + bsl$ + bsl$ + "c" + bsl$ + "/d" +src$ = src$ + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse multi esc") +IF root& <> 0 THEN + hm = root& + got$ = HmGet$(hm, "s") + exp$ = "a" + q$ + "b" + bsl$ + "c/d" + TkAssertEqStr(got$, exp$, "multi esc val") + TkAssertEq&(LEN(got$), 7, "multi esc len = 7") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 7: Empty string value ============== *} + +PRINT "-- Test 7: Empty string value" +src$ = "{" + q$ + "e" + q$ + ":" + q$ + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse empty str") +IF root& <> 0 THEN + hm = root& + TkAssertEqStr(HmGet$(hm, "e"), "", "e = empty") + TkAssertEq&(LEN(HmGet$(hm, "e")), 0, "empty len = 0") + TkAssertEq%(HmType(hm, "e"), HmTypeStr, "e type = str") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 8: Escaped quotes in array ============== *} + +PRINT "-- Test 8: Escaped quotes in array" +' JSON: ["say \"hi\"", "ok"] +src$ = "[" + q$ + "say " + bsl$ + q$ + "hi" + bsl$ + q$ + q$ + "," +src$ = src$ + q$ + "ok" + q$ + "]" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse arr esc quote") +IF root& <> 0 THEN + da = root& + TkAssertEq&(DaCount(da), 2, "arr esc count = 2") + got$ = DaGet$(da, 0) + exp$ = "say " + q$ + "hi" + q$ + TkAssertEqStr(got$, exp$, "arr[0] = say qhiq") + TkAssertEqStr(DaGet$(da, 1), "ok", "arr[1] = ok") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 9: JsParseFile - simple ============== *} + +PRINT "-- Test 9: JsParseFile simple" +' Write JSON to temp file +OPEN "O", #1, "T:test_json.tmp" +src$ = "{" + q$ + "nm" + q$ + ":" + q$ + "Bob" + q$ + "}" +PRINT #1, src$ +CLOSE #1 + +' Read back via JsParseFile +OPEN "I", #1, "T:test_json.tmp" +root& = JsParseFile(1) +CLOSE #1 + +TkAssertNeq&(root&, 0, "parsefile not null") +IF root& <> 0 THEN + TkAssertEq%(JsRootType, JsObject, "pf root = object") + hm = root& + TkAssertEqStr(HmGet$(hm, "nm"), "Bob", "pf nm = Bob") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 10: JsParseFile - multi-line ============== *} + +PRINT "-- Test 10: JsParseFile multi-line" +OPEN "O", #1, "T:test_json2.tmp" +PRINT #1, "{" +PRINT #1, " "; q$; "x"; q$; ": 10," +PRINT #1, " "; q$; "y"; q$; ": 20" +PRINT #1, "}" +CLOSE #1 + +OPEN "I", #1, "T:test_json2.tmp" +root& = JsParseFile(1) +CLOSE #1 + +TkAssertNeq&(root&, 0, "pf multiline ok") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmGet&(hm, "x"), 10, "pf x = 10") + TkAssertEq&(HmGet&(hm, "y"), 20, "pf y = 20") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 11: JsParseFile - array ============== *} + +PRINT "-- Test 11: JsParseFile array" +OPEN "O", #1, "T:test_json3.tmp" +src$ = "[1, 2, 3]" +PRINT #1, src$ +CLOSE #1 + +OPEN "I", #1, "T:test_json3.tmp" +root& = JsParseFile(1) +CLOSE #1 + +TkAssertNeq&(root&, 0, "pf array ok") +IF root& <> 0 THEN + TkAssertEq%(JsRootType, JsArray, "pf root = array") + da = root& + TkAssertEq&(DaCount(da), 3, "pf arr count = 3") + TkAssertEq&(DaGet&(da, 0), 1, "pf arr[0] = 1") + TkAssertEq&(DaGet&(da, 1), 2, "pf arr[1] = 2") + TkAssertEq&(DaGet&(da, 2), 3, "pf arr[2] = 3") + DaFree(da) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 12: Error - unexpected EOF ============== *} + +PRINT "-- Test 12: Error - unexpected EOF" +src$ = "{" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "unexp EOF -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "unexp EOF -> error msg") + +{* ============== Test 13: Error - invalid literal ============== *} + +PRINT "-- Test 13: Error - invalid literal" +src$ = "{" + q$ + "x" + q$ + ":tru}" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "bad literal -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "bad literal -> error msg") + +{* ============== Test 14: Error - missing close bracket ============== *} + +PRINT "-- Test 14: Error - missing close bracket" +src$ = "[1, 2, 3" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "no close -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "no close -> error msg") + +{* ============== Test 15: Error - empty input ============== *} + +PRINT "-- Test 15: Error - empty input" +src$ = "" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "empty -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "empty -> error msg") + +{* ============== Test 16: Whitespace with newlines and tabs ============== *} + +PRINT "-- Test 16: Whitespace with newlines and tabs" +src$ = "{" + CHR$(10) + CHR$(9) + q$ + "k" + q$ + " :" + CHR$(10) + " 42" + CHR$(10) + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse ws nl/tab") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmGet&(hm, "k"), 42, "ws nl/tab k = 42") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 17: Escaped key name ============== *} + +PRINT "-- Test 17: Escaped key name" +' JSON: {"a\"b":1} +src$ = "{" + q$ + "a" + bsl$ + q$ + "b" + q$ + ":1}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse esc key") +IF root& <> 0 THEN + hm = root& + exp$ = "a" + q$ + "b" + TkAssertEq&(HmGet&(hm, exp$), 1, "esc key val = 1") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_parse_obj.b b/submods/json/test_parse_obj.b new file mode 100644 index 0000000..efe88a2 --- /dev/null +++ b/submods/json/test_parse_obj.b @@ -0,0 +1,236 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_parse_obj.b - Phase 1: Parse JSON objects with scalar values +** Tests: JsParse, JsError$, JsRootType +** Value types: string, integer, boolean, null +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 1: Parse JSON Objects ===" +PRINT + +TkInit + +STRING src$ SIZE 4096 +STRING errMsg$ SIZE 128 +STRING q$ SIZE 4 +q$ = CHR$(34) + +LONGINT root& +DECLARE CLASS Hashmap hm + +{* ============== Test 1: Empty object ============== *} + +PRINT "-- Test 1: Empty object" +src$ = "{}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse {} not null") +IF root& <> 0 THEN + TkAssertEq%(JsRootType, JsObject, "root type = object") + hm = root& + TkAssertEq&(HmCount(hm), 0, "empty count = 0") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 2: Single string ============== *} + +PRINT "-- Test 2: Single string" +src$ = "{" + q$ + "city" + q$ + ":" + q$ + "Berlin" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse single str") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 1, "count = 1") + TkAssertEqStr(HmGet$(hm, "city"), "Berlin", "city = Berlin") + TkAssertEq%(HmType(hm, "city"), HmTypeStr, "city type = str") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 3: Multiple strings ============== *} + +PRINT "-- Test 3: Multiple strings" +src$ = "{" + q$ + "a" + q$ + ":" + q$ + "one" + q$ + "," +src$ = src$ + q$ + "b" + q$ + ":" + q$ + "two" + q$ + "}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse multi str") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 2, "count = 2") + TkAssertEqStr(HmGet$(hm, "a"), "one", "a = one") + TkAssertEqStr(HmGet$(hm, "b"), "two", "b = two") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 4: Integer values ============== *} + +PRINT "-- Test 4: Integer values" +src$ = "{" + q$ + "pos" + q$ + ":42," +src$ = src$ + q$ + "neg" + q$ + ":-7," +src$ = src$ + q$ + "zero" + q$ + ":0}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse integers") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 3, "count = 3") + TkAssertEq&(HmGet&(hm, "pos"), 42, "pos = 42") + TkAssertEq&(HmGet&(hm, "neg"), -7, "neg = -7") + TkAssertEq&(HmGet&(hm, "zero"), 0, "zero = 0") + TkAssertEq%(HmType(hm, "pos"), HmTypeLng, "pos type = lng") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 5: Boolean values ============== *} + +PRINT "-- Test 5: Boolean values" +src$ = "{" + q$ + "on" + q$ + ":true," +src$ = src$ + q$ + "off" + q$ + ":false}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse booleans") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 2, "count = 2") + TkAssertEq%(HmType(hm, "on"), HmTypeBool, "on type = bool") + TkAssertEq%(HmType(hm, "off"), HmTypeBool, "off type = bool") + TkAssertEq&(HmGet&(hm, "on"), 1, "on = 1 (true)") + TkAssertEq&(HmGet&(hm, "off"), 0, "off = 0 (false)") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 6: Null value ============== *} + +PRINT "-- Test 6: Null value" +src$ = "{" + q$ + "gone" + q$ + ":null}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse null") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 1, "count = 1") + TkAssertEq%(HmType(hm, "gone"), HmTypeNull, "gone type = null") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 7: Mixed types ============== *} + +PRINT "-- Test 7: Mixed types" +src$ = "{" + q$ + "nm" + q$ + ":" + q$ + "Alice" + q$ + "," +src$ = src$ + q$ + "ag" + q$ + ":30," +src$ = src$ + q$ + "ok" + q$ + ":true," +src$ = src$ + q$ + "rm" + q$ + ":null}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse mixed") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmCount(hm), 4, "count = 4") + TkAssertEqStr(HmGet$(hm, "nm"), "Alice", "nm = Alice") + TkAssertEq&(HmGet&(hm, "ag"), 30, "ag = 30") + TkAssertEq%(HmType(hm, "ok"), HmTypeBool, "ok type = bool") + TkAssertEq%(HmType(hm, "rm"), HmTypeNull, "rm type = null") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 8: Whitespace tolerance ============== *} + +PRINT "-- Test 8: Whitespace tolerance" +src$ = " { " + q$ + "x" + q$ + " : " + q$ + "y" + q$ + " } " +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse with whitespace") +IF root& <> 0 THEN + hm = root& + TkAssertEqStr(HmGet$(hm, "x"), "y", "x = y") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Test 9: Error - missing colon ============== *} + +PRINT "-- Test 9: Error - missing colon" +src$ = "{" + q$ + "x" + q$ + " " + q$ + "y" + q$ + "}" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "missing colon -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "missing colon -> error msg") + +{* ============== Test 10: Error - unterminated string ============== *} + +PRINT "-- Test 10: Error - unterminated string" +src$ = "{" + q$ + "x" + q$ + ":" + q$ + "hello}" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "unterm string -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "unterm string -> error msg") + +{* ============== Test 11: Error - trailing comma ============== *} + +PRINT "-- Test 11: Error - trailing comma" +src$ = "{" + q$ + "x" + q$ + ":1,}" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "trailing comma -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "trailing comma -> error msg") + +{* ============== Test 12: Error - invalid input ============== *} + +PRINT "-- Test 12: Error - invalid input" +src$ = "hello" +root& = JsParse(src$) +TkAssertEq&(root&, 0, "invalid input -> null") +errMsg$ = JsError$ +TkAssertTrue(LEN(errMsg$) > 0, "invalid input -> error msg") + +{* ============== Test 13: Large integer ============== *} + +PRINT "-- Test 13: Large integer" +src$ = "{" + q$ + "big" + q$ + ":1000000}" +root& = JsParse(src$) +TkAssertNeq&(root&, 0, "parse large int") +IF root& <> 0 THEN + hm = root& + TkAssertEq&(HmGet&(hm, "big"), 1000000, "big = 1000000") + HmFree(hm) + FREE root& +ELSE + errMsg$ = JsError$ + PRINT " Error: "; errMsg$ +END IF + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_roundtrip.b b/submods/json/test_roundtrip.b new file mode 100644 index 0000000..4f5f47a --- /dev/null +++ b/submods/json/test_roundtrip.b @@ -0,0 +1,350 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/json/json.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_roundtrip.b - Phase 5: Pretty printer + round-trip +** Tests: JsWriteFmt, parse->generate->compare +** Note: JsFree not yet implemented (Phase 6), parsed trees are leaked. +*} + +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 5: Pretty Printer + Round-Trip ===" +PRINT + +TkInit + +STRING result$ SIZE 4096 +STRING expected$ SIZE 4096 +STRING src$ SIZE 4096 +STRING ln$ SIZE 512 +STRING q$ SIZE 4 +q$ = CHR$(34) + +LONGINT root&, root2& +DECLARE CLASS Hashmap hm +DECLARE CLASS DynArray da + +{* ============== Test 1: Fmt empty object ============== *} + +PRINT "-- Test 1: Fmt empty object" +HmMake(hm, HM_SMALL) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(hm, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +CLOSE #1 +TkAssertEqStr(ln$, "{}", "fmt empty obj") +HmFree(hm) + +{* ============== Test 2: Fmt empty array ============== *} + +PRINT "-- Test 2: Fmt empty array" +DaMake(da, DA_SMALL) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(da, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +CLOSE #1 +TkAssertEqStr(ln$, "[]", "fmt empty arr") +DaFree(da) + +{* ============== Test 3: Fmt single-key object ============== *} + +PRINT "-- Test 3: Fmt single-key object" +HmMake(hm, HM_SMALL) +HmPut$(hm, "city", "Berlin") +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(hm, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "{", "fmt obj L1 {") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "city" + q$ + ": " + q$ + "Berlin" + q$ +TkAssertEqStr(ln$, expected$, "fmt obj L2 kv") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "}", "fmt obj L3 }") +CLOSE #1 +HmFree(hm) + +{* ============== Test 4: Fmt integer array ============== *} + +PRINT "-- Test 4: Fmt integer array" +DaMake(da, DA_SMALL) +DaAppend&(da, 10) +DaAppend&(da, 20) +DaAppend&(da, 30) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(da, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "[", "fmt arr L1 [") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " 10,", "fmt arr L2 10,") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " 20,", "fmt arr L3 20,") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " 30", "fmt arr L4 30") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "]", "fmt arr L5 ]") +CLOSE #1 +DaFree(da) + +{* ============== Test 5: Fmt nested array in object ============== *} + +PRINT "-- Test 5: Fmt nested array in object" +DaMake(da, DA_SMALL) +DaAppend&(da, 1) +DaAppend&(da, 2) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "arr", da) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(hm, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "{", "fmt nest L1 {") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "arr" + q$ + ": [" +TkAssertEqStr(ln$, expected$, "fmt nest L2 arr:[") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " 1,", "fmt nest L3 1,") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " 2", "fmt nest L4 2") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " ]", "fmt nest L5 ]") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "}", "fmt nest L6 }") +CLOSE #1 +DaFree(da) +HmFree(hm) + +{* ============== Test 6: Fmt nested object in object ============== *} + +PRINT "-- Test 6: Fmt nested object in object" +DECLARE CLASS Hashmap inner +HmMake(inner, HM_SMALL) +HmPut&(inner, "x", 99) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "obj", inner) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(hm, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "{", "fmt nobj L1 {") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "obj" + q$ + ": {" +TkAssertEqStr(ln$, expected$, "fmt nobj L2 obj:{") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "x" + q$ + ": 99" +TkAssertEqStr(ln$, expected$, "fmt nobj L3 x:99") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " }", "fmt nobj L4 }") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "}", "fmt nobj L5 }") +CLOSE #1 +HmFree(inner) +HmFree(hm) + +{* ============== Test 7: Fmt bool/null array ============== *} + +PRINT "-- Test 7: Fmt bool/null array" +DaMake(da, DA_SMALL) +DaAppendBool(da, -1) +DaAppendNull(da) +DaAppendBool(da, 0) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(da, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "[", "fmt bnl L1") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " true,", "fmt bnl L2") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " null,", "fmt bnl L3") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " false", "fmt bnl L4") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "]", "fmt bnl L5") +CLOSE #1 +DaFree(da) + +{* ============== Test 8: Compact round-trip int array ============== *} + +PRINT "-- Test 8: Compact round-trip int array" +src$ = "[1,-2,0,999]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt intarr parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt intarr match") + +{* ============== Test 9: Compact round-trip string array ============== *} + +PRINT "-- Test 9: Compact round-trip string array" +src$ = "[" + q$ + "aaa" + q$ + "," + q$ + "bbb" + q$ + "]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt strarr parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt strarr match") + +{* ============== Test 10: Compact round-trip mixed array ============== *} + +PRINT "-- Test 10: Compact round-trip mixed array" +src$ = "[42," + q$ + "hi" + q$ + ",true,false,null]" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt mixarr parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt mixarr match") + +{* ============== Test 11: Compact round-trip single-key obj ============== *} + +PRINT "-- Test 11: Compact round-trip single-key object" +src$ = "{" + q$ + "n" + q$ + ":42}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt 1key parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt 1key match") + +{* ============== Test 12: Compact round-trip string escapes ============== *} + +PRINT "-- Test 12: Compact round-trip string escapes" +' Input: {"k":"a\"b\\c"} +src$ = "{" + q$ + "k" + q$ + ":" + q$ + "a\" + q$ + "b\\c" + q$ + "}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt esc parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt esc match") + +{* ============== Test 13: Compact round-trip nested ============== *} + +PRINT "-- Test 13: Compact round-trip nested" +' Single-key objects preserve order -> string comparison works +src$ = "{" + q$ + "a" + q$ + ":[1,2]}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "rt nest parse") +result$ = JsToStr$(root&) +TkAssertEqStr(result$, src$, "rt nest match") + +{* ============== Test 14: Fmt round-trip (format then parse back) ============== *} + +PRINT "-- Test 14: Fmt round-trip array" +DaMake(da, DA_SMALL) +DaAppend$(da, "hello") +DaAppend&(da, 42) +DaAppendBool(da, -1) +OPEN "O", #1, "T:jsfmt_rt.json" +JsWriteFmt(da, 1) +CLOSE #1 +DaFree(da) + +' Parse the formatted output back +OPEN "I", #1, "T:jsfmt_rt.json" +root& = JsParseFile(1) +CLOSE #1 +TkAssertTrue(root& <> 0, "fmt rt parse ok") + +DECLARE CLASS DynArray da2 +da2 = root& +TkAssertEq&(DaCount(da2), 3, "fmt rt count") +TkAssertEqStr(DaGet$(da2, 0), "hello", "fmt rt str") +TkAssertEq&(DaGet&(da2, 1), 42, "fmt rt int") +TkAssertEq&(DaGet&(da2, 2), 1, "fmt rt bool") + +{* ============== Test 15: Fmt round-trip object ============== *} + +PRINT "-- Test 15: Fmt round-trip object" +HmMake(hm, HM_SMALL) +HmPut$(hm, "msg", "ok") +HmPut&(hm, "code", 200) +HmPutBool(hm, "flag", 0) +HmPutNull(hm, "nil") +OPEN "O", #1, "T:jsfmt_rt.json" +JsWriteFmt(hm, 1) +CLOSE #1 +HmFree(hm) + +' Parse back +OPEN "I", #1, "T:jsfmt_rt.json" +root& = JsParseFile(1) +CLOSE #1 +TkAssertTrue(root& <> 0, "fmt rt obj parse") + +DECLARE CLASS Hashmap doc +doc = root& +TkAssertEqStr(HmGet$(doc, "msg"), "ok", "fmt rt obj str") +TkAssertEq&(HmGet&(doc, "code"), 200, "fmt rt obj int") +TkAssertTrue(HmHas(doc, "flag"), "fmt rt obj has flag") +TkAssertEq%(HmType(doc, "nil"), HmTypeNull, "fmt rt obj null") + +{* ============== Test 16: Type preservation after round-trip ============== *} + +PRINT "-- Test 16: Type preservation" +src$ = "{" + q$ + "i" + q$ + ":7," + q$ + "b" + q$ + ":true," +src$ = src$ + q$ + "n" + q$ + ":null}" +root& = JsParse(src$) +TkAssertTrue(root& <> 0, "tp parse ok") + +doc = root& +TkAssertEq%(HmType(doc, "i"), HmTypeLng, "tp int type") +TkAssertEq%(HmType(doc, "b"), HmTypeBool, "tp bool type") +TkAssertEq%(HmType(doc, "n"), HmTypeNull, "tp null type") + +' Generate and parse again +result$ = JsToStr$(root&) +root2& = JsParse(result$) +TkAssertTrue(root2& <> 0, "tp reparse ok") +doc = root2& +TkAssertEq%(HmType(doc, "i"), HmTypeLng, "tp2 int type") +TkAssertEq&(HmGet&(doc, "i"), 7, "tp2 int val") +TkAssertEq%(HmType(doc, "b"), HmTypeBool, "tp2 bool type") +TkAssertEq%(HmType(doc, "n"), HmTypeNull, "tp2 null type") + +{* ============== Test 17: Deep nesting pretty-print ============== *} + +PRINT "-- Test 17: Deep nesting pretty-print" +' Build: {"d":[{"v":7}]} +DECLARE CLASS Hashmap deep +HmMake(deep, HM_SMALL) +HmPut&(deep, "v", 7) +DaMake(da, DA_SMALL) +DaAppendRef(da, deep) +HmMake(hm, HM_SMALL) +HmPutRef(hm, "d", da) +OPEN "O", #1, "T:jsfmt.txt" +JsWriteFmt(hm, 1) +CLOSE #1 +OPEN "I", #1, "T:jsfmt.txt" +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "{", "fmt deep L1") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "d" + q$ + ": [" +TkAssertEqStr(ln$, expected$, "fmt deep L2") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " {", "fmt deep L3") +LINE INPUT #1, ln$ +expected$ = " " + q$ + "v" + q$ + ": 7" +TkAssertEqStr(ln$, expected$, "fmt deep L4") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " }", "fmt deep L5") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, " ]", "fmt deep L6") +LINE INPUT #1, ln$ +TkAssertEqStr(ln$, "}", "fmt deep L7") +CLOSE #1 +HmFree(deep) +DaFree(da) +HmFree(hm) + +{* ============== Summary ============== *} +TkSummary diff --git a/submods/json/test_typecase.b b/submods/json/test_typecase.b new file mode 100644 index 0000000..d021ddf --- /dev/null +++ b/submods/json/test_typecase.b @@ -0,0 +1,168 @@ +REM #using ace:submods/hashmap/hashmap.o +REM #using ace:submods/dynarray/dynarray.o +REM #using ace:submods/testkit/testkit.o + +{* +** test_typecase.b - Phase 0: Verify CLASS descriptor stamping +** Tests that ALLOC'd Hashmap and DynArray instances (from builders) +** have proper descriptors for TYPECASE discrimination. +*} + +#include +#include +#include + +{* ============== Test Suite ============== *} + +PRINT "=== Phase 0: TYPECASE Descriptor Stamping ===" +PRINT + +TkInit + +LONGINT hmAddr&, daAddr& + +{* ============== Test 1: TYPECASE on builder Hashmap ============== *} + +PRINT "-- Test 1: TYPECASE on builder Hashmap" +HmNew(HM_SMALL) + HmAdd$("key", "val") +hmAddr& = HmEnd + +DECLARE CLASS Hashmap hm +hm = hmAddr& + +SHORTINT matched% +matched% = 0 + +TYPECASE hm + CASE Hashmap + matched% = 1 + CASE DynArray + matched% = 2 + CASE ELSE + matched% = -1 +END TYPECASE + +TkAssertEq%(matched%, 1, "builder Hashmap matches CASE Hashmap") + +' Verify it still works as a Hashmap +TkAssertEqStr(HmGet$(hm, "key"), "val", "Hashmap data intact") + +HmFree(hm) +FREE hmAddr& + +{* ============== Test 2: TYPECASE on builder DynArray ============== *} + +PRINT "-- Test 2: TYPECASE on builder DynArray" +DaNew(DA_SMALL) + DaAdd$("hello") +daAddr& = DaEnd + +DECLARE CLASS DynArray da +da = daAddr& + +matched% = 0 + +TYPECASE da + CASE Hashmap + matched% = 1 + CASE DynArray + matched% = 2 + CASE ELSE + matched% = -1 +END TYPECASE + +TkAssertEq%(matched%, 2, "builder DynArray matches CASE DynArray") + +' Verify it still works as a DynArray +TkAssertEqStr(DaGet$(da, 0), "hello", "DynArray data intact") + +DaFree(da) +FREE daAddr& + +{* ============== Test 3: Discriminate via common variable ============== *} + +PRINT "-- Test 3: Discriminate Hashmap vs DynArray" +HmNew(HM_SMALL) + HmAdd&("num", 42) +hmAddr& = HmEnd + +DaNew(DA_SMALL) + DaAdd&(99) +daAddr& = DaEnd + +' Use Hashmap variable but assign DynArray address +DECLARE CLASS Hashmap probe +SHORTINT result% + +' Test with Hashmap address +probe = hmAddr& +result% = 0 +TYPECASE probe + CASE Hashmap + result% = 1 + CASE DynArray + result% = 2 + CASE ELSE + result% = -1 +END TYPECASE +TkAssertEq%(result%, 1, "hmAddr matches Hashmap") + +' Test with DynArray address +probe = daAddr& +result% = 0 +TYPECASE probe + CASE Hashmap + result% = 1 + CASE DynArray + result% = 2 + CASE ELSE + result% = -1 +END TYPECASE +TkAssertEq%(result%, 2, "daAddr matches DynArray") + +' Cleanup +hm = hmAddr& +HmFree(hm) +FREE hmAddr& + +da = daAddr& +DaFree(da) +FREE daAddr& + +{* ============== Test 4: BSS-backed instances still work ============== *} + +PRINT "-- Test 4: BSS-backed CLASS instances" +DECLARE CLASS Hashmap bssHm +DECLARE CLASS DynArray bssDa + +HmMake(bssHm, HM_SMALL) +DaMake(bssDa, DA_SMALL) + +' TYPECASE on BSS Hashmap +probe = bssHm +result% = 0 +TYPECASE probe + CASE Hashmap + result% = 1 + CASE DynArray + result% = 2 +END TYPECASE +TkAssertEq%(result%, 1, "BSS Hashmap matches Hashmap") + +' TYPECASE on BSS DynArray +probe = bssDa +result% = 0 +TYPECASE probe + CASE Hashmap + result% = 1 + CASE DynArray + result% = 2 +END TYPECASE +TkAssertEq%(result%, 2, "BSS DynArray matches DynArray") + +HmFree(bssHm) +DaFree(bssDa) + +{* ============== Summary ============== *} +TkSummary diff --git a/verify/scripts/otherthenamiga/call-on-ustartup b/verify/scripts/otherthenamiga/call-on-ustartup index 139597f..1431e92 100644 --- a/verify/scripts/otherthenamiga/call-on-ustartup +++ b/verify/scripts/otherthenamiga/call-on-ustartup @@ -1,2 +1,16 @@ +; Verify merged _JsWriteNode (compact + formatted) +cd ace:submods/json +; Recompile json module +execute make >ace:build-output.txt + +; Run all test suites +execute ACE:bin/bas test_free >>ace:build-output.txt +test_free >>ace:build-output.txt + +execute ACE:bin/bas test_roundtrip >>ace:build-output.txt +test_roundtrip >>ace:build-output.txt + +execute ACE:bin/bas test_gen >>ace:build-output.txt +test_gen >>ace:build-output.txt