administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(stdlib): add JSON library (writer, DOM, parser, reader)

Browse source 
A read+write JSON library for the standard library:

  Json.Writer  streaming serialiser — TStringBuilder-backed (O(n)), with a
               three-tier .NET-style API: WriteString(name,value) for object
               fields, WriteStringValue(value) for array elements, and WriteKey
               for nested-container values. Compact + pretty output. Standalone
               (no DOM dependency).
  Json.Types   in-memory document model (DOM): TJSONData + typed nodes, tree
               building, accessors; emits through Json.Writer.
  Json.Parser  RFC 8259 recursive-descent parser into the DOM, with full string
               escapes incl. \uXXXX surrogate pairs.
  Json.Reader  thin GetJSON(text) facade.

Adds the first stdlib test tree under stdlib/src/test/pascal: a self-registering
Json.Tests suite (19 tests), a Test.Registry hub unit, and a TestRunner program,
wired into 'pasbuild test -m blaise-stdlib' via the <test> block in project.xml.
run-tests.sh builds and runs the suite directly.
This commit is contained in:
Graeme Geldenhuys 2026-06-22 20:07:34 +01:00
parent 1e92604599
commit 36065ecd7d
9 changed files with 1909 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
stdlib/project.xml
View file

@ -9,4 +9,9 @@
</unitPaths> </unitPaths>
</build> </build>
<test>
<framework>blaise</framework>
<testSource>testrunner.pas</testSource>
</test>
</project> </project>

366
stdlib/src/main/pascal/json.parser.pas Normal file
View file

@ -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.

37
stdlib/src/main/pascal/json.reader.pas Normal file
View file

@ -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.

747
stdlib/src/main/pascal/json.types.pas Normal file
View file

@ -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.

361
stdlib/src/main/pascal/json.writer.pas Normal file
View file

@ -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.

300
stdlib/src/test/pascal/json.tests.pas Normal file
View file

@ -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.

28
stdlib/src/test/pascal/test.registry.pas Normal file
View file

@ -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.

34
stdlib/src/test/pascal/testrunner.pas Normal file
View file

@ -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 <Class> / --suite <Class.Method> filtering (handled by RunAll). }
program TestRunner;
uses
blaise.testing,
blaise.testing.runner.text,
Test.Registry;
begin
Halt(RunAll());
end.

31
stdlib/src/test/run-tests.sh Executable file
View file

@ -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