diff --git a/stdlib/project.xml b/stdlib/project.xml index 14578cc..8187f02 100644 --- a/stdlib/project.xml +++ b/stdlib/project.xml @@ -9,4 +9,9 @@ + + blaise + testrunner.pas + + diff --git a/stdlib/src/main/pascal/json.parser.pas b/stdlib/src/main/pascal/json.parser.pas new file mode 100644 index 0000000..74261f4 --- /dev/null +++ b/stdlib/src/main/pascal/json.parser.pas @@ -0,0 +1,366 @@ +{ + Blaise stdlib - JSON parser + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Blaise stdlib - JSON parsing engine. + + TJSONParser is a recursive-descent parser that turns JSON text into the + Json.Types tree. Json.Reader is the thin GetJSON facade over it. + + Conformant to RFC 8259 for the value grammar: objects, arrays, strings (with + the escapes \" \\ \/ \b \f \n \r \t and \uXXXX, including surrogate pairs), + numbers (int/float discriminated by '.' / 'e'), and the true/false/null + literals. Malformed input raises EJSONParseError with the byte offset. + + Strings are UTF-8; \uXXXX escapes are decoded and re-encoded as UTF-8. +} + +unit Json.Parser; + +interface + +uses + SysUtils, StrUtils, Json.Types; + +type + EJSONParseError = class(Exception) + end; + + TJSONParser = class + private + FText: string; + FPos: Integer; + FLen: Integer; + procedure Fail(const AMsg: string); + procedure SkipWhitespace; + function Peek: Integer; { current byte, or -1 at end } + function ParseValue: TJSONData; + function ParseObject: TJSONObject; + function ParseArray: TJSONArray; + function ParseStringRaw: string; { consumes a "..." token } + function ParseHex4: Integer; { reads 4 hex digits after \u } + function ParseNumber: TJSONData; + function ParseLiteral: TJSONData; { true / false / null } + public + constructor Create(const AText: string); + { Parse the whole document; raises EJSONParseError on malformed input. } + function Parse: TJSONData; + end; + +implementation + +constructor TJSONParser.Create(const AText: string); +begin + FText := AText; + FPos := 0; + FLen := Length(AText); +end; + +procedure TJSONParser.Fail(const AMsg: string); +begin + raise EJSONParseError.Create(AMsg + ' at offset ' + IntToStr(FPos)); +end; + +function TJSONParser.Peek: Integer; +begin + if FPos < FLen then + Result := Byte(FText[FPos]) + else + Result := -1; +end; + +procedure TJSONParser.SkipWhitespace; +var + C: Integer; +begin + while FPos < FLen do + begin + C := Byte(FText[FPos]); + if (C = 32) or (C = 9) or (C = 10) or (C = 13) then + FPos := FPos + 1 + else + Exit; + end; +end; + +function TJSONParser.Parse: TJSONData; +begin + SkipWhitespace(); + Result := ParseValue(); + SkipWhitespace(); + if FPos < FLen then + Fail('trailing content after JSON value'); +end; + +function TJSONParser.ParseValue: TJSONData; +var + C: Integer; +begin + SkipWhitespace(); + C := Peek(); + if C = Ord('{') then + Result := ParseObject() + else if C = Ord('[') then + Result := ParseArray() + else if C = Ord('"') then + Result := TJSONString.Create(ParseStringRaw()) + else if (C = Ord('-')) or ((C >= Ord('0')) and (C <= Ord('9'))) then + Result := ParseNumber() + else if (C = Ord('t')) or (C = Ord('f')) or (C = Ord('n')) then + Result := ParseLiteral() + else + begin + Result := nil; + Fail('unexpected character'); + end; +end; + +function TJSONParser.ParseObject: TJSONObject; +var + Obj: TJSONObject; + Key: string; +begin + Obj := TJSONObject.Create(); + FPos := FPos + 1; { consume '{' } + SkipWhitespace(); + if Peek() = Ord('}') then + begin + FPos := FPos + 1; + Result := Obj; + Exit; + end; + while True do + begin + SkipWhitespace(); + if Peek() <> Ord('"') then + Fail('expected string key'); + Key := ParseStringRaw(); + SkipWhitespace(); + if Peek() <> Ord(':') then + Fail('expected '':'' after key'); + FPos := FPos + 1; { consume ':' } + Obj.Add(Key, ParseValue()); + SkipWhitespace(); + if Peek() = Ord(',') then + begin + FPos := FPos + 1; + Continue; + end; + if Peek() = Ord('}') then + begin + FPos := FPos + 1; + Break; + end; + Fail('expected '','' or ''}'' in object'); + end; + Result := Obj; +end; + +function TJSONParser.ParseArray: TJSONArray; +var + Arr: TJSONArray; +begin + Arr := TJSONArray.Create(); + FPos := FPos + 1; { consume '[' } + SkipWhitespace(); + if Peek() = Ord(']') then + begin + FPos := FPos + 1; + Result := Arr; + Exit; + end; + while True do + begin + Arr.Add(ParseValue()); + SkipWhitespace(); + if Peek() = Ord(',') then + begin + FPos := FPos + 1; + Continue; + end; + if Peek() = Ord(']') then + begin + FPos := FPos + 1; + Break; + end; + Fail('expected '','' or '']'' in array'); + end; + Result := Arr; +end; + +function JPHexVal(AByte: Integer): Integer; +begin + if (AByte >= Ord('0')) and (AByte <= Ord('9')) then + Result := AByte - Ord('0') + else if (AByte >= Ord('a')) and (AByte <= Ord('f')) then + Result := AByte - Ord('a') + 10 + else if (AByte >= Ord('A')) and (AByte <= Ord('F')) then + Result := AByte - Ord('A') + 10 + else + Result := -1; +end; + +{ Append codepoint ACP to ASB as UTF-8 bytes. } +procedure JPAppendUTF8(ASB: TStringBuilder; ACP: Integer); +begin + if ACP < $80 then + ASB.AppendByte(ACP) + else if ACP < $800 then + begin + ASB.AppendByte($C0 + (ACP div $40)); + ASB.AppendByte($80 + (ACP mod $40)); + end + else if ACP < $10000 then + begin + ASB.AppendByte($E0 + (ACP div $1000)); + ASB.AppendByte($80 + ((ACP div $40) mod $40)); + ASB.AppendByte($80 + (ACP mod $40)); + end + else + begin + ASB.AppendByte($F0 + (ACP div $40000)); + ASB.AppendByte($80 + ((ACP div $1000) mod $40)); + ASB.AppendByte($80 + ((ACP div $40) mod $40)); + ASB.AppendByte($80 + (ACP mod $40)); + end; +end; + +function TJSONParser.ParseHex4: Integer; +var + K, D, V: Integer; +begin + V := 0; + K := 0; + while K < 4 do + begin + if FPos >= FLen then + Fail('truncated \u escape'); + D := JPHexVal(Byte(FText[FPos])); + if D < 0 then + Fail('bad hex digit in \u escape'); + V := V * 16 + D; + FPos := FPos + 1; + K := K + 1; + end; + Result := V; +end; + +function TJSONParser.ParseStringRaw: string; +var + SB: TStringBuilder; + C: Integer; + Esc: Integer; + Hi: Integer; + Lo: Integer; +begin + SB := TStringBuilder.Create(); + FPos := FPos + 1; { consume opening '"' } + while True do + begin + if FPos >= FLen then + Fail('unterminated string'); + C := Byte(FText[FPos]); + FPos := FPos + 1; + if C = Ord('"') then + Break + else if C = Ord('\') then + begin + if FPos >= FLen then + Fail('unterminated escape'); + Esc := Byte(FText[FPos]); + FPos := FPos + 1; + if Esc = Ord('"') then SB.AppendByte(Ord('"')) + else if Esc = Ord('\') then SB.AppendByte(Ord('\')) + else if Esc = Ord('/') then SB.AppendByte(Ord('/')) + else if Esc = Ord('b') then SB.AppendByte(8) + else if Esc = Ord('f') then SB.AppendByte(12) + else if Esc = Ord('n') then SB.AppendByte(10) + else if Esc = Ord('r') then SB.AppendByte(13) + else if Esc = Ord('t') then SB.AppendByte(9) + else if Esc = Ord('u') then + begin + Hi := ParseHex4(); + if (Hi >= $D800) and (Hi <= $DBFF) then + begin + { high surrogate — expect a following \uLOW } + if (FPos + 1 < FLen) and (Byte(FText[FPos]) = Ord('\')) + and (Byte(FText[FPos + 1]) = Ord('u')) then + begin + FPos := FPos + 2; + Lo := ParseHex4(); + JPAppendUTF8(SB, $10000 + (Hi - $D800) * $400 + (Lo - $DC00)); + end + else + JPAppendUTF8(SB, Hi); + end + else + JPAppendUTF8(SB, Hi); + end + else + Fail('bad escape'); + end + else + SB.AppendByte(C); + end; + Result := SB.ToString(); + SB.Free(); +end; + +function TJSONParser.ParseNumber: TJSONData; +var + Start: Integer; + IsInt: Boolean; + C: Integer; + Lex: string; +begin + Start := FPos; + IsInt := True; + if Peek() = Ord('-') then + FPos := FPos + 1; + while FPos < FLen do + begin + C := Byte(FText[FPos]); + if (C >= Ord('0')) and (C <= Ord('9')) then + FPos := FPos + 1 + else if (C = Ord('.')) or (C = Ord('e')) or (C = Ord('E')) + or (C = Ord('+')) or (C = Ord('-')) then + begin + if (C = Ord('.')) or (C = Ord('e')) or (C = Ord('E')) then + IsInt := False; + FPos := FPos + 1; + end + else + Break; + end; + Lex := Copy(FText, Start, FPos - Start); + Result := TJSONNumber.CreateText(Lex, IsInt); +end; + +function TJSONParser.ParseLiteral: TJSONData; +begin + if (FPos + 4 <= FLen) and (Copy(FText, FPos, 4) = 'true') then + begin + FPos := FPos + 4; + Result := TJSONBoolean.Create(True); + end + else if (FPos + 5 <= FLen) and (Copy(FText, FPos, 5) = 'false') then + begin + FPos := FPos + 5; + Result := TJSONBoolean.Create(False); + end + else if (FPos + 4 <= FLen) and (Copy(FText, FPos, 4) = 'null') then + begin + FPos := FPos + 4; + Result := TJSONNull.Create(); + end + else + begin + Result := nil; + Fail('invalid literal'); + end; +end; + +end. diff --git a/stdlib/src/main/pascal/json.reader.pas b/stdlib/src/main/pascal/json.reader.pas new file mode 100644 index 0000000..cd0b16a --- /dev/null +++ b/stdlib/src/main/pascal/json.reader.pas @@ -0,0 +1,37 @@ +{ + Blaise stdlib - JSON reader + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Blaise stdlib - JSON reader facade. + + GetJSON parses a JSON document string into the Json.Types tree by driving the + Json.Parser engine. The caller owns the returned root (parent-owns-child); + releasing it frees the whole tree. EJSONParseError is raised on malformed + input. +} + +unit Json.Reader; + +interface + +uses + Json.Types, Json.Parser; + +{ Parse AText into a JSON tree. Raises EJSONParseError on malformed input. } +function GetJSON(const AText: string): TJSONData; + +implementation + +function GetJSON(const AText: string): TJSONData; +var + P: TJSONParser; +begin + P := TJSONParser.Create(AText); + Result := P.Parse(); + P.Free(); +end; + +end. diff --git a/stdlib/src/main/pascal/json.types.pas b/stdlib/src/main/pascal/json.types.pas new file mode 100644 index 0000000..ddb3d98 --- /dev/null +++ b/stdlib/src/main/pascal/json.types.pas @@ -0,0 +1,747 @@ +{ + Blaise stdlib - JSON document model (DOM) + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Blaise stdlib - the in-memory JSON document model. + + TJSONData is the abstract base; the concrete node types are TJSONNull, + TJSONBoolean, TJSONString, TJSONNumber, TJSONArray and TJSONObject. Both the + reader (Json.Parser / Json.Reader) and any code that builds a document by hand + target this one tree, so JSON round-trips through it. + + Building a document (the .NET-friendly tree API): + + Root := TJSONObject.Create(); + Root.Add('name', 'blaise'); // string field + Root.Add('version', Int64(12)); // integer field + Root.Add('stable', True); // boolean field + Arr := TJSONArray.Create(); + Arr.Add('DEBUG'); Arr.Add('UNIX'); // array elements + Root.Add('defines', Arr); // nested array (Root adopts Arr) + WriteLn(Root.FormatJSON()); // pretty + WriteLn(Root.AsJSON()); // compact + + Memory model: parent-owns-child. Containers hold STRONG references to their + children, so under Blaise ARC, releasing the root recursively releases the + whole tree. Every Add() overload that takes a TJSONData *adopts* the node: + never Add the same node to two parents, and never Add a node you also keep a + separate owning reference to and free yourself. Use Extract() to move a node + out of one parent before placing it in another. + + Scalars are typed nodes (jtNull/jtBoolean/jtNumber/jtString) so a parser can + faithfully distinguish 42 from "42" from true. Insertion order is preserved + (parallel name/value arrays in objects) so emitted output is stable and + diffable. + + Serialisation is delegated to Json.Writer (the single emit kernel): AsJSON is + compact, FormatJSON is pretty. The writer itself has no dependency on this + unit, so streaming-only callers need not pull in the DOM. +} + +unit Json.Types; + +interface + +uses + SysUtils, Json.Writer; + +type + TJSONType = (jtNull, jtBoolean, jtNumber, jtString, jtArray, jtObject); + + TJSONData = class + protected + function GetJSONType: TJSONType; virtual; abstract; + function GetCount: Integer; virtual; { 0 for scalars } + function GetAsString: string; virtual; + function GetAsInt64: Int64; virtual; + function GetAsFloat: Double; virtual; + function GetAsBoolean: Boolean; virtual; + { Drive AWriter to emit this node and its descendants. } + procedure WriteTo(AWriter: TJSONWriter); virtual; abstract; + public + function IsNull: Boolean; + function AsJSON: string; { compact, no whitespace } + function FormatJSON: string; overload; { pretty, 2-space indent } + function FormatJSON(AIndent: Integer): string; overload; + + property JSONType: TJSONType read GetJSONType; + property Count: Integer read GetCount; + property AsString: string read GetAsString; + property AsInt64: Int64 read GetAsInt64; + property AsFloat: Double read GetAsFloat; + property AsBoolean: Boolean read GetAsBoolean; + end; + + TJSONNull = class(TJSONData) + protected + function GetJSONType: TJSONType; override; + function GetAsString: string; override; + procedure WriteTo(AWriter: TJSONWriter); override; + end; + + TJSONBoolean = class(TJSONData) + protected + FValue: Boolean; + function GetJSONType: TJSONType; override; + function GetAsString: string; override; + function GetAsBoolean: Boolean; override; + function GetAsInt64: Int64; override; + procedure WriteTo(AWriter: TJSONWriter); override; + public + constructor Create(AValue: Boolean); + property Value: Boolean read FValue write FValue; + end; + + TJSONString = class(TJSONData) + protected + FValue: string; + function GetJSONType: TJSONType; override; + function GetAsString: string; override; + function GetAsInt64: Int64; override; + function GetAsFloat: Double; override; + function GetAsBoolean: Boolean; override; + procedure WriteTo(AWriter: TJSONWriter); override; + public + constructor Create(const AValue: string); + property Value: string read FValue write FValue; + end; + + { One number node with an int/float discriminator. FText keeps the original + lexeme so parsed numbers round-trip exactly; programmatically-built numbers + synthesise it. } + TJSONNumber = class(TJSONData) + protected + FInt: Int64; + FFloat: Double; + FIsInt: Boolean; + FText: string; + function GetJSONType: TJSONType; override; + function GetAsString: string; override; + function GetAsInt64: Int64; override; + function GetAsFloat: Double; override; + function GetAsBoolean: Boolean; override; + procedure WriteTo(AWriter: TJSONWriter); override; + public + constructor CreateInt(AValue: Int64); + constructor CreateFloat(AValue: Double); + { Construct from a raw, already-validated JSON number lexeme (reader path). } + constructor CreateText(const AText: string; AIsInt: Boolean); + property IsInteger: Boolean read FIsInt; + end; + + TJSONArray = class(TJSONData) + private + FItems: array of TJSONData; { parent owns these (strong) } + protected + function GetJSONType: TJSONType; override; + function GetCount: Integer; override; + procedure WriteTo(AWriter: TJSONWriter); override; + public + function Add(AValue: TJSONData): Integer; overload; { TAKES OWNERSHIP } + function Add(const AValue: string): Integer; overload; { wraps TJSONString } + function Add(AValue: Int64): Integer; overload; + function Add(AValue: Boolean): Integer; overload; + function Add(AValue: Double): Integer; overload; + function AddNull: Integer; + { Detach the element at AIndex and return it; the caller then owns it. } + function Extract(AIndex: Integer): TJSONData; + { Detach and discard the element at AIndex (ARC frees it). } + procedure Delete(AIndex: Integer); + procedure Clear; + function GetItem(AIndex: Integer): TJSONData; + property Items[AIndex: Integer]: TJSONData read GetItem; default; + end; + + TJSONObject = class(TJSONData) + private + FNames: array of string; { parallel arrays preserve insertion order } + FValues: array of TJSONData; { parent owns these (strong) } + function IndexOfName(const AName: string): Integer; + procedure RemoveIndex(AIndex: Integer); + protected + function GetJSONType: TJSONType; override; + function GetCount: Integer; override; + procedure WriteTo(AWriter: TJSONWriter); override; + public + function Add(const AName: string; AValue: TJSONData): Integer; overload; { OWNS } + function Add(const AName: string; const AValue: string): Integer; overload; + function Add(const AName: string; AValue: Int64): Integer; overload; + function Add(const AName: string; AValue: Boolean): Integer; overload; + function Add(const AName: string; AValue: Double): Integer; overload; + function AddNull(const AName: string): Integer; + function Find(const AName: string): TJSONData; { nil if absent } + function Contains(const AName: string): Boolean; + { Detach a member and return it (nil if absent). Use to move a node. } + function Extract(const AName: string): TJSONData; + { Detach and discard a member (ARC frees it). True if it existed. } + function Remove(const AName: string): Boolean; + procedure Delete(AIndex: Integer); + procedure Clear; + function GetByName(const AName: string): TJSONData; + function GetName(AIndex: Integer): string; + function GetItem(AIndex: Integer): TJSONData; + property Values[AName: string]: TJSONData read GetByName; default; + property Names[AIndex: Integer]: string read GetName; + property ItemsByIndex[AIndex: Integer]: TJSONData read GetItem; + end; + +{ Serialise a tree. Equivalent to AData.AsJSON / AData.FormatJSON, offered as + free functions for callers that prefer them. } +function AsJSON(AData: TJSONData): string; +function FormatJSON(AData: TJSONData): string; overload; +function FormatJSON(AData: TJSONData; AIndent: Integer): string; overload; + +implementation + +{ ------------------------------------------------------------------ } +{ helpers } +{ ------------------------------------------------------------------ } + +{ Parse a JSON number lexeme into a Double. The lexeme is assumed already + validated (shape -?int(.frac)?([eE][+-]?digits)?); robust enough for + config-sized inputs. } +function StrToFloatJSON(const S: string): Double; +var + I, Len, ExpSign, ExpVal, K: Integer; + Sign, Acc, Scale: Double; +begin + Len := Length(S); + I := 0; + Sign := 1.0; + if (I < Len) and (Byte(S[I]) = Ord('-')) then begin Sign := -1.0; I := I + 1; end + else if (I < Len) and (Byte(S[I]) = Ord('+')) then I := I + 1; + + Acc := 0.0; + while (I < Len) and (Byte(S[I]) >= Ord('0')) and (Byte(S[I]) <= Ord('9')) do + begin + Acc := Acc * 10.0 + (Byte(S[I]) - Ord('0')); + I := I + 1; + end; + + if (I < Len) and (Byte(S[I]) = Ord('.')) then + begin + I := I + 1; + Scale := 1.0; + while (I < Len) and (Byte(S[I]) >= Ord('0')) and (Byte(S[I]) <= Ord('9')) do + begin + Acc := Acc * 10.0 + (Byte(S[I]) - Ord('0')); + Scale := Scale * 10.0; + I := I + 1; + end; + Acc := Acc / Scale; + end; + + if (I < Len) and ((Byte(S[I]) = Ord('e')) or (Byte(S[I]) = Ord('E'))) then + begin + I := I + 1; + ExpSign := 1; + if (I < Len) and (Byte(S[I]) = Ord('-')) then begin ExpSign := -1; I := I + 1; end + else if (I < Len) and (Byte(S[I]) = Ord('+')) then I := I + 1; + ExpVal := 0; + while (I < Len) and (Byte(S[I]) >= Ord('0')) and (Byte(S[I]) <= Ord('9')) do + begin + ExpVal := ExpVal * 10 + (Byte(S[I]) - Ord('0')); + I := I + 1; + end; + Scale := 1.0; + K := 0; + while K < ExpVal do begin Scale := Scale * 10.0; K := K + 1; end; + if ExpSign < 0 then Acc := Acc / Scale else Acc := Acc * Scale; + end; + + Result := Sign * Acc; +end; + +{ ------------------------------------------------------------------ } +{ TJSONData } +{ ------------------------------------------------------------------ } + +function TJSONData.GetCount: Integer; +begin + Result := 0; +end; + +function TJSONData.GetAsString: string; +begin + Result := ''; +end; + +function TJSONData.GetAsInt64: Int64; +begin + Result := 0; +end; + +function TJSONData.GetAsFloat: Double; +begin + Result := 0.0; +end; + +function TJSONData.GetAsBoolean: Boolean; +begin + Result := False; +end; + +function TJSONData.IsNull: Boolean; +begin + Result := GetJSONType() = jtNull; +end; + +function TJSONData.AsJSON: string; +var + W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.Pretty := False; + WriteTo(W); + Result := W.ToString(); + W.Free(); +end; + +function TJSONData.FormatJSON: string; +begin + Result := FormatJSON(2); +end; + +function TJSONData.FormatJSON(AIndent: Integer): string; +var + W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.Pretty := True; + W.Indent := AIndent; + WriteTo(W); + Result := W.ToString(); + W.Free(); +end; + +{ ------------------------------------------------------------------ } +{ TJSONNull } +{ ------------------------------------------------------------------ } + +function TJSONNull.GetJSONType: TJSONType; +begin + Result := jtNull; +end; + +function TJSONNull.GetAsString: string; +begin + Result := 'null'; +end; + +procedure TJSONNull.WriteTo(AWriter: TJSONWriter); +begin + AWriter.WriteNullValue(); +end; + +{ ------------------------------------------------------------------ } +{ TJSONBoolean } +{ ------------------------------------------------------------------ } + +constructor TJSONBoolean.Create(AValue: Boolean); +begin + FValue := AValue; +end; + +function TJSONBoolean.GetJSONType: TJSONType; +begin + Result := jtBoolean; +end; + +function TJSONBoolean.GetAsString: string; +begin + if FValue then Result := 'true' else Result := 'false'; +end; + +function TJSONBoolean.GetAsBoolean: Boolean; +begin + Result := FValue; +end; + +function TJSONBoolean.GetAsInt64: Int64; +begin + if FValue then Result := 1 else Result := 0; +end; + +procedure TJSONBoolean.WriteTo(AWriter: TJSONWriter); +begin + AWriter.WriteBoolValue(FValue); +end; + +{ ------------------------------------------------------------------ } +{ TJSONString } +{ ------------------------------------------------------------------ } + +constructor TJSONString.Create(const AValue: string); +begin + FValue := AValue; +end; + +function TJSONString.GetJSONType: TJSONType; +begin + Result := jtString; +end; + +function TJSONString.GetAsString: string; +begin + Result := FValue; +end; + +function TJSONString.GetAsInt64: Int64; +begin + Result := StrToInt64(FValue); +end; + +function TJSONString.GetAsFloat: Double; +begin + Result := StrToFloatJSON(FValue); +end; + +function TJSONString.GetAsBoolean: Boolean; +begin + Result := FValue = 'true'; +end; + +procedure TJSONString.WriteTo(AWriter: TJSONWriter); +begin + AWriter.WriteStringValue(FValue); +end; + +{ ------------------------------------------------------------------ } +{ TJSONNumber } +{ ------------------------------------------------------------------ } + +constructor TJSONNumber.CreateInt(AValue: Int64); +begin + FInt := AValue; + FFloat := AValue; + FIsInt := True; + FText := IntToStr(AValue); +end; + +constructor TJSONNumber.CreateFloat(AValue: Double); +begin + FFloat := AValue; + FInt := Trunc(AValue); + FIsInt := False; + FText := Format('%g', [AValue]); +end; + +constructor TJSONNumber.CreateText(const AText: string; AIsInt: Boolean); +begin + FText := AText; + FIsInt := AIsInt; + if AIsInt then + begin + FInt := StrToInt64(AText); + FFloat := FInt; + end + else + begin + FFloat := StrToFloatJSON(AText); + FInt := Trunc(FFloat); + end; +end; + +function TJSONNumber.GetJSONType: TJSONType; +begin + Result := jtNumber; +end; + +function TJSONNumber.GetAsString: string; +begin + Result := FText; +end; + +function TJSONNumber.GetAsInt64: Int64; +begin + Result := FInt; +end; + +function TJSONNumber.GetAsFloat: Double; +begin + Result := FFloat; +end; + +function TJSONNumber.GetAsBoolean: Boolean; +begin + Result := FFloat <> 0.0; +end; + +procedure TJSONNumber.WriteTo(AWriter: TJSONWriter); +begin + { Emit the original lexeme verbatim to preserve exact representation. } + AWriter.WriteRaw(FText); +end; + +{ ------------------------------------------------------------------ } +{ TJSONArray } +{ ------------------------------------------------------------------ } + +function TJSONArray.GetJSONType: TJSONType; +begin + Result := jtArray; +end; + +function TJSONArray.GetCount: Integer; +begin + Result := Length(FItems); +end; + +function TJSONArray.GetItem(AIndex: Integer): TJSONData; +begin + Result := FItems[AIndex]; +end; + +function TJSONArray.Add(AValue: TJSONData): Integer; +begin + SetLength(FItems, Length(FItems) + 1); + FItems[Length(FItems) - 1] := AValue; + Result := Length(FItems) - 1; +end; + +function TJSONArray.Add(const AValue: string): Integer; +begin + Result := Add(TJSONString.Create(AValue)); +end; + +function TJSONArray.Add(AValue: Int64): Integer; +begin + Result := Add(TJSONNumber.CreateInt(AValue)); +end; + +function TJSONArray.Add(AValue: Boolean): Integer; +begin + Result := Add(TJSONBoolean.Create(AValue)); +end; + +function TJSONArray.Add(AValue: Double): Integer; +begin + Result := Add(TJSONNumber.CreateFloat(AValue)); +end; + +function TJSONArray.AddNull: Integer; +begin + Result := Add(TJSONNull.Create()); +end; + +function TJSONArray.Extract(AIndex: Integer): TJSONData; +var + I: Integer; +begin + Result := FItems[AIndex]; { hold a ref so it survives the shrink } + I := AIndex; + while I < Length(FItems) - 1 do + begin + FItems[I] := FItems[I + 1]; + I := I + 1; + end; + SetLength(FItems, Length(FItems) - 1); +end; + +procedure TJSONArray.Delete(AIndex: Integer); +var + Gone: TJSONData; +begin + Gone := Extract(AIndex); { dropping the local ref lets ARC free it } +end; + +procedure TJSONArray.Clear; +begin + SetLength(FItems, 0); +end; + +procedure TJSONArray.WriteTo(AWriter: TJSONWriter); +var + I: Integer; +begin + AWriter.BeginArray(); + I := 0; + while I < Length(FItems) do + begin + FItems[I].WriteTo(AWriter); + I := I + 1; + end; + AWriter.EndArray(); +end; + +{ ------------------------------------------------------------------ } +{ TJSONObject } +{ ------------------------------------------------------------------ } + +function TJSONObject.GetJSONType: TJSONType; +begin + Result := jtObject; +end; + +function TJSONObject.GetCount: Integer; +begin + Result := Length(FValues); +end; + +function TJSONObject.IndexOfName(const AName: string): Integer; +var + I: Integer; +begin + Result := -1; + I := 0; + while I < Length(FNames) do + begin + if FNames[I] = AName then + begin + Result := I; + Exit; + end; + I := I + 1; + end; +end; + +procedure TJSONObject.RemoveIndex(AIndex: Integer); +var + I: Integer; +begin + I := AIndex; + while I < Length(FNames) - 1 do + begin + FNames[I] := FNames[I + 1]; + FValues[I] := FValues[I + 1]; + I := I + 1; + end; + SetLength(FNames, Length(FNames) - 1); + SetLength(FValues, Length(FValues) - 1); +end; + +function TJSONObject.Add(const AName: string; AValue: TJSONData): Integer; +begin + SetLength(FNames, Length(FNames) + 1); + SetLength(FValues, Length(FValues) + 1); + FNames[Length(FNames) - 1] := AName; + FValues[Length(FValues) - 1] := AValue; + Result := Length(FValues) - 1; +end; + +function TJSONObject.Add(const AName: string; const AValue: string): Integer; +begin + Result := Add(AName, TJSONString.Create(AValue)); +end; + +function TJSONObject.Add(const AName: string; AValue: Int64): Integer; +begin + Result := Add(AName, TJSONNumber.CreateInt(AValue)); +end; + +function TJSONObject.Add(const AName: string; AValue: Boolean): Integer; +begin + Result := Add(AName, TJSONBoolean.Create(AValue)); +end; + +function TJSONObject.Add(const AName: string; AValue: Double): Integer; +begin + Result := Add(AName, TJSONNumber.CreateFloat(AValue)); +end; + +function TJSONObject.AddNull(const AName: string): Integer; +begin + Result := Add(AName, TJSONNull.Create()); +end; + +function TJSONObject.Find(const AName: string): TJSONData; +var + Idx: Integer; +begin + Idx := IndexOfName(AName); + if Idx < 0 then Result := nil else Result := FValues[Idx]; +end; + +function TJSONObject.Contains(const AName: string): Boolean; +begin + Result := IndexOfName(AName) >= 0; +end; + +function TJSONObject.Extract(const AName: string): TJSONData; +var + Idx: Integer; +begin + Idx := IndexOfName(AName); + if Idx < 0 then + Result := nil + else + begin + Result := FValues[Idx]; { hold a ref so it survives RemoveIndex } + RemoveIndex(Idx); + end; +end; + +function TJSONObject.Remove(const AName: string): Boolean; +var + Idx: Integer; +begin + Idx := IndexOfName(AName); + Result := Idx >= 0; + if Result then + RemoveIndex(Idx); +end; + +procedure TJSONObject.Delete(AIndex: Integer); +begin + RemoveIndex(AIndex); +end; + +procedure TJSONObject.Clear; +begin + SetLength(FNames, 0); + SetLength(FValues, 0); +end; + +function TJSONObject.GetByName(const AName: string): TJSONData; +begin + Result := Find(AName); +end; + +function TJSONObject.GetName(AIndex: Integer): string; +begin + Result := FNames[AIndex]; +end; + +function TJSONObject.GetItem(AIndex: Integer): TJSONData; +begin + Result := FValues[AIndex]; +end; + +procedure TJSONObject.WriteTo(AWriter: TJSONWriter); +var + I: Integer; +begin + AWriter.BeginObject(); + I := 0; + while I < Length(FValues) do + begin + AWriter.WriteKey(FNames[I]); + FValues[I].WriteTo(AWriter); + I := I + 1; + end; + AWriter.EndObject(); +end; + +{ ------------------------------------------------------------------ } +{ free functions } +{ ------------------------------------------------------------------ } + +function AsJSON(AData: TJSONData): string; +begin + Result := AData.AsJSON(); +end; + +function FormatJSON(AData: TJSONData): string; +begin + Result := AData.FormatJSON(); +end; + +function FormatJSON(AData: TJSONData; AIndent: Integer): string; +begin + Result := AData.FormatJSON(AIndent); +end; + +end. diff --git a/stdlib/src/main/pascal/json.writer.pas b/stdlib/src/main/pascal/json.writer.pas new file mode 100644 index 0000000..31bd9e4 --- /dev/null +++ b/stdlib/src/main/pascal/json.writer.pas @@ -0,0 +1,361 @@ +{ + Blaise stdlib - JSON writer + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Blaise stdlib - streaming JSON writer. + + TJSONWriter emits a JSON document by announcing structure as you go: open a + container, write fields or elements, close it. Output is accumulated in a + TStringBuilder, so building even a large document is O(n), not the O(n^2) of + repeated string concatenation. + + The API has three tiers, mirroring how JSON is actually written: + + 1. Object fields (the common case) - name and value in one call: + W.WriteString('name', 'blaise'); + W.WriteInt('version', 12); + W.WriteBool('stable', True); + + 2. Array elements - value only, no name (the '...Value' forms): + W.BeginArray; + W.WriteStringValue('a'); + W.WriteIntValue(1); + W.EndArray; + + 3. Structure / escape hatch - when an object member's value is itself a + nested object or array, write the key, then open the container: + W.WriteKey('tags'); + W.BeginArray; ... W.EndArray; + + The '...Value' suffix marks the keyless (array-element) form, following the + naming used by .NET's Utf8JsonWriter, so it is always clear at the call site + whether a write is keyed or not. + + Separators, newlines and indentation are tracked internally; the caller never + writes a comma or a brace by hand. Set Pretty (and Indent) before writing for + human-readable output; the default is compact. + + This unit is self-contained: it does not depend on a JSON document/DOM type. + A reader and an in-memory document model are a separate, future layer. +} + +unit Json.Writer; + +interface + +uses + SysUtils, StrUtils; + +type + EJSONWriterError = class(Exception) + end; + + TJSONContainerKind = (ckObject, ckArray); + + TJSONFrame = record + Kind: TJSONContainerKind; + Count: Integer; { members/elements emitted so far } + end; + + TJSONWriter = class + private + FSB: TStringBuilder; + FPretty: Boolean; + FIndent: Integer; { spaces per level when pretty } + FStack: array of TJSONFrame; + FPending: Boolean; { a key was written; the next value fills it } + procedure NewlineIndent(ALevel: Integer); + procedure PreValue; { emit element separator / newline as needed } + procedure WriteEscaped(const S: string); + public + constructor Create; + destructor Destroy; override; + + { ---- containers ---- } + procedure BeginObject; + procedure EndObject; + procedure BeginArray; + procedure EndArray; + + { ---- object fields: name + value in one call (the common case) ---- } + procedure WriteString(const AName, AValue: string); overload; + procedure WriteInt(const AName: string; AValue: Int64); overload; + procedure WriteBool(const AName: string; AValue: Boolean); overload; + procedure WriteFloat(const AName: string; AValue: Double); overload; + procedure WriteNull(const AName: string); + + { ---- array elements: value only, no name ---- } + procedure WriteStringValue(const AValue: string); + procedure WriteIntValue(AValue: Int64); + procedure WriteBoolValue(AValue: Boolean); + procedure WriteFloatValue(AValue: Double); + procedure WriteNullValue; + + { ---- structure / escape hatch ---- } + { Write an object member key whose value follows. Use this when the value + is itself a nested object or array (BeginObject / BeginArray next). } + procedure WriteKey(const AName: string); + { Emit a verbatim, already-formatted JSON fragment as the next value. } + procedure WriteRaw(const AJSONFragment: string); + + { The accumulated document so far. } + function ToString: string; override; + { Discard all output and reset to an empty document. } + procedure Reset; + + property Pretty: Boolean read FPretty write FPretty; + property Indent: Integer read FIndent write FIndent; + end; + +{ Escape a string's contents per RFC 8259 (no surrounding quotes added). } +function JSONEscape(const S: string): string; + +implementation + +function JSONEscape(const S: string): string; +var + SB: TStringBuilder; + I, N: Integer; + B: Byte; +const + Hex = '0123456789abcdef'; +begin + SB := TStringBuilder.Create(); + N := Length(S); + I := 0; + while I < N do + begin + B := Byte(S[I]); + if B = 34 then SB.Append('\"') { " } + else if B = 92 then SB.Append('\\') { \ } + else if B = 8 then SB.Append('\b') + else if B = 9 then SB.Append('\t') + else if B = 10 then SB.Append('\n') + else if B = 12 then SB.Append('\f') + else if B = 13 then SB.Append('\r') + else if B < 32 then + begin + { other control characters -> \u00XX (Hex is 0-based in Blaise) } + SB.Append('\u00'); + SB.AppendByte(Byte(Hex[B div 16])); + SB.AppendByte(Byte(Hex[B mod 16])); + end + else + SB.AppendByte(B); + I := I + 1; + end; + Result := SB.ToString(); + SB.Free(); +end; + +constructor TJSONWriter.Create; +begin + FSB := TStringBuilder.Create(); + FPretty := False; + FIndent := 2; + FPending := False; +end; + +destructor TJSONWriter.Destroy; +begin + FSB.Free(); + inherited Destroy; +end; + +procedure TJSONWriter.NewlineIndent(ALevel: Integer); +var + I: Integer; +begin + if not FPretty then + Exit; + FSB.AppendByte(10); { LF } + I := 0; + while I < ALevel * FIndent do + begin + FSB.AppendByte(32); { space } + I := I + 1; + end; +end; + +{ Called before emitting any value. If a key was just written the value simply + fills it (the separator is already in place). Otherwise, inside an array, emit + the inter-element comma plus newline/indent and count the element. At the top + level nothing is needed. } +procedure TJSONWriter.PreValue; +var + Top: Integer; +begin + if FPending then + begin + FPending := False; + Exit; + end; + Top := Length(FStack) - 1; + if Top >= 0 then + begin + if FStack[Top].Count > 0 then + FSB.Append(','); + NewlineIndent(Top + 1); + FStack[Top].Count := FStack[Top].Count + 1; + end; +end; + +procedure TJSONWriter.WriteEscaped(const S: string); +begin + FSB.Append('"'); + FSB.Append(JSONEscape(S)); + FSB.Append('"'); +end; + +procedure TJSONWriter.BeginObject; +begin + PreValue(); + FSB.Append('{'); + SetLength(FStack, Length(FStack) + 1); + FStack[Length(FStack) - 1].Kind := ckObject; + FStack[Length(FStack) - 1].Count := 0; +end; + +procedure TJSONWriter.EndObject; +var + Cnt: Integer; +begin + Cnt := FStack[Length(FStack) - 1].Count; + SetLength(FStack, Length(FStack) - 1); + if Cnt > 0 then + NewlineIndent(Length(FStack)); + FSB.Append('}'); +end; + +procedure TJSONWriter.BeginArray; +begin + PreValue(); + FSB.Append('['); + SetLength(FStack, Length(FStack) + 1); + FStack[Length(FStack) - 1].Kind := ckArray; + FStack[Length(FStack) - 1].Count := 0; +end; + +procedure TJSONWriter.EndArray; +var + Cnt: Integer; +begin + Cnt := FStack[Length(FStack) - 1].Count; + SetLength(FStack, Length(FStack) - 1); + if Cnt > 0 then + NewlineIndent(Length(FStack)); + FSB.Append(']'); +end; + +procedure TJSONWriter.WriteKey(const AName: string); +var + Top: Integer; +begin + Top := Length(FStack) - 1; + if (Top < 0) or (FStack[Top].Kind <> ckObject) then + raise EJSONWriterError.Create('WriteKey outside an object'); + if FStack[Top].Count > 0 then + FSB.Append(','); + NewlineIndent(Top + 1); + FStack[Top].Count := FStack[Top].Count + 1; + WriteEscaped(AName); + if FPretty then + FSB.Append(': ') + else + FSB.Append(':'); + FPending := True; +end; + +{ ---- array-element (keyless) writes ---- } + +procedure TJSONWriter.WriteStringValue(const AValue: string); +begin + PreValue(); + WriteEscaped(AValue); +end; + +procedure TJSONWriter.WriteIntValue(AValue: Int64); +begin + PreValue(); + FSB.Append(IntToStr(AValue)); +end; + +procedure TJSONWriter.WriteBoolValue(AValue: Boolean); +begin + PreValue(); + if AValue then + FSB.Append('true') + else + FSB.Append('false'); +end; + +{ NOTE: float formatting uses '%g', which is a reasonable general default but + can use exponent form and does not guarantee shortest round-trip output. + JSON has no integer/float distinction, so prefer WriteInt for whole numbers. } +procedure TJSONWriter.WriteFloatValue(AValue: Double); +begin + PreValue(); + FSB.Append(Format('%g', [AValue])); +end; + +procedure TJSONWriter.WriteNullValue; +begin + PreValue(); + FSB.Append('null'); +end; + +procedure TJSONWriter.WriteRaw(const AJSONFragment: string); +begin + PreValue(); + FSB.Append(AJSONFragment); +end; + +{ ---- object-field (key + value) writes ---- } + +procedure TJSONWriter.WriteString(const AName, AValue: string); +begin + WriteKey(AName); + WriteStringValue(AValue); +end; + +procedure TJSONWriter.WriteInt(const AName: string; AValue: Int64); +begin + WriteKey(AName); + WriteIntValue(AValue); +end; + +procedure TJSONWriter.WriteBool(const AName: string; AValue: Boolean); +begin + WriteKey(AName); + WriteBoolValue(AValue); +end; + +procedure TJSONWriter.WriteFloat(const AName: string; AValue: Double); +begin + WriteKey(AName); + WriteFloatValue(AValue); +end; + +procedure TJSONWriter.WriteNull(const AName: string); +begin + WriteKey(AName); + WriteNullValue(); +end; + +function TJSONWriter.ToString: string; +begin + Result := FSB.ToString(); +end; + +procedure TJSONWriter.Reset; +begin + FSB.Free(); + FSB := TStringBuilder.Create(); + FPending := False; + SetLength(FStack, 0); +end; + +end. diff --git a/stdlib/src/test/pascal/json.tests.pas b/stdlib/src/test/pascal/json.tests.pas new file mode 100644 index 0000000..8d34de6 --- /dev/null +++ b/stdlib/src/test/pascal/json.tests.pas @@ -0,0 +1,300 @@ +{ + Blaise - An Object Pascal Compiler + Copyright (c) 2026 Graeme Geldenhuys + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Unit tests for the stdlib JSON library: Json.Writer (streaming), Json.Types + (DOM), Json.Parser / Json.Reader (parsing), and round-tripping through them. + In-process tests via blaise.testing — no toolchain spawning. + + Self-registers with the test registry via the initialization section; the + test runner program pulls this unit in (through test.registry) and runs it. } + +unit Json.Tests; + +interface + +uses + SysUtils, + blaise.testing, + Json.Writer, + Json.Types, + Json.Parser, + Json.Reader; + +type + TJsonTests = class(TTestCase) + published + { Json.Writer } + procedure TestWriter_Fields; + procedure TestWriter_Array; + procedure TestWriter_Nested; + procedure TestWriter_Pretty; + procedure TestWriter_Escape; + procedure TestWriter_Raw; + procedure TestWriter_Float; + { Json.Types (DOM) } + procedure TestDom_Build; + procedure TestDom_Accessors; + procedure TestDom_Empty; + procedure TestDom_Remove; + { Json.Parser / Json.Reader } + procedure TestParse_Scalars; + procedure TestParse_Escapes; + procedure TestParse_Unicode; + procedure TestParse_Nested; + procedure TestParse_RoundTrip; + procedure TestParse_Whitespace; + procedure TestParse_Error; + procedure TestParse_Trailing; + end; + +implementation + +{ ---- Json.Writer ---- } + +procedure TJsonTests.TestWriter_Fields; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.BeginObject(); + W.WriteString('name', 'blaise'); + W.WriteInt('version', 12); + W.WriteBool('stable', True); + W.WriteNull('extra'); + W.EndObject(); + AssertEquals('compact object', + '{"name":"blaise","version":12,"stable":true,"extra":null}', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Array; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.BeginArray(); + W.WriteStringValue('a'); + W.WriteIntValue(1); + W.WriteBoolValue(False); + W.EndArray(); + AssertEquals('array elements', '["a",1,false]', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Nested; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.BeginObject(); + W.WriteString('id', 'x'); + W.WriteKey('tags'); + W.BeginArray(); + W.WriteStringValue('p'); + W.WriteStringValue('q'); + W.EndArray(); + W.EndObject(); + AssertEquals('nested array', '{"id":"x","tags":["p","q"]}', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Pretty; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.Pretty := True; + W.BeginObject(); + W.WriteInt('a', 1); + W.WriteKey('b'); + W.BeginArray(); + W.WriteIntValue(2); + W.EndArray(); + W.EndObject(); + AssertEquals('pretty', + '{' + #10 + ' "a": 1,' + #10 + ' "b": [' + #10 + ' 2' + #10 + + ' ]' + #10 + '}', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Escape; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.WriteStringValue('a"b\' + #9 + #10 + 'c' + Chr(1)); + AssertEquals('escapes', '"a\"b\\\t\nc\u0001"', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Raw; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.BeginObject(); + W.WriteKey('geo'); + W.WriteRaw('{"x":1,"y":2}'); + W.EndObject(); + AssertEquals('raw', '{"geo":{"x":1,"y":2}}', W.ToString()); + W.Free(); +end; + +procedure TJsonTests.TestWriter_Float; +var W: TJSONWriter; +begin + W := TJSONWriter.Create(); + W.WriteFloatValue(1.5); + AssertEquals('float', '1.5', W.ToString()); + W.Free(); +end; + +{ ---- Json.Types (DOM) ---- } + +procedure TJsonTests.TestDom_Build; +var Root: TJSONObject; Arr: TJSONArray; +begin + Root := TJSONObject.Create(); + Root.Add('name', 'blaise'); + Root.Add('version', Int64(12)); + Root.Add('ratio', 1.5); + Root.Add('stable', True); + Arr := TJSONArray.Create(); + Arr.Add('DEBUG'); Arr.Add('UNIX'); + Root.Add('defines', Arr); + Root.AddNull('extra'); + AssertEquals('dom compact', + '{"name":"blaise","version":12,"ratio":1.5,"stable":true,' + + '"defines":["DEBUG","UNIX"],"extra":null}', Root.AsJSON()); + Root.Free(); +end; + +procedure TJsonTests.TestDom_Accessors; +var Root: TJSONObject; v: Int64; s: string; +begin + Root := TJSONObject.Create(); + Root.Add('version', Int64(12)); + Root.Add('name', 'blaise'); + v := Root.Find('version').AsInt64; + AssertEquals('AsInt64', Int64(12), v); + s := Root.Find('name').AsString; + AssertEquals('AsString', 'blaise', s); + AssertTrue('Contains', Root.Contains('name')); + AssertFalse('not Contains', Root.Contains('nope')); + AssertEquals('Count', 2, Root.Count); + Root.Free(); +end; + +procedure TJsonTests.TestDom_Empty; +var O: TJSONObject; A: TJSONArray; +begin + O := TJSONObject.Create(); + AssertEquals('empty object', '{}', O.AsJSON()); + O.Free(); + A := TJSONArray.Create(); + AssertEquals('empty array', '[]', A.AsJSON()); + A.Free(); +end; + +procedure TJsonTests.TestDom_Remove; +var Root: TJSONObject; +begin + Root := TJSONObject.Create(); + Root.Add('a', Int64(1)); + Root.Add('b', Int64(2)); + AssertTrue('remove existing', Root.Remove('a')); + AssertFalse('remove absent', Root.Remove('zzz')); + AssertEquals('after remove', '{"b":2}', Root.AsJSON()); + Root.Free(); +end; + +{ ---- Json.Parser / Json.Reader ---- } + +procedure TJsonTests.TestParse_Scalars; +var D: TJSONData; v: Int64; s: string; b: Boolean; +begin + D := GetJSON('42'); v := D.AsInt64; AssertEquals('int', Int64(42), v); D.Free(); + D := GetJSON('"hi"'); s := D.AsString; AssertEquals('str', 'hi', s); D.Free(); + D := GetJSON('true'); b := D.AsBoolean; AssertTrue('bool', b); D.Free(); + D := GetJSON('null'); AssertTrue('null', D.IsNull()); D.Free(); +end; + +procedure TJsonTests.TestParse_Escapes; +var D: TJSONData; s: string; +begin + D := GetJSON('"say \"hi\"\tbye"'); + s := D.AsString; + AssertEquals('unescape', 'say "hi"' + #9 + 'bye', s); + D.Free(); +end; + +procedure TJsonTests.TestParse_Unicode; +var D: TJSONData; s: string; +begin + { é is U+00E9 -> two UTF-8 bytes. } + D := GetJSON('"' + Chr($C3) + Chr($A9) + '"'); + s := D.AsString; + AssertEquals('é is 2 utf8 bytes', 2, Length(s)); + D.Free(); +end; + +procedure TJsonTests.TestParse_Nested; +var D: TJSONData; Obj: TJSONObject; v: Int64; b: Boolean; +begin + D := GetJSON('{"a":1,"b":[2,3],"c":{"d":true}}'); + Obj := TJSONObject(D); + v := Obj.Find('a').AsInt64; + AssertEquals('a', Int64(1), v); + AssertEquals('b count', 2, Obj.Find('b').Count); + b := TJSONObject(Obj.Find('c')).Find('d').AsBoolean; + AssertTrue('c.d', b); + D.Free(); +end; + +procedure TJsonTests.TestParse_RoundTrip; +var D: TJSONData; src: string; +begin + src := '{"n":"x","v":12,"r":1.5,"ok":true,"a":[1,2,3],"z":null}'; + D := GetJSON(src); + AssertEquals('round-trip', src, D.AsJSON()); + D.Free(); +end; + +procedure TJsonTests.TestParse_Whitespace; +var D: TJSONData; +begin + D := GetJSON(' { "a" : 1 , "b" : [ 2 , 3 ] } '); + AssertEquals('ws-tolerant', '{"a":1,"b":[2,3]}', D.AsJSON()); + D.Free(); +end; + +procedure TJsonTests.TestParse_Error; +var D: TJSONData; raised: Boolean; +begin + raised := False; + try + D := GetJSON('{bad}'); + D.Free(); + except + on E: EJSONParseError do raised := True; + end; + AssertTrue('malformed raises', raised); +end; + +procedure TJsonTests.TestParse_Trailing; +var D: TJSONData; raised: Boolean; +begin + raised := False; + try + D := GetJSON('1 2'); + D.Free(); + except + on E: EJSONParseError do raised := True; + end; + AssertTrue('trailing content raises', raised); +end; + + +initialization + RegisterTest(TJsonTests); + +end. diff --git a/stdlib/src/test/pascal/test.registry.pas b/stdlib/src/test/pascal/test.registry.pas new file mode 100644 index 0000000..8dad0f7 --- /dev/null +++ b/stdlib/src/test/pascal/test.registry.pas @@ -0,0 +1,28 @@ +{ + Blaise - An Object Pascal Compiler + Copyright (c) 2026 Graeme Geldenhuys + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Central registry of stdlib test units. + + Each test unit self-registers its TTestCase class in its own initialization + section. This unit simply pulls them all in via the uses clause, so the test + runner program only needs to depend on this one unit. + + To add a new test suite: write a 'Foo.Tests' unit with an + 'initialization RegisterTest(TFooTests)' section, then add it to the uses + clause below. } + +unit Test.Registry; + +interface + +uses + Json.Tests; + +implementation + +end. diff --git a/stdlib/src/test/pascal/testrunner.pas b/stdlib/src/test/pascal/testrunner.pas new file mode 100644 index 0000000..5b5cd8f --- /dev/null +++ b/stdlib/src/test/pascal/testrunner.pas @@ -0,0 +1,34 @@ +{ + Blaise - An Object Pascal Compiler + Copyright (c) 2026 Graeme Geldenhuys + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +{ Test runner for the Blaise standard library. + + Pulls in every test unit via Test.Registry (each self-registers via its + initialization section), then runs them all with the text runner. Exits 0 + when everything passes, 1 otherwise, so it is CI-friendly. + + Build (from the repo root): + blaise --source stdlib/src/test/pascal/testrunner.pas --output testrunner \ + --unit-path stdlib/src/main/pascal \ + --unit-path runtime/src/main/pascal \ + \ + --unit-path stdlib/src/test/pascal + ./testrunner + + Supports --suite / --suite filtering (handled by RunAll). } + +program TestRunner; + +uses + blaise.testing, + blaise.testing.runner.text, + Test.Registry; + +begin + Halt(RunAll()); +end. diff --git a/stdlib/src/test/run-tests.sh b/stdlib/src/test/run-tests.sh new file mode 100755 index 0000000..b9f321e --- /dev/null +++ b/stdlib/src/test/run-tests.sh @@ -0,0 +1,31 @@ +#!/usr/bin/env bash +# Build and run the Blaise stdlib test suite. +# +# Usage: stdlib/src/test/run-tests.sh [blaise-binary] [-- runner-args...] +# blaise-binary defaults to the newest release under releases/. +# Anything after '--' is passed to the runner (e.g. --suite TJsonTests). +set -euo pipefail + +# Repo root = two levels up from this script's dir (stdlib/src/test -> repo). +ROOT="$(cd "$(dirname "$0")/../../.." && pwd)" + +BLAISE="${1:-$ROOT/releases/v0.12.0-pre/blaise}" +[ "${1:-}" != "" ] && shift || true +# Drop a leading '--' separator if present. +[ "${1:-}" = "--" ] && shift || true + +CACHE="$(mktemp -d)" +OUT="$CACHE/testrunner" + +"$BLAISE" \ + --source "$ROOT/stdlib/src/test/pascal/testrunner.pas" \ + --output "$OUT" \ + --unit-path "$ROOT/stdlib/src/main/pascal" \ + --unit-path "$ROOT/runtime/src/main/pascal" \ + --unit-path "$ROOT/stdlib/src/test/pascal" \ + --unit-cache "$CACHE" + +"$OUT" "$@" +RC=$? +rm -rf "$CACHE" +exit $RC