feat(stdlib): add JSON library (writer, DOM, parser, reader)
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
parent
1e92604599
commit
36065ecd7d
|
|
@ -9,4 +9,9 @@
|
|||
</unitPaths>
|
||||
</build>
|
||||
|
||||
<test>
|
||||
<framework>blaise</framework>
|
||||
<testSource>testrunner.pas</testSource>
|
||||
</test>
|
||||
|
||||
</project>
|
||||
|
|
|
|||
366
stdlib/src/main/pascal/json.parser.pas
Normal file
366
stdlib/src/main/pascal/json.parser.pas
Normal 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
37
stdlib/src/main/pascal/json.reader.pas
Normal 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
747
stdlib/src/main/pascal/json.types.pas
Normal 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
361
stdlib/src/main/pascal/json.writer.pas
Normal 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
300
stdlib/src/test/pascal/json.tests.pas
Normal 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
28
stdlib/src/test/pascal/test.registry.pas
Normal 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
34
stdlib/src/test/pascal/testrunner.pas
Normal 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
31
stdlib/src/test/run-tests.sh
Executable 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
|
||||
Loading…
Reference in a new issue