* JSON Schema

packages/fcl-jsonschema/Makefile

@@ -0,0 +1,2 @@
+PACKAGE_NAME=fcl-jsonschema
+include ../build/Makefile.pkg

packages/fcl-jsonschema/fpmake.pp

@@ -0,0 +1,89 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses {$ifdef unix}cthreads,{$endif} fpmkunit;
+
+Var
+  T : TTarget;
+  P : TPackage;
+begin
+  With Installer do
+    begin
+{$endif ALLPACKAGES}
+
+    P:=AddPackage('fcl-jsonschema');
+    P.ShortName:='fcljschm';
+{$ifdef ALLPACKAGES}
+    P.Directory:=ADirectory;
+{$endif ALLPACKAGES}
+    P.Version:='3.3.1';
+    P.Dependencies.Add('fcl-base');
+    P.Dependencies.Add('rtl-objpas');
+    P.Dependencies.Add('fcl-fpcunit');
+    P.Dependencies.Add('fcl-json');
+    P.Dependencies.Add('regexpr');
+    P.Author := 'Michael van Canneyt';
+    P.License := 'LGPL with modification, ';
+    P.HomepageURL := 'www.freepascal.org';
+    P.Email := '';
+    P.Description := 'Json Schema validator implementation.';
+    P.NeedLibC:= false;
+    P.OSes:=AllOSes-[embedded,msdos,win16,macosclassic,palmos,zxspectrum,msxdos,amstradcpc,sinclairql,human68k];
+    if Defaults.CPU=jvm then
+      P.OSes := P.OSes - [java,android];
+
+    P.SourcePath.Add('src');
+
+    T:=P.Targets.AddUnit('fpjson.schema.consts.pp');
+    T.ResourceStrings:=true;
+    
+    T:=P.Targets.AddUnit('fpjson.schema.types.pp');
+    with T.Dependencies do
+      AddUnit('fpjson.schema.consts');
+
+    T:=P.Targets.AddUnit('fpjson.schema.schema.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson.schema.consts');
+      AddUnit('fpjson.schema.types');
+      end;
+
+    T:=P.Targets.AddUnit('fpjson.schema.reader.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson.schema.consts');
+      AddUnit('fpjson.schema.types');
+      AddUnit('fpjson.schema.schema');
+      end;
+    T:=P.Targets.AddUnit('fpjson.schema.loader.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson.schema.consts');
+      AddUnit('fpjson.schema.types');
+      AddUnit('fpjson.schema.schema');
+      end;
+    T:=P.Targets.AddUnit('fpjson.schema.writer.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson.schema.consts');
+      AddUnit('fpjson.schema.types');
+      AddUnit('fpjson.schema.schema');
+      end;
+
+    T:=P.Targets.AddUnit('fpjson.schema.validator.pp');
+    with T.Dependencies do
+      begin
+      AddUnit('fpjson.schema.consts');
+      AddUnit('fpjson.schema.types');
+      AddUnit('fpjson.schema.schema');
+      end;
+      
+{$ifndef ALLPACKAGES}
+    Run;
+    end;
+end.
+{$endif ALLPACKAGES}
+
+
+

packages/fcl-jsonschema/src/fpjson.schema.consts.pp

@@ -0,0 +1,180 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema constants
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FpJson.Schema.Consts;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils;
+  {$ELSE}
+  SysUtils;
+  {$ENDIF}
+
+Const
+  // Keywords
+
+  // Core
+  SJKWUnknown = '';
+  SJKWId = '$id';
+  SJKWOldId = 'id';
+  SJKWSchema = '$schema';
+  SJKWDefs = '$defs';
+  SJKWRef = '$ref';
+  SJKWAnchor = '$anchor';
+  SJKWVocabulary = '$vocabulary';
+  SJKWComment = '$comment';
+  SJKWDynamicRef = '$dynamicRef';
+  SJKWDynamicAnchor = '$dynamicAnchor';
+  // Applicator
+  SJKWAllOf = 'allOf';
+  SJKWAnyOf = 'anyOf';
+  SJKWOneOf = 'oneOf';
+  SJKWNot = 'not';
+  SJKWIf = 'if';
+  SJKWThen = 'then';
+  SJKWElse = 'else';
+  SJKWProperties = 'properties';
+  SJKWPatternProperties = 'patternProperties';
+  SJKWAdditionalProperties = 'additionalProperties';
+  SJKWPropertyNames = 'propertyNames';
+  SJKWDependentSchemas = 'dependentSchemas';
+  SJKWDependentRequired = 'dependentRequired';
+  SJKWPrefixItems = 'prefixItems';
+  SJKWItems = 'items';
+  SJKWContains = 'contains';
+
+  // Metadata
+  SJKWTitle = 'title';
+  SJKWDescription = 'description';
+  SJKWDefault = 'default';
+  SJKWDeprecated = 'deprecated';
+  SJKWExamples = 'examples';
+  SJKWReadOnly = 'readOnly';
+  SJKWWriteOnly = 'writeOnly';
+
+  // Validation
+  SJKWMultipleOf = 'multipleOf';
+  SJKWMaximum = 'maximum';
+  SJKWExclusiveMaximum = 'exclusiveMaximum';
+  SJKWMinimum = 'minimum';
+  SJKWExclusiveMinimum = 'exclusiveMinimum';
+  SJKWMaxLength = 'maxLength';
+  SJKWMinLength = 'minLength';
+  SJKWPattern = 'pattern';
+  SJKWAdditionalItems = 'additionalItems';
+  SJKWMaxItems = 'maxItems';
+  SJKWMinItems = 'minItems';
+  SJKWUniqueItems = 'uniqueItems';
+  SJKWMaxProperties = 'maxProperties';
+  SJKWMinProperties = 'minProperties';
+  SJKWMaxContains = 'maxContains';
+  SJKWMinContains = 'minContains';
+  SJKWRequired = 'required';
+  SJKWDefinitions = 'definitions';
+  SJKWEnum = 'enum';
+  SJKWType = 'type';
+  SJKWFormat = 'format';
+  SJKWConst = 'const';
+  SJKWUnevaluatedItems = 'unevaluatedItems';
+  SJKWUnevaluatedProperties = 'unevaluatedProperties';
+
+  SJKWContentEncoding = 'contentEncoding';
+  SJKWContentMediaType =  'contentMediaType';
+  SJKWContentSchema = 'contentSchema';
+
+  // Types
+  STNone    = '';
+  STNull    = 'null';
+  STBoolean = 'boolean';
+  STInteger = 'integer';
+  STNumber  = 'number';
+  STString  = 'string';
+  STArray   = 'array';
+  STObject  = 'object';
+  STAny     = 'any';
+
+  SFmtDatetime = 'date-time';
+  SFmtDate = 'date';
+  SFmtTime = 'time';
+  SFmtDuration = 'duration';
+  SFmtEmail = 'email';
+  SFmtIdnEmail = 'idn-email';
+  SFmtHostname = 'hostname';
+  SFmtIdnHostname = 'idn-hostname';
+  SFmtIPV4 = 'ipv4';
+  SFmtIPV6 = 'ipv6';
+  SFmtURI = 'uri';
+  SFmtURIReference = 'uri-reference';
+  SFmtIRI = 'iri';
+  SFmtIRIReference = 'iri-reference';
+  SFmtUUID = 'uuid';
+  SFmtURITemplate = 'uri-template';
+  SFmtJSONPointer = 'json-pointer';
+  SFmtRelativeJSONPointer = 'relative-json-pointer';
+  SFmtRegex = 'regex';
+
+Resourcestring
+  // Types
+  SErrOnlySimpleValues = 'Only simple values can be stored as Schema value';
+
+  // Reader
+  SErrInvalidNumber = 'Invalid number : %s';
+  SErrInvalidToken = 'Invalid token at %s: "%s"';
+  SErrUnexpectedToken = 'Invalid token at %s, expected: "%s", got: "%s"';
+  SErrUnexpectedTokenNotInSet = 'Invalid token, expected one of: [%s], got: "%s"';
+  SErrNumberIsNotAnInteger = 'Number is not an integer at %s: %s';
+  SErrIntegerIsNegative = 'Integer is negative %s: %d';
+  SErrUnexpectedType = 'Invalid JSON type at <<%s>>, expected: "%s", got: "%s"';
+  SErrUnexpectedTypeNotInSet = 'Invalid JSON type at <<%s>>, expected one of: [%s], got: "%s"';
+  SErrInvalidType = 'Invalid JSON type %s at <<%s>>';
+
+  // Writer
+  SErrNoObjectsOnStack = 'No objects created on stack';
+  SPropertyNameAlreadySet = 'Cannot set property name to "%s", it is already set to "%s"';
+  SErrNotAtStructuredValue = 'Current value is not a structured value';
+  SErrCannotPop = 'Cannot pop, stack empty';
+  SErrNoPushOnSimpleValue = 'Cannot push on top of non-structured value';
+  SErrNoPropertyNameForPush = 'Cannot push to object without property name';
+
+  // Validator
+  SSchemaInfo = 'Schema info: "%s" : %s';
+  SErrNoFalseMatch = '"false" schema does not match any JSON';
+  SErrTypeMismatch = 'JSON type "%s" does not match one of %s';
+  SNotNumericalData = '%s is not numerical data, cannot check %s';
+  SNotStringData = '%s is not string data, cannot check %s';
+  SNotArrayData = '%s is not array data, cannot check %s';
+  SNotObjectData = '%s is not object data, cannot check %s';
+  SViolatesNumericalCondition = '%g violates numerical condition %s: %g';
+  SViolatesArrayCondition = '%s violates array condition %s: %s';
+  SViolatesObjectCondition = '%s violates object condition %s: %s';
+  SViolatesStringCondition = '"%s" violates string condition %s: %s';
+  SNotImplementedInValidator = 'Not implemented in validator %s';
+  SErrListCountMismatch = 'Data fails to comply to correct amount of schemas in "%s" list: %d (list has %d items)';
+  SIfResult = 'If() condition at path "%s" result: %s';
+  SErrMissingRequiredDependent = 'Missing required dependent "%s"';
+  SErrNotEqual = 'Not equal to JSON value %s';
+  SErrSchemaMatchesNot = 'JSON data Matches "not" schema';
+  SErrNotInList = 'Not in list of JSON values %s';
+
+implementation
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.loader.pp

@@ -0,0 +1,489 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema loader - load from JSON data
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit FpJson.Schema.Loader;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, FpJson.Data, FpJson.Schema.Schema, FpJson.Schema.Types;
+  {$ELSE}
+  Classes, SysUtils, fpjson, FpJson.Schema.Schema, FpJson.Schema.Types;
+  {$ENDIF}
+
+Type
+  TJSONtypes = set of TJSONtype;
+  EJsonSchemaLoader = class(EJSONSchema);
+
+  { TJsonSchemaLoader }
+  TKeywordInfo = Record
+    Schema : TJSONSChema;
+    Keyword : TJSONStringType;
+    Value : TJSONData;
+  end;
+
+  TKeyWordHandler = Procedure(Sender : TObject; const Info : TKeywordInfo; var Handled: Boolean) of object;
+  TSchemaLoadOption = (loSkipUnknownProperties);
+  TSchemaLoadOptions = Set of TSchemaLoadOption;
+
+  TJsonSchemaLoader = class(TComponent)
+  private
+    FCurrentKeyword : TJSONSchemaKeyword;
+    FOnUnknownKeyword: TKeyWordHandler;
+    FOptions: TSchemaLoadOptions;
+    procedure ReadVocabulary(aData: TJSONData; aSchema: TJSONSchema);
+  Protected
+    class function JSONTypesToString(aTypes: TJSONTypes): string;
+    function GetMatchType(aData : TJSONData) : TSchemaMatchType;
+    // Check routines
+    Procedure CheckType(aData : TJSONData; aType : TJSONtype; atKey : TJSONSchemaKeyword = jskUnknown);
+    Procedure CheckType(aData : TJSONData; aType : TJSONtype; atPos : String);
+    Procedure CheckType(aData : TJSONData; aTypes : TJSONtypes; atKey : TJSONSchemaKeyword = jskUnknown);
+    Procedure CheckType(aData : TJSONData; aTypes : TJSONtypes; atPos : String);
+    procedure InvalidType(aType: TJSONType);
+    // Read simple values
+    function ReadBoolean(aData : TJSONData): Boolean;
+    function ReadNumber(aData : TJSONData): Double;
+    function ReadPositiveInteger(aData : TJSONData): cardinal;
+    function ReadString(aData : TJSONData): String;
+    // Handle unknown props
+    function HandleUnknownKeyWord(const aInfo : TKeywordInfo) : Boolean; virtual;
+    // Read various special properties
+    procedure ReadDependentRequired(aData: TJSONData; aList: TSchemaDependentRequiredList);
+    procedure ReadArray(aData : TJSONData; aValues: TJSONArray);
+    procedure ReadNamedSchemas(aData : TJSONData; ASchema: TJsonSchema; aList: TJSONSchemaList);
+    procedure ReadItems(aData : TJSONData; ASchema: TJsonSchema);
+    procedure ReadProperties(aData : TJSONData; ASchema: TJsonSchema);
+    procedure ReadSchemaArray(aData : TJSONData; ASchema: TJsonSchema; ASchemaList: TJsonSchemaList);
+    procedure ReadStringArray(aData : TJSONData; AStrings: TStrings);
+    procedure ReadTypes(aData : TJSONData; AJsonSchema: TJsonSchema);
+    // Main entry routines
+    procedure ReadSchema(aData : TJSONData; ASchema: TJsonSchema);
+    procedure ReadSchemaObject(aObject : TJSONObject; ASchema: TJsonSchema);
+  public
+    procedure ReadFromJSON(aSchema: TJSONSchema; aJSONData : TJSONData);
+  Published
+    property OnUnknownKeyword : TKeyWordHandler read FOnUnknownKeyword Write FOnUnknownKeyword;
+    property Options : TSchemaLoadOptions Read FOptions Write FOptions;
+  end;
+
+implementation
+
+uses FpJson.Schema.Consts;
+
+{ ---------------------------------------------------------------------
+  Auxiliary routines
+  ---------------------------------------------------------------------}
+
+procedure TJsonSchemaLoader.CheckType(aData: TJSONData; aType: TJSONtype; atKey: TJSONSchemaKeyword);
+
+var
+  Loc : String;
+
+begin
+  if aData.JSONType=aType then
+    exit;
+  Loc:=atkey.AsString;
+  if Loc='' then
+    Loc:=aData.asJSON;
+  Raise EJsonSchemaLoader.CreateFmt(SErrUnexpectedType,[Loc,JSONTypeName(aType),JSONTypeName(aData.JSONType)]);
+end;
+
+procedure TJsonSchemaLoader.CheckType(aData: TJSONData; aType: TJSONtype; atPos: String);
+
+begin
+  if aData.JSONType=aType then
+    exit;
+  Raise EJsonSchemaLoader.CreateFmt(SErrUnexpectedType,[atPos,JSONTypeName(aType),JSONTypeName(aData.JSONType)]);
+end;
+
+class function TJsonSchemaLoader.JSONTypesToString(aTypes : TJSONTypes) : string;
+
+var
+  T : TJSONType;
+
+begin
+  Result:='';
+  For T in TJSONType do
+    if T in aTypes then
+      begin
+      if Result<>'' then
+        Result:=Result+', ';
+      Result:=Result+JSONTypeName(T);
+      end;
+end;
+
+function TJsonSchemaLoader.GetMatchType(aData: TJSONData): TSchemaMatchType;
+begin
+  case aData.JSONType of
+    jtBoolean:
+      if aData.AsBoolean then
+        Result:=smAny
+      else
+        Result:=smNone;
+    jtObject:
+      Result:=smConstrained;
+  end;
+end;
+
+function TJsonSchemaLoader.HandleUnknownKeyWord(const aInfo: TKeywordInfo): Boolean;
+begin
+  Result:=False;
+  if Assigned(FOnUnknownKeyword) then
+    FOnUnknownKeyword(Self,aInfo,Result);
+end;
+
+procedure TJsonSchemaLoader.CheckType(aData: TJSONData; aTypes: TJSONtypes; atKey: TJSONSchemaKeyword);
+
+var
+  Types,Loc : String;
+
+begin
+  if aData.JSONType in aTypes then
+    exit;
+  Loc:=atkey.AsString;
+  if Loc='' then
+    Loc:=aData.asJSON;
+  Types:=JSONTypesToString(aTypes);
+  Raise EJsonSchemaLoader.CreateFmt(SErrUnexpectedTypeNotInSet,[Loc,Types,JSONTypeName(aData.JSONType)]);
+end;
+
+procedure TJsonSchemaLoader.CheckType(aData: TJSONData; aTypes: TJSONtypes; atPos: String);
+var
+  Types : String;
+
+begin
+  if aData.JSONType in aTypes then
+    exit;
+  Types:=JSONTypesToString(aTypes);
+  Raise EJsonSchemaLoader.CreateFmt(SErrUnexpectedTypeNotInSet,[atPos,Types,JSONTypeName(aData.JSONType)]);
+end;
+
+procedure TJsonSchemaLoader.InvalidType(aType: TJSONType);
+begin
+  Raise EJsonSchemaLoader.CreateFmt(SErrInvalidType,[JSONTypeName(aType),FCurrentKeyWord.AsString]);
+end;
+
+function TJsonSchemaLoader.ReadBoolean(aData: TJSONData): Boolean;
+
+
+begin
+  CheckType(aData,jtBoolean,FCurrentKeyword);
+  Result:=aData.AsBoolean;
+end;
+
+function TJsonSchemaLoader.ReadNumber(aData: TJSONData): Double;
+
+
+begin
+  CheckType(aData,jtNumber,FCurrentKeyword);
+  Result:=aData.AsFloat;
+end;
+
+function TJsonSchemaLoader.ReadPositiveInteger(aData: TJSONData): cardinal;
+
+var
+  aValue : Int64;
+begin
+  CheckType(aData,jtNumber,FCurrentKeyword);
+  if (TJSONNumber(aData).NumberType<>ntInteger) and (aData.AsFloat<>Trunc(aData.asFloat)) then
+      raise EJsonSchemaLoader.CreateFmt(SErrNumberIsNotAnInteger, [FCurrentKeyword.AsString, aData.asJSON]);
+  aValue:=aData.Asint64;
+  if aValue<0 then
+    raise EJsonSchemaLoader.CreateFmt(SErrIntegerIsNegative, [FCurrentKeyword.AsString, aValue]);
+  Result:=aValue;
+end;
+
+
+{ ---------------------------------------------------------------------
+  Actual reading of Schema
+  ---------------------------------------------------------------------}
+
+procedure TJsonSchemaLoader.ReadArray(aData: TJSONData; aValues: TJSONArray);
+
+var
+  i : Integer;
+
+begin
+  CheckType(aData,jtArray,FCurrentKeyWord);
+  for I:=0 to aData.Count-1 do
+    aValues.Add(aData.Items[I].clone);
+end;
+
+
+procedure TJsonSchemaLoader.ReadNamedSchemas(aData: TJSONData; ASchema: TJsonSchema; aList: TJSONSchemaList);
+var
+  Item : TJSONSchema;
+  Enum : TJSONEnum;
+
+begin
+  CheckType(aData,jtObject,FCurrentKeyword);
+  for Enum in aData do
+    begin
+    item:=aSchema.CreateChildSchema(Enum.Key);
+    aList.Add(Item);
+    ReadSchema(Enum.Value,Item);
+    end;
+end;
+
+procedure TJsonSchemaLoader.ReadItems(aData: TJSONData; ASchema: TJsonSchema);
+
+var
+  item: TJsonSchema;
+
+begin
+  case aData.JSONType of
+  jtBoolean,
+  jtObject:
+    begin
+    item:=ASchema.CreateChildSchema('items');
+    ASchema.Items.Add(Item);
+    ReadSchema(TJSONObject(aData),Item);
+    end;
+  jtArray:
+    begin
+    ReadSchemaArray(aData, ASchema, ASchema.Items);
+    end;
+  else
+    InvalidType(aData.JSONType);
+  end;
+end;
+
+
+procedure TJsonSchemaLoader.ReadProperties(aData: TJSONData; ASchema: TJsonSchema);
+var
+  Item: TJsonSchema;
+  Enum : TJSONEnum;
+
+begin
+  checkType(aData,jtObject,FCurrentKeyword);
+  for Enum in aData do
+    begin
+    item:=aSchema.CreateChildSchema(Enum.key);
+    aSchema.Properties.Add(Item);
+    ReadSchema(Enum.Value,Item);
+    end;
+end;
+
+
+
+procedure TJsonSchemaLoader.ReadSchema(aData: TJSONData; ASchema: TJsonSchema);
+
+
+begin
+  Case aData.JSONType of
+    jtBoolean,
+    jtObject:
+      begin
+      aSchema.MatchType:=GetMatchType(aData);
+      if aData.JSONType=jtObject then
+        ReadSchemaObject(TJSONObject(aData),aSchema);
+      end
+  else
+    InvalidType(aData.JSONType);
+  end;
+end;
+
+procedure TJsonSchemaLoader.ReadDependentRequired(aData : TJSONData; aList: TSchemaDependentRequiredList);
+
+var
+  Item : TSchemaDependentRequired;
+  enum : TJSONEnum;
+
+begin
+  checkType(aData,jtObject,FCurrentKeyword);
+  for Enum in aData do
+    begin
+    item:=aList.AddDependent(Enum.Key);
+    ReadStringArray(Enum.Value,Item.Required);
+    end;
+end;
+
+procedure TJsonSchemaLoader.ReadVocabulary(aData : TJSONData; aSchema: TJSONSchema);
+
+var
+  Enum : TJSONEnum;
+
+begin
+  CheckType(aData,jtObject);
+  for Enum in aData do
+    begin
+    CheckType(enum.Value,jtBoolean,jskVocabulary);
+    aSchema.Vocabulary.AddVocabulary(Enum.Key).Enabled:=Enum.Value.asBoolean;
+    end;
+end;
+
+procedure TJsonSchemaLoader.ReadSchemaObject(aObject: TJSONObject; ASchema: TJsonSchema);
+
+var
+  Enum : TJSONEnum;
+  aData : TJSONData;
+  keyword : TJSONSchemaKeyword;
+  Info : TKeywordInfo;
+
+begin
+  For Enum in aObject do
+    begin
+    keyWord:=TJSONSchemaKeyword.FromString(Enum.Key);
+    aData:=Enum.Value;
+    FCurrentKeyWord:=KeyWord;
+    case KeyWord of
+      // Older
+      jskDefinitions,
+      jskDefs: ReadNamedSchemas(aData,ASchema,aSchema.Defs);
+      jskProperties: ReadProperties(aData,ASchema);
+      jskDependentSchemas: ReadNamedSchemas(aData,ASchema,aSchema.DependentSchemas);
+      jskType: ReadTypes(aData,ASchema);
+      jskDescription: ASchema.MetaData.Description := ReadString(aData);
+      jskTitle: ASchema.MetaData.Title := ReadString(aData);
+      jskDefault: aSchema.MetaData.DefaultValue:=aData.Clone;
+      jskSchema: ASchema.Schema := ReadString(aData);
+      jskConst : ASchema.Validations.constValue:=aData.Clone;
+      // Older
+      jskIdDraft4,
+      jskId: ASchema.Id := ReadString(aData);
+      jskAnchor: ASchema.Anchor:= ReadString(aData);
+      jskDynamicAnchor: ASchema.DynamicAnchor:= ReadString(aData);
+      jskComment: ASchema.Comment:=ReadString(aData);
+      jskMinimum: ASchema.Validations.Minimum := ReadNumber(aData);
+      jskMaximum: ASchema.Validations.Maximum := ReadNumber(aData);
+      jskMaxItems: ASchema.Validations.MaxItems := ReadPositiveInteger(aData);
+      jskMinItems: ASchema.Validations.MinItems := ReadPositiveInteger(aData);
+      jskMaxLength: ASchema.Validations.MaxLength := ReadPositiveInteger(aData);
+      jskMinLength: ASchema.Validations.MinLength := ReadPositiveInteger(aData);
+      jskMaxProperties: ASchema.Validations.MaxProperties := ReadPositiveInteger(aData);
+      jskMinProperties: ASchema.Validations.MinProperties := ReadPositiveInteger(aData);
+      jskMaxContains : aSchema.Validations.MaxContains:=ReadPositiveInteger(aData);
+      jskMinContains : aSchema.Validations.MaxContains:=ReadPositiveInteger(aData);
+      jskUniqueItems: ASchema.Validations.UniqueItems := ReadBoolean(aData);
+      jskExclusiveMaximum: ASchema.Validations.ExclusiveMaximum := ReadNumber(aData);
+      jskExclusiveMinimum: ASchema.Validations.ExclusiveMinimum := ReadNumber(aData);
+      jskMultipleOf : ASchema.Validations.MultipleOf := ReadNumber(aData);
+      jskEnum: ReadArray(aData,ASchema.Validations.Enum);
+      jskItems: ReadItems(aData,ASchema);
+      jskPrefixItems: ReadSchemaArray(aData,aSchema,aSchema.PrefixItems);
+      // For backwards compatibility
+      jskAdditionalItems: ReadItems(aData,aSchema);
+      jskAdditionalProperties: ReadSchema(aData,ASchema.AdditionalProperties);
+      jskPattern: ASchema.Validations.Pattern := ReadString(aData);
+      jskPatternProperties: ReadNamedSchemas(aData,aSchema,ASchema.PatternProperties);
+      jskRequired: ReadStringArray(aData,ASchema.Validations.Required);
+      jskFormat: ASchema.Validations.Format := ReadString(aData);
+      jskRef: ASchema.Ref := ReadString(aData);
+      jskDynamicRef: ASchema.DynamicRef := ReadString(aData);
+      jskAllOf: ReadSchemaArray(aData,ASchema, ASchema.AllOf);
+      jskAnyOf: ReadSchemaArray(aData,ASchema, ASchema.AnyOf);
+      jskOneOf: ReadSchemaArray(aData,ASchema, ASchema.OneOf);
+      jskIf: ReadSchema(aData,ASchema.IfSchema);
+      jskThen: ReadSchema(aData,ASchema.ThenSchema);
+      jskElse: ReadSchema(aData,ASchema.ElseSchema);
+      jskNot: ReadSchema(aData,ASchema.NotSchema);
+      jskContains : ReadSchema(aData,ASchema.Contains);
+      jskPropertyNames : ReadSchema(aData,aSchema.PropertyNames);
+      jskDependentRequired: ReadDependentRequired(aData,aSchema.Validations.DependentRequired);
+      jskUnevaluatedItems : ReadSchema(aData,aSchema.UnevaluatedItems);
+      jskUnevaluatedProperties : ReadSchema(aData,aSchema.UnevaluatedProperties);
+      jskContentEncoding : ASchema.Validations.ContentEncoding := ReadString(aData);
+      jskContentMediaType  : ASchema.Validations.ContentMediaType := ReadString(aData);
+      jskContentSchema : ReadSchema(aData,ASchema.Validations.ContentSchema);
+      jskExamples : ReadArray(aData,aSchema.MetaData.Examples);
+      jskDeprecated : aSchema.Metadata.Deprecated:=ReadBoolean(aData);
+      jskReadOnly : aSchema.Metadata.ReadOnly:=ReadBoolean(aData);
+      jskWriteOnly : aSchema.Metadata.WriteOnly:=ReadBoolean(aData);
+      jskVocabulary : ReadVocabulary(aData,aSchema);
+      jskUnknown:
+        begin
+        Info.Keyword:=Enum.Key;
+        Info.Schema:=aSchema;
+        Info.Value:=Enum.Value;
+        if not HandleUnknownKeyWord(Info) then
+          if Not (loSkipUnknownProperties in Options) then
+            aSchema.UnknownKeywordData.Add(Info.Keyword,Info.Value.Clone);
+        end;
+      end;
+    end;
+end;
+
+procedure TJsonSchemaLoader.ReadSchemaArray(aData: TJSONData; ASchema: TJsonSchema; ASchemaList: TJsonSchemaList);
+
+var
+  Item : TJsonSchema;
+  Enum : TJSONEnum;
+
+begin
+  CheckType(aData,jtArray);
+  For Enum in aData do
+    begin
+    Case Enum.Value.JSONType of
+      jtBoolean,
+      jtObject:
+        begin
+        Item:=ASchema.CreateChildSchema;
+        ASchemaList.Add(Item);
+        ReadSchema(TJSONObject(enum.Value),Item);
+        end;
+    else
+      InvalidType(Enum.Value.JSONType);
+    end;
+    end;
+end;
+
+function TJsonSchemaLoader.ReadString(aData: TJSONData): String;
+
+begin
+  CheckType(aData,jtString);
+  Result:=aData.AsString;
+end;
+
+procedure TJsonSchemaLoader.ReadStringArray(aData: TJSONData; AStrings: TStrings);
+
+var
+  Enum : TJSONEnum;
+
+begin
+  CheckType(aData,jtArray);
+  for Enum in aData do
+    begin
+    CheckType(Enum.Value,jtString);
+    AStrings.Add(Enum.Value.AsString);
+    end;
+end;
+
+procedure TJsonSchemaLoader.ReadTypes(aData: TJSONData; AJsonSchema: TJsonSchema);
+var
+  aTypes : TSchemaSimpleTypes;
+  Enum : TJSONEnum;
+
+begin
+  aTypes:=[];
+  CheckType(aData,[jtString,jtArray]);
+  for Enum in aData do
+    begin
+    CheckType(Enum.Value,jtString,FCurrentKeyword);
+    Include(aTypes,TSchemaSimpleType.FromString(Enum.Value.AsString));
+    end;
+  AJSONSchema.Validations.Types:=aTypes;
+end;
+
+procedure TJsonSchemaLoader.ReadFromJSON(aSchema: TJSONSchema; aJSONData: TJSONData);
+begin
+  ReadSchema(aJSONData,aSchema);
+end;
+
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.reader.pp

@@ -0,0 +1,810 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema reader - read directly from stream
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FpJson.Schema.Reader;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, FpJson.Data, FpJson.Schema.Schema, FpJson.Schema.Types, FpJson.Scanner;
+  {$ELSE}
+  Classes, SysUtils, fpjson, FpJson.Schema.Schema, FpJson.Schema.Types, jsonscanner;
+  {$ENDIF}
+
+Type
+  EJsonSchemaReader = class(EJSONSchema);
+
+  TJsonTokens = Set of TJsonToken;
+
+  TKeywordInfo = Record
+    Schema : TJSONSChema;
+    Keyword : TJSONStringType;
+    Scanner : TJSONScanner;
+  end;
+
+  TKeyWordHandler = Procedure(Sender : TObject; const Info : TKeywordInfo; var Handled: Boolean) of object;
+  TSchemaReadOption = (roSkipUnknownProperties);
+  TSchemaReadOptions = Set of TSchemaReadOption;
+
+
+  { TJsonSchemaReader }
+
+  TJsonSchemaReader = class(TComponent)
+  private
+    FOnUnknownKeyWord: TKeywordHandler;
+    FOptions: TSchemaReadOptions;
+    FScanner : TJSONScanner;
+  Protected
+    function GetMatchType(aToken: TJSONToken): TSchemaMatchType;
+    // Getting scanner info
+    function GetToken : TJSONToken;
+    function GetTokenString: TJSONStringType;
+    function CurPosAsString: String;
+    function TokensToString(aTokens: TJSONTokens): String;
+    // Checking things
+    function  CheckNextToken(aExpectedTokens: TJSONTokens): TJSONToken;
+    procedure CheckNextToken(aExpectedToken: TJSONToken);
+    procedure CheckToken(aExpectedToken, aActualToken: TJSONToken);
+    procedure CheckToken(aExpectedTokens: TJSONTokens; aActualToken: TJSONToken);
+    procedure InvalidToken(aToken: TJSONToken);
+    // Parsing utilities
+    function StringToJSONNumber(S: RawByteString): TJSONNumber;
+    function StringToJSONString(S: RawByteString): TJSONString;
+    function ReadJSONData(aToken: TJSONToken): TJSONData;
+    procedure ReadJSONArray(aArray: TJSONArray);
+    procedure ReadJSONObject(aObj: TJSONObject);
+    function ReadBoolean: Boolean;
+    function ReadNumber: Double;
+    function ReadPositiveInteger: Cardinal;
+    function ReadString: String;
+    // Read properties
+    function HandleUnknownKeyword(aInfo : TKeyWordInfo) : Boolean;
+    procedure ReadDependentRequired(aSchema: TJsonSchema; aList: TSchemaDependentRequiredList);
+//    procedure ReadSchemaValue(aSchema: TJsonSchema; AValue: TSchemaValue; const AValidTypes: TJsonTokens = []);
+    procedure ReadArray(aValues: TJSONArray; Full : Boolean);
+    procedure ReadNamedSchemas(ASchema: TJsonSchema; aList: TJSONSchemaList);
+    procedure ReadItems(ASchema: TJsonSchema);
+    procedure ReadProperties(ASchema: TJsonSchema);
+    procedure ReadSchemaArray(ASchema: TJsonSchema; ASchemaList: TJsonSchemaList);
+    procedure ReadStringArray(AStrings: TStrings);
+    procedure ReadTypes(AJsonSchema: TJsonSchema);
+    procedure ReadVocabulary(aSchema: TJsonSchema);
+    // Entry points
+    procedure ReadSchemaObject(ASchema: TJsonSchema);
+    procedure ReadSchema(ASchema: TJsonSchema);
+    property Scanner : TJSONScanner Read FScanner;
+  public
+    procedure ReadFromFile(aSchema: TJSONSchema; const AFilename: String);
+    procedure ReadFromStream(aSchema: TJSONSchema; AStream: TStream);
+    procedure ReadFromString(aSchema: TJSONSchema; const AString: TJSONStringType);
+    function ReadJSONData: TJSONData;
+    Property Options : TSchemaReadOptions Read FOptions Write FOptions;
+    Property OnUnknownKeyWord : TKeywordHandler Read FOnUnknownKeyWord Write FOnUnknownKeyWord;
+  end;
+
+implementation
+
+uses fpjson.schema.consts;
+
+
+{ ---------------------------------------------------------------------
+  Auxiliary routines
+  ---------------------------------------------------------------------}
+
+function TJsonSchemaReader.CurPosAsString: String;
+
+begin
+  Result:=Format('%d:%d',[FScanner.CurRow,FScanner.CurColumn]);
+end;
+
+procedure TJsonSchemaReader.InvalidToken(aToken: TJSONToken);
+
+begin
+  raise EJsonSchemaReader.CreateFmt(SErrInvalidToken, [CurPosAsString, TokenInfos[aToken]]);
+end;
+
+procedure TJsonSchemaReader.CheckToken(aExpectedToken,aActualToken: TJSONToken);
+
+begin
+  if aExpectedToken<>aActualToken then
+    raise EJsonSchemaReader.CreateFmt(SErrUnexpectedToken, [CurPosAsString, TokenInfos[aExpectedToken], TokenInfos[aActualToken]]);
+end;
+
+function TJsonSchemaReader.TokensToString(aTokens : TJSONTokens) : String;
+
+var
+  T : TJSONToken;
+  S : String;
+
+begin
+  S:='';
+  For T in aTokens do
+    begin
+    if (S<>'') then
+      S:=S+', ';
+    S:=S+'"'+TokenInfos[T]+'"';
+    end;
+  Result:=S;
+end;
+
+procedure TJsonSchemaReader.CheckToken(aExpectedTokens : TJSONTokens; aActualToken: TJSONToken);
+
+begin
+  if not (aActualToken in aExpectedTokens) then
+    raise EJsonSchemaReader.CreateFmt(SErrUnexpectedTokenNotInSet, [TokensToString(aExpectedTokens), TokenInfos[aActualToken]]);
+end;
+
+
+function TJsonSchemaReader.CheckNextToken(aExpectedTokens : TJSONTokens) : TJSONToken;
+
+begin
+  Result:=GetToken;
+  CheckToken(aExpectedTokens,Result);
+end;
+
+procedure TJsonSchemaReader.CheckNextToken(aExpectedToken : TJSONToken);
+begin
+  CheckToken(aExpectedToken,GetToken);
+end;
+
+function TJsonSchemaReader.StringToJSONNumber(S : RawByteString): TJSONNumber;
+
+var
+  I : integer;
+  I64 : Int64;
+  Q : QWord;
+  F : TJSONFloat;
+
+begin
+  if TryStrToInt(S,I) then
+    Exit(TJSONIntegerNumber.Create(I));
+  if TryStrToInt64(S,I64) then
+    Exit(TJSONInt64Number.Create(I64));
+  if TryStrToQWord(S,Q) then
+    Exit(TJSONQWordNumber.Create(Q));
+  Val(S,F,I);
+  If (I<>0) then
+    EConvertError.CreateFmt(SErrInvalidNumber,[S]);
+  Result:=TJSONFloatNumber.Create(F);
+end;
+
+function TJsonSchemaReader.StringToJSONString(S : RawByteString): TJSONString;
+
+begin
+  Result:=TJSONString.Create(UTF8Decode(S))
+end;
+
+function TJsonSchemaReader.GetTokenString: TJSONStringType;
+
+begin
+  Result:=FScanner.CurTokenString;
+end;
+
+function TJsonSchemaReader.GetToken: TJSONToken;
+
+const
+  IgnoredTokens = [tkWhitespace,tkComment];
+
+begin
+  repeat
+    Result:=FScanner.FetchToken;
+  until Not (Result in IgnoredTokens);
+end;
+
+function TJsonSchemaReader.ReadBoolean: Boolean;
+
+var
+  aToken : TJSONToken;
+
+begin
+  aToken:=GetToken;
+  CheckToken([tkTrue,tkFalse],aToken);
+  Result:=aToken=tkTrue;
+end;
+
+function TJsonSchemaReader.ReadNumber: Double;
+
+var
+  N : TJSONNumber;
+  aToken : TJSONToken;
+begin
+  aToken:=GetToken;
+  CheckToken(tkNumber,aToken);
+  N:=StringToJSONNumber(GetTokenString);
+  try
+    Result:=N.AsFloat;
+  finally
+    N.Free;
+  end;
+end;
+
+function TJsonSchemaReader.ReadPositiveInteger: Cardinal;
+
+var
+  N : TJSONNumber;
+  aToken : TJSONToken;
+  aValue : Int64;
+begin
+  aToken:=GetToken;
+  CheckToken(tkNumber,aToken);
+  N:=StringToJSONNumber(GetTokenString);
+  try
+    if (N.NumberType<>ntInteger) and (N.AsFloat<>Trunc(N.asFloat)) then
+      raise EJsonSchemaReader.CreateFmt(SErrNumberIsNotAnInteger, [CurPosAsString, GetTokenString]);
+
+    aValue:=N.Asint64;
+
+    if aValue<0 then
+      raise EJsonSchemaReader.CreateFmt(SErrIntegerIsNegative, [CurPosAsString, aValue]);
+    Result:=aValue;
+  finally
+    N.Free;
+  end;
+end;
+
+
+{ ---------------------------------------------------------------------
+  Actual reading of Schema
+  ---------------------------------------------------------------------}
+
+procedure TJsonSchemaReader.ReadJSONObject(aObj : TJSONObject);
+// On entry, we're on {
+
+var
+  aToken : TJSONToken;
+  aName : TJSONStringtype;
+
+begin
+  aToken:=CheckNextToken([tkString,tkIdentifier,tkCurlyBraceClose]);
+  While not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    aName:=GetTokenString;
+    CheckNextToken(tkColon);
+    aObj.Add(aNAme,ReadJSONData);
+    aToken:=CheckNextToken([tkComma,tkCurlyBraceClose]);
+    if aToken=tkComma then
+      aToken:=CheckNextToken([tkString,tkIdentifier]);
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+procedure TJsonSchemaReader.ReadJSONArray(aArray : TJSONArray);
+// On entry, we're on [
+
+var
+  aToken : TJSONToken;
+
+begin
+  Repeat
+    aToken:=GetToken;
+    if Not (aToken in [tkComma,tkSquaredBraceClose]) then
+      aArray.Add(ReadJSONData(aToken));
+  until (aToken in [tkSquaredBraceClose,tkEOF]);
+  CheckToken(tkSquaredBraceClose,aToken);
+end;
+
+
+function TJsonSchemaReader.ReadJSONData : TJSONData;
+
+// Read token and construct JSON Value from it
+
+begin
+  Result:=ReadJSONData(GetToken);
+end;
+
+function TJsonSchemaReader.ReadJSONData(aToken : TJSONToken) : TJSONData;
+// construct JSON value from atoken
+
+begin
+  Result:=nil;
+  try
+    case aToken of
+      tkNull : Result:=TJSONNull.Create;
+      tkNumber : Result:=StringToJSONNumber(GetTokenString);
+      tkTrue,
+      tkFalse : Result:=TJSONBoolean.Create(aToken=tkTrue);
+      tkString : Result:=TJSONString.Create(GetTokenString);
+      tkCurlyBraceOpen :
+        begin
+        Result:=TJSONObject.Create;
+        ReadJSONObject(TJSONObject(Result));
+        end;
+      tkSquaredBraceOpen :
+        begin
+        Result:=TJSONArray.Create;
+        ReadJSONArray(TJSONArray(Result));
+        end
+    else
+      InvalidToken(aToken);
+    end;
+  except
+    Result.Free;
+    Raise;
+  end;
+end;
+
+(*
+procedure TJsonSchemaReader.ReadSchemaValue(aSchema: TJsonSchema; AValue: TSchemaValue; const AValidTypes: TJsonTokens);
+
+var
+  aToken : TJSONToken;
+
+begin
+  aToken:=GetToken;
+  if aToken=tkEOF then
+    Exit;
+  if (aValidTypes<>[]) then
+    CheckToken(aValidTypes,aToken);
+  case aToken of
+  tkCurlyBraceOpen:
+    begin
+    aValue.Schema := aSchema.CreateChildSchema;
+    aValue.Schema.MatchType:=GetMatchType(aToken);
+    ReadSchemaObject(aValue.Schema);
+    end;
+  tkSquaredBraceOpen:
+    begin
+    aValue.List:=TSchemaValueList.Create(jskUnknown);
+    ReadArray(aValue.List,False);
+    end;
+  tkNumber:
+    aValue.SimpleValue:=StringToJSONNumber(GetTokenString);
+  tkString:
+    aValue.SimpleValue :=StringToJSONString(GetTokenString);
+  tkTrue,tkFalse:
+    aValue.SimpleValue:=TJSONBoolean.Create(aToken=tkTrue);
+  tkNull:
+    aValue.SimpleValue:=TJSONNull.Create();
+  end;
+end;
+*)
+procedure TJsonSchemaReader.ReadArray(aValues: TJSONArray; Full: Boolean);
+
+begin
+  if Full then
+    CheckNextToken(tkSquaredBraceOpen);
+  ReadJSONArray(aValues);
+end;
+
+
+procedure TJsonSchemaReader.ReadNamedSchemas(ASchema: TJsonSchema; aList : TJSONSchemaList);
+var
+  Item : TJSONSchema;
+  aName : TJSONStringType;
+  aToken : TJSONToken;
+
+begin
+  CheckNextToken(tkCurlyBraceOpen);
+  aToken:=GetToken;
+  While Not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    case aToken of
+    tkIdentifier,
+    tkString:
+      begin
+      aName:=GetTokenString;
+      item:=aSchema.CreateChildSchema(aName);
+      aList.Add(Item);
+      CheckNextToken(tkColon);
+      ReadSchema(Item);
+      end;
+    tkComma: ;
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+procedure TJsonSchemaReader.ReadFromFile(aSchema : TJSONSchema; const AFilename: String);
+var
+  fileStream: TFileStream;
+begin
+  fileStream := TFileStream.Create(AFilename, fmOpenRead or fmShareDenyWrite);
+  try
+    ReadFromStream(aSchema,fileStream);
+    aSchema.Name := ChangeFileExt(ExtractFileName(AFilename), '');
+  finally
+    fileStream.Free;
+  end;
+end;
+
+procedure TJsonSchemaReader.ReadFromStream(aSchema : TJSONSchema; AStream: TStream);
+
+begin
+  FScanner:= TJSONScanner.Create(AStream,[joUTF8]);
+  try
+    ReadSchema(aSchema)
+  finally
+    FScanner.Free;
+  end;
+end;
+
+procedure TJsonSchemaReader.ReadFromString(aSchema: TJSONSchema; const AString: TJSONStringType);
+var
+  S: TStringStream;
+begin
+  S:=TStringStream.Create(AString);
+  try
+    ReadFromStream(aSchema,S);
+  finally
+    S.Free;
+  end;
+end;
+
+function TJsonSchemaReader.GetMatchType(aToken : TJSONToken) : TSchemaMatchType;
+
+begin
+  case aToken of
+    tkTrue : Result:=smAny;
+    tkFalse : Result:=smNone;
+    tkCurlyBraceOpen : Result:=smConstrained;
+  else
+    InvalidToken(aToken);
+  end;
+end;
+
+procedure TJsonSchemaReader.ReadItems(ASchema: TJsonSchema);
+var
+  itemSchema: TJsonSchema;
+  aToken : TJSONToken;
+
+begin
+  aToken:=GetToken;
+  case aToken of
+   tkTrue,
+   tkFalse,
+   tkCurlyBraceOpen:
+    begin
+      itemSchema := ASchema.CreateChildSchema;
+      itemSchema.Name := 'items';
+      ASchema.Items.Add(itemSchema);
+      ItemSchema.MatchType:=GetMatchType(aToken);
+      if aToken=tkCurlyBraceOpen then
+        ReadSchemaObject(itemSchema);
+    end;
+    tkSquaredBraceOpen:
+    begin
+      ReadSchemaArray(ASchema, ASchema.Items);
+    end;
+  else
+    InvalidToken(aToken);
+  end;
+end;
+
+
+procedure TJsonSchemaReader.ReadProperties(ASchema: TJsonSchema);
+var
+  propName: String;
+  schemaItem: TJsonSchema;
+  aToken: TJSONToken;
+begin
+    aToken:=GetToken;
+  while Not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    case aToken of
+      tkIdentifier,
+      tkString:
+      begin
+        CheckNextToken(tkColon);
+        propName := GetTokenString;
+        schemaItem := ASchema.CreateChildSchema;
+        schemaItem.Name := propName;
+        ASchema.Properties.Add(schemaItem);
+        ReadSchema(schemaItem);
+      end;
+      tkComma : ;
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+
+
+procedure TJsonSchemaReader.ReadSchema(ASchema: TJsonSchema);
+
+var
+  aToken : TJSONToken;
+
+begin
+  aToken:=GetToken;
+  Case aToken of
+    tkTrue,
+    tkFalse,
+    tkCurlyBraceOpen:
+      begin
+      aSchema.MatchType:=GetMatchType(aToken);
+      if aToken=tkCurlyBraceOpen then
+        ReadSchemaObject(aSchema);
+      end
+  else
+    InvalidToken(aToken);
+  end;
+end;
+
+procedure TJsonSchemaReader.ReadDependentRequired(aSchema: TJsonSchema; aList: TSchemaDependentRequiredList);
+
+var
+  aName : string;
+  Item : TSchemaDependentRequired;
+  aToken : TJSONToken;
+
+begin
+  CheckNextToken(tkCurlyBraceOpen);
+  aToken:=GetToken;
+  While Not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    case aToken of
+    tkIdentifier,
+    tkString:
+      begin
+      aName:=GetTokenString;
+      CheckNextToken(tkColon);
+      item:=aList.AddDependent(aName);
+      ReadStringArray(Item.Required);
+      end;
+    tkComma: ;
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+
+procedure TJsonSchemaReader.ReadVocabulary(aSchema: TJsonSchema);
+
+var
+  aName : string;
+  aToken : TJSONToken;
+
+begin
+  CheckNextToken(tkCurlyBraceOpen);
+  aToken:=GetToken;
+  While Not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    case aToken of
+    tkIdentifier,
+    tkString:
+      begin
+      aName:=GetTokenString;
+      CheckNextToken(tkColon);
+      aSchema.Vocabulary.AddVocabulary(aName).Enabled:=ReadBoolean;
+      end;
+    tkComma: ;
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+
+procedure TJsonSchemaReader.ReadSchemaObject(ASchema: TJsonSchema);
+
+var
+  propName: String;
+  aToken: TJSONToken;
+  keyword : TJSONSchemaKeyword;
+  Info : TKeywordInfo;
+  aValue : TJSONData;
+
+begin
+  aToken:=GetToken;
+  while not (aToken in [tkEOF,tkCurlyBraceClose]) do
+    begin
+    case aToken of
+    tkString,
+    tkIdentifier:
+      begin
+        propName := GetTokenString;
+        CheckNextToken(tkColon);
+        keyWord:=TJSONSchemaKeyword.FromString(PropName);
+        case KeyWord of
+          jskDefs: ReadNamedSchemas(ASchema,aSchema.Defs);
+          jskProperties: ReadProperties(ASchema);
+          jskDependentSchemas: ReadNamedSchemas(ASchema,aSchema.DependentSchemas);
+          jskType: ReadTypes(ASchema);
+          jskDescription: ASchema.MetaData.Description := ReadString;
+          jskTitle: ASchema.MetaData.Title := ReadString;
+          jskDefault: aSchema.Metadata.DefaultValue:=ReadJSONData;
+          jskSchema: ASchema.Schema := ReadString;
+          jskConst : ASchema.Validations.constValue:=ReadJSONData;
+          jskIdDraft4,
+          jskId: ASchema.Id := ReadString;
+          jskAnchor: ASchema.Anchor:= ReadString;
+          jskDynamicAnchor: ASchema.DynamicAnchor:= ReadString;
+          jskComment: ASchema.Comment:=ReadString;
+          jskMinimum: ASchema.Validations.Minimum := ReadNumber;
+          jskMaximum: ASchema.Validations.Maximum := ReadNumber;
+          jskMaxItems: ASchema.Validations.MaxItems := ReadPositiveInteger;
+          jskMinItems: ASchema.Validations.MinItems := ReadPositiveInteger;
+          jskMaxLength: ASchema.Validations.MaxLength := ReadPositiveInteger;
+          jskMinLength: ASchema.Validations.MinLength := ReadPositiveInteger;
+          jskMaxProperties: ASchema.Validations.MaxProperties := ReadPositiveInteger;
+          jskMinProperties: ASchema.Validations.MinProperties := ReadPositiveInteger;
+          jskMaxContains : aSchema.Validations.MaxContains:=ReadPositiveInteger;
+          jskMinContains : aSchema.Validations.MaxContains:=ReadPositiveInteger;
+          jskUniqueItems: ASchema.Validations.UniqueItems := ReadBoolean;
+          jskExclusiveMaximum: ASchema.Validations.ExclusiveMaximum := ReadNumber;
+          jskExclusiveMinimum: ASchema.Validations.ExclusiveMinimum := ReadNumber;
+          jskMultipleOf : ASchema.Validations.MultipleOf := ReadNumber;
+          jskEnum: ReadArray(ASchema.Validations.Enum,True);
+          jskItems: ReadItems(ASchema);
+          jskPrefixItems: ReadSchemaArray(aSchema,aSchema.PrefixItems);
+          // For backwards compatibility
+          jskAdditionalItems: ReadItems(aSchema);
+//          jskAdditionalItems: ReadSchemaValue(ASchema, ASchema.AdditionalItems, [tkBoolean, tkCurlyBraceOpen]);
+          jskAdditionalProperties: ReadSchema(ASchema.AdditionalProperties);
+          jskPattern: ASchema.Validations.Pattern := ReadString;
+          jskPatternProperties: ReadNamedSchemas(aSchema,ASchema.PatternProperties);
+          jskRequired: ReadStringArray(ASchema.Validations.Required);
+          jskFormat: ASchema.Validations.Format := ReadString;
+          jskRef: ASchema.Ref := ReadString;
+          jskDynamicRef: ASchema.DynamicRef := ReadString;
+          jskAllOf: ReadSchemaArray(ASchema, ASchema.AllOf);
+          jskAnyOf: ReadSchemaArray(ASchema, ASchema.AnyOf);
+          jskOneOf: ReadSchemaArray(ASchema, ASchema.OneOf);
+          jskIf: ReadSchema(ASchema.IfSchema);
+          jskThen: ReadSchema(ASchema.ThenSchema);
+          jskElse: ReadSchema(ASchema.ElseSchema);
+          jskNot: ReadSchema(ASchema.NotSchema);
+          jskContains : ReadSchema(ASchema.Contains);
+          jskPropertyNames : ReadSchema(aSchema.PropertyNames);
+          jskDependentRequired: ReadDependentRequired(aSchema,aSchema.Validations.DependentRequired);
+          jskUnevaluatedItems : ReadSchema(aSchema.UnevaluatedItems);
+          jskUnevaluatedProperties : ReadSchema(aSchema.UnevaluatedProperties);
+          jskDefinitions : ReadNamedSchemas(ASchema,aSchema.Defs);
+          jskContentEncoding : ASchema.Validations.ContentEncoding := ReadString;
+          jskContentMediaType  : ASchema.Validations.ContentMediaType := ReadString;
+          jskContentSchema : ReadSchema(ASchema.Validations.ContentSchema);
+          jskExamples : ReadArray(aSchema.MetaData.Examples,True);
+          jskDeprecated : aSchema.Metadata.Deprecated:=ReadBoolean();
+          jskReadOnly : aSchema.Metadata.ReadOnly:=ReadBoolean();
+          jskWriteOnly : aSchema.Metadata.WriteOnly:=ReadBoolean();
+          jskVocabulary : ReadVocabulary(aSchema);
+          jskUnknown:
+            begin
+            Info.Keyword:=PropName;
+            Info.Schema:=aSchema;
+            Info.Scanner:=Scanner;
+            If not HandleUnknownKeyword(info) then
+              begin
+              aValue:=ReadJSONData;
+              if (roSkipUnknownProperties in Options) then
+                aValue.Free
+              else
+                aSchema.UnknownKeywordData.Add(PropName,aValue);
+              end;
+            end;
+        end;
+      end;
+    tkComma:
+      ;
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkCurlyBraceClose,aToken);
+end;
+
+procedure TJsonSchemaReader.ReadSchemaArray(ASchema: TJsonSchema; ASchemaList: TJsonSchemaList);
+
+var
+  schemaItem: TJsonSchema;
+  aToken: TJSONToken;
+
+begin
+  CheckNextToken(tkSquaredBraceOpen);
+  aToken:=GetToken;
+  while not (aToken in [tkEOF,tkSquaredBraceClose]) do
+    begin
+    case aToken of
+      tkComma:
+        ;
+      tkTrue,
+      tkFalse,
+      tkCurlyBraceOpen:
+        begin
+        schemaItem := ASchema.CreateChildSchema;
+        ASchemaList.Add(schemaItem);
+        schemaItem.MatchType:=GetMatchType(aToken);
+        if aToken=tkCurlyBraceOpen then
+          ReadSchemaObject(schemaItem);
+        end;
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+  CheckToken(tkSquaredBraceClose,aToken);
+end;
+
+function TJsonSchemaReader.ReadString(): String;
+var
+  aToken: TJSONToken;
+begin
+  aToken:=GetToken;
+  CheckToken(tkString,aToken);
+  Result:=GetTokenString;
+end;
+
+function TJsonSchemaReader.HandleUnknownKeyword(aInfo: TKeyWordInfo): Boolean;
+begin
+  Result:=False;
+  if Assigned(OnUnknownKeyword) then
+    OnUnknownKeyword(Self,aInfo,Result);
+end;
+
+procedure TJsonSchemaReader.ReadStringArray(AStrings: TStrings);
+var
+  aToken: TJSONToken;
+begin
+  CheckNextToken(tkSquaredBraceOpen);
+  aToken:=GetToken;
+  while Not (aToken in [tkEOF,tkSquaredBraceClose]) do
+    begin
+    case aToken of
+      tkComma:
+        ;
+      tkString:
+        AStrings.Add(GetTokenString);
+    else
+      InvalidToken(aToken);
+    end;
+    aToken:=GetToken;
+    end;
+end;
+
+procedure TJsonSchemaReader.ReadTypes(AJsonSchema: TJsonSchema);
+var
+  aTypes : TSchemaSimpleTypes;
+  aToken: TJSONToken;
+begin
+  aTypes:=[];
+  aToken:=CheckNextToken([tkString,tkSquaredBraceOpen]);
+  if aToken=tkString then
+    Include(aTypes,TSchemaSimpleType.FromString(GetTokenString))
+  else
+    begin
+    aToken:=GetToken;
+    while Not (aToken in [tkEOF,tkSquaredBraceClose]) do
+      begin
+      Case aToken of
+      tkComma:
+        ;
+      tkString:
+        Include(aTypes,TSchemaSimpleType.FromString(GetTokenString));
+      else
+        InvalidToken(aToken);
+      end;
+      aToken:=GetToken;
+      end;
+    CheckToken(tkSquaredBraceClose,aToken);
+    end;
+  AJSONSchema.Validations.Types:=aTypes;
+end;
+
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.schema.pp

@@ -0,0 +1,1583 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema class
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit fpjson.schema.schema;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, System.Contnrs, FpJson.Data, FpJson.Schema.Types;
+  {$ELSE}
+  Classes, SysUtils, contnrs, fpjson, fpjson.schema.types;
+  {$ENDIF}
+
+Type
+  TJSONSchema = class;
+  TJSONSchemaList = class;
+  TJSONSchemaValidations = class;
+  TJSONSchemaVocabulary = class;
+  TJSONSchemaVocabularyList= class;
+
+  { TJSONSchemaMetadata }
+
+  TJSONSchemaMetadata = Class(TPersistent)
+  Private
+    FSchema: TJSONSchema;
+    FTitle: String;
+    FDescription: String;
+    FDefaultValue: TJSONData;
+    FDeprecated : Boolean;
+    FExamples : TJSONArray;
+    FReadOnly : Boolean;
+    FWriteOnly : Boolean;
+    FKeywordData : TJSONSchemaKeywords;
+    procedure DoAddExample(Sender: TObject);
+    procedure SetDefaultValue(AValue: TJSONData);
+    procedure SetDeprecated(AValue: Boolean);
+    procedure SetDescription(AValue: String);
+    procedure SetExamples(AValue: TJSONArray);
+    procedure SetReadOnly(AValue: Boolean);
+    procedure SetTitle(AValue: String);
+    procedure SetWriteOnly(AValue: Boolean);
+  Protected
+    procedure SetConstrained; inline;
+    Procedure SetKeywordData(aKeyword: TJSONSchemaKeyword);
+    Procedure UnSetKeywordData(aKeyword: TJSONSchemaKeyword);
+    function GetOwner: TPersistent; override;
+    // List of possible keywords for this class
+    function Keywords : TJSONSchemaKeywords; virtual;
+  Public
+    procedure Assign(Source: TPersistent); override;
+    constructor Create(aSchema : TJSONSchema); virtual;
+    destructor Destroy; override;
+    // List of keywords for which data is available
+    function KeywordsWithData : TJSONSchemaKeywords; virtual;
+    // Is this keyword set ?
+    function HasKeywordData(aKeyword : TJSONSchemaKeyword) : boolean; virtual;
+    property Schema : TJSONSchema Read FSchema;
+  Published
+    Property Title: String Read FTitle write SetTitle;
+    Property Description: String Read FDescription write SetDescription;
+    Property DefaultValue: TJSONData Read FDefaultValue Write SetDefaultValue;
+    Property Deprecated: Boolean Read FDeprecated write SetDeprecated;
+    Property Examples: TJSONArray Read FExamples Write SetExamples;
+    Property ReadOnly: Boolean Read FReadOnly write SetReadOnly;
+    Property WriteOnly: Boolean Read FWriteOnly write SetWriteOnly;
+  end;
+
+  { TSchemaDependentRequired }
+  TSchemaDependentRequired = Class(TCollectionItem)
+  private
+    FRequired: TStrings;
+    FURL: String;
+    procedure SetRequired(AValue: TStrings);
+  Public
+    Constructor Create(ACollection: TCollection); override;
+    Destructor Destroy; override;
+    Procedure Assign(Source: TPersistent); override;
+  Published
+    Property Name : String Read FURL Write FURL;
+    Property Required : TStrings Read FRequired Write SetRequired;
+  end;
+
+  { TSchemaDependentRequiredList }
+
+  TSchemaDependentRequiredList = Class(TOwnedCollection)
+  private
+    function GetDependent(aIndex : integer): TSchemaDependentRequired;
+    function GetValidations: TJSONSchemaValidations;
+    procedure SetDependent(aIndex : integer; AValue: TSchemaDependentRequired);
+  Public
+    Property SchemaValidations : TJSONSchemaValidations Read GetValidations;
+    function AddDependent(const aName : String) : TSchemaDependentRequired;
+    Property Dependent[aIndex : integer] : TSchemaDependentRequired Read GetDependent Write SetDependent; default;
+  end;
+
+  { TJSONSchemaValidations }
+
+  TJSONSchemaValidations = Class(TPersistent)
+  private
+    FConstValue: TJSONData;
+    FcontentEncoding: String;
+    FcontentMediaType: String;
+    FcontentSchema: TJSONSchema;
+    FDependentRequired: TSchemaDependentRequiredList;
+    FEnum: TJSONArray;
+    FExclusiveMaximum: Double;
+    FExclusiveMinimum: Double;
+    FFormat: String;
+    FMaxContains: Integer;
+    FMaximum: Double;
+    FMaxItems: Cardinal;
+    FMaxLength: Cardinal;
+    FMaxProperties: Cardinal;
+    FMinContains: Integer;
+    FMinimum: Double;
+    FMinItems: Cardinal;
+    FMinLength: Cardinal;
+    FMinProperties: Cardinal;
+    FMultipleOf: Double;
+    FPattern: String;
+    FRequired: TStrings;
+    FSchema: TJSONSchema;
+    FTypes: TSchemaSimpleTypes;
+    FUniqueItems: Boolean;
+    FKeywordData : TJSONSchemaKeywords;
+    procedure DoAdd(Sender: TObject);
+    procedure DoRequiredChange(Sender: TObject);
+    function GetContentSchema: TJSONSchema;
+    function GetFormatValidator: TStringFormatValidator;
+    procedure SetConstValue(AValue: TJSONData);
+    procedure SetcontentEncoding(AValue: String);
+    procedure SetcontentMediaType(AValue: String);
+    procedure SetEnum(AValue: TJSONArray);
+    procedure SetExclusiveMaximum(AValue: Double);
+    procedure SetExclusiveMinimum(AValue: Double);
+    procedure SetFormat(AValue: String);
+    procedure SetFormatValidator(AValue: TStringFormatValidator);
+    procedure SetMaxContains(AValue: Integer);
+    procedure SetMaximum(AValue: Double);
+    procedure SetMaxItems(AValue: Cardinal);
+    procedure SetMaxLength(AValue: Cardinal);
+    procedure SetMaxProperties(AValue: Cardinal);
+    procedure SetMinContains(AValue: Integer);
+    procedure SetMinimum(AValue: Double);
+    procedure SetMinItems(AValue: Cardinal);
+    procedure SetMinLength(AValue: Cardinal);
+    procedure SetMinProperties(AValue: Cardinal);
+    procedure SetMultipleOf(AValue: Double);
+    procedure SetPattern(AValue: String);
+    procedure SetRequired(AValue: TStrings);
+    procedure SetTypes(AValue: TSchemaSimpleTypes);
+    procedure SetUniqueItems(AValue: Boolean);
+  Protected
+    procedure SetConstrained;inline;
+    procedure SetKeywordData(aKeyword: TJSONSchemaKeyword); virtual;
+    procedure UnSetKeywordData(aKeyword: TJSONSchemaKeyword); virtual;
+    Function CreateDependentRequired : TSchemaDependentRequiredList; virtual;
+    function GetOwner: TPersistent; override;
+    function Keywords : TJSONSchemaKeywords; virtual;
+  Public
+    procedure Assign(Source: TPersistent); override;
+    Constructor Create(aSchema : TJSONSchema);
+    Destructor Destroy; override;
+    // List of keywords for which data is available
+    function KeywordsWithData : TJSONSchemaKeywords; virtual;
+    // Is the keyword set
+    function HasKeywordData(aKeyword : TJSONSchemaKeyword) : Boolean; virtual;
+    // Owner schema
+    property Schema : TJSONSchema Read FSchema;
+    // type keyword
+    property Types: TSchemaSimpleTypes read FTypes Write SetTypes;
+    property constValue : TJSONData Read FConstValue Write SetConstValue;
+    property Enum: TJSONArray read FEnum Write SetEnum;
+    property ExclusiveMaximum: Double read FExclusiveMaximum write SetExclusiveMaximum;
+    property ExclusiveMinimum: Double read FExclusiveMinimum write SetExclusiveMinimum;
+    property Maximum: Double read FMaximum write SetMaximum;
+    property Minimum: Double read FMinimum write SetMinimum;
+    property MaxItems: Cardinal read FMaxItems write SetMaxItems;
+    property MinItems: Cardinal read FMinItems write SetMinItems;
+    property Required: TStrings read FRequired write SetRequired;
+    property MaxLength: Cardinal read FMaxLength write SetMaxLength;
+    property MinLength: Cardinal read FMinLength write SetMinLength;
+    property MaxProperties: Cardinal read FMaxProperties write SetMaxProperties;
+    property MinProperties: Cardinal read FMinProperties write SetMinProperties;
+    property Pattern: String read FPattern write SetPattern;
+    property UniqueItems: Boolean read FUniqueItems write SetUniqueItems;
+    property MinContains : Integer Read FMinContains Write SetMinContains;
+    property MaxContains : Integer Read FMaxContains Write SetMaxContains;
+    property MultipleOf : Double Read FMultipleOf Write SetMultipleOf;
+    Property DependentRequired : TSchemaDependentRequiredList Read FDependentRequired;
+    // Probably better under annotations...
+    property Format: String read FFormat write SetFormat;
+    property FormatValidator: TStringFormatValidator read GetFormatValidator write SetFormatValidator;
+    property contentMediaType : String read FcontentMediaType write SetcontentMediaType;
+    property contentEncoding : String read FcontentEncoding write SetcontentEncoding;
+    property contentSchema : TJSONSchema read GetContentSchema;
+  end;
+
+  { TJSONSchemaVocabulary }
+
+  TJSONSchemaVocabulary = Class(TCollectionItem)
+  private
+    FEnabled: Boolean;
+    FURL: String;
+  Public
+    procedure Assign(Source: TPersistent); override;
+    function ToString : String; override;
+  Published
+    Property URL : String Read FURL Write FUrl;
+    Property Enabled : Boolean Read FEnabled Write FEnabled;
+  end;
+
+  { TJSONSChemaVocabularyList }
+
+  TJSONSchemaVocabularyList = Class(TOwnedCollection)
+  private
+    function GetSchema: TJSONSchema;
+    function GetVocabulary(aIndex : integer): TJSONSchemaVocabulary;
+    procedure SetVocabulary(aIndex : integer; AValue: TJSONSchemaVocabulary);
+  Public
+    function IndexOfVocabulary(const aURL : String) : Integer;
+    function FindVocabulary(aURL : String) : TJSONSchemaVocabulary;
+    Function AddVocabulary(const aURL : String) : TJSONSchemaVocabulary;
+    Property Schema : TJSONSchema Read GetSchema;
+    Property Vocabularies[aIndex : integer] : TJSONSchemaVocabulary Read GetVocabulary Write SetVocabulary; default;
+    function ToString : String; overload;
+  end;
+
+  { TJsonSchema }
+
+  TJsonSchema = class(TPersistent)
+  private
+    FAnchor: String;
+    FComment: String;
+    FMatchType: TSchemaMatchType;
+    FParent: TJsonSchema;
+    FSubSchemas : Array[TJSONSubschema] of TJSONSchema;
+    FPatternProperties : TJsonSchemaList;
+    FPrefixItems: TJsonSchemaList;
+    FProperties: TJsonSchemaList;
+    FItems: TJsonSchemaList;
+    FAllOf: TJsonSchemaList;
+    FAnyOf: TJsonSchemaList;
+    FOneOf: TJsonSchemaList;
+    FDependentSchemas: TJSONSchemaList;
+    FDefs: TJSONSchemaList;
+    FDynamicAnchor: String;
+    FDynamicRef: String;
+    FMetaData: TJSONSchemaMetadata;
+    FName: String;
+    FId: String;
+    FSchema: String;
+    FRef: String;
+    FAdditionalProperties: TJSONSchema;
+
+    FValidations: TJsonSchemaValidations;
+    FVocabulary: TJSONSchemaVocabularyList;
+    FUnknownKeywordData : TJSONObject;
+    FChildren : TFPList;
+    FKeywordData : TJSONSchemaKeywords;
+    function GetAdditionalProperties: TJSONSchema;
+    function GetChildSchema(aIndex : Integer): TJSONSchema;
+    function GetChildSchemaCount: Integer;
+    function GetDependentSchemas: TJSONSchemaList;
+    function GetNamedList(const aName: string): TJSONSchemaList;
+    function GetPatternProperties: TJsonSchemaList;
+    function GetUnknownKeywordData: TJSONObject;
+    procedure SetMetadata(AValue: TJSONSchemaMetadata);
+    procedure SetString(AIndex: Integer; AValue: String);
+    procedure SetValidations(AValue: TJsonSchemaValidations);
+    procedure SetVocabulary(AValue: TJSONSchemaVocabularyList);
+  protected
+    procedure SetKeyWordData(akeyWord : TJSONSchemaKeyword);
+    procedure UnsetKeyWordData(akeyWord : TJSONSchemaKeyword);
+    function GetSubSchema(aIndex : Integer) : TJSONSchema;
+    function CreateVocabulary : TJSONSchemaVocabularyList; virtual;
+    function CreateMetadata: TJSONSchemaMetadata; virtual;
+    function CreateValidations: TJsonSchemaValidations; virtual;
+    procedure CheckConstrained;
+    function GetPath: String; virtual;
+  public
+    constructor Create(AParent: TJsonSchema);
+    constructor Create;
+    destructor Destroy; override;
+    // Check if there is data for a given keyword.
+    Function HasKeywordData(aKeyword : TJSONSchemaKeyword) : Boolean;
+    // All set keywords
+    Function KeywordsWithData : TJSONSchemaKeywords;
+    // Create child schema with given name
+    function CreateChildSchema(aName : string): TJsonSchema; overload;
+    // Create child schema with name equal to keyword.
+    function CreateChildSchema(aKeyword : TJSONSchemaKeyword): TJsonSchema; overload;
+    // Create unnamed child schema
+    function CreateChildSchema: TJsonSchema; virtual;
+    // Toplevel schema (follows parent)
+    Function RootSchema: TJSONSchema;
+    // Find schema using schema-local $Ref URI
+    function Find(const aPath : String) : TJSONSchema;
+    // Find index of direct child schema with given name
+    function IndexOfChild(const aName: String): Integer;
+    // Find direct child schema with given name
+    function FindChild(const aName: String): TJSONSchema;
+    // Enumerate child schemas (named and unnamed)
+    property ChildSchemas[aIndex : Integer] : TJSONSchema Read GetChildSchema;
+    // Number of child schemas (named and unnamed)
+    property ChildSchemaCount : Integer Read GetChildSchemaCount;
+    // Parent schema
+    Property Parent : TJSONSchema Read FParent;
+    // Path till root schema.
+    Property Path : String Read GetPath;
+    // Name of current schema in parent.
+    property Name: String read FName write FName;
+
+     { Core vocabulary }
+    // Was the schema read as True/False/Object
+    property MatchType : TSchemaMatchType Read FMatchType Write FMatchType;
+    // Identifier of used JSON schema
+    property Schema: String Index Ord(jskSchema) read FSchema write SetString;
+    // ID of this schema
+    property Id: String Index Ord(jskID) read FId write SetString;
+    // $ref
+    property Ref: String Index Ord(jskRef) read FRef write SetString;
+    // $comment
+    property Comment: String Index Ord(jskComment) read FComment write SetString;
+    // $anchor
+    property Anchor: String Index Ord(jskAnchor) read FAnchor write SetString;
+    // $dynamicAnchor
+    property DynamicAnchor: String Index Ord(jskDynamicAnchor) read FDynamicAnchor write SetString;
+    // $dynamicRef
+    property DynamicRef: String Index Ord(jskDynamicRef) read FDynamicRef write SetString;
+    // $vocabulary
+    property Vocabulary : TJSONSchemaVocabularyList Read FVocabulary Write SetVocabulary;
+    // $defs
+    property Defs: TJSONSchemaList read FDefs;
+
+    // Metadata vocabulary keywords
+    Property MetaData : TJSONSchemaMetadata Read FMetaData Write SetMetadata;
+    // Validations vocabulary keywords
+    Property Validations : TJsonSchemaValidations Read FValidations Write SetValidations;
+    // Applicator vocabulary keywords
+    // allOf keyword
+    property AllOf: TJsonSchemaList read FAllOf;
+    // anyOf keyword
+    property AnyOf: TJsonSchemaList read FAnyOf;
+    // OneOf keyword
+    property OneOf: TJsonSchemaList read FOneOf;
+    // Not keyword
+    property NotSchema: TJsonSchema index Ord(ssNot) read GetSubSchema;
+    // if keyword
+    property IfSchema: TJsonSchema index Ord(ssIf) read GetSubSchema;
+    // Then keyword
+    property ThenSchema: TJsonSchema index Ord(ssThen) read GetSubSchema;
+    // Else keyword
+    property ElseSchema: TJsonSchema index Ord(ssElse) read GetSubSchema;
+    // properties keyword
+    property Properties: TJsonSchemaList read FProperties;
+    // items keyword.
+    // Declared in draft 2020-12 as schema, but we keep it a List, so we can handle earlier drafts.
+    property Items: TJsonSchemaList read FItems;
+    // prefixItems keyword
+    property PrefixItems: TJsonSchemaList read FPrefixItems;
+    // patternProperties keyword
+    property PatternProperties: TJsonSchemaList Read GetPatternProperties;
+    // propertyNames keyword
+    property PropertyNames: TJsonSchema index Ord(ssPropertyNames) read GetSubSchema;
+    // additionalProperties keyword
+    property AdditionalProperties: TJSONSchema index Ord(ssAdditionalProperties) read GetSubschema;
+    // dependentSchemas keyw
+    property DependentSchemas: TJSONSchemaList read GetDependentSchemas;
+    // contains keyword
+    property Contains: TJsonSchema Index Ord(ssContains) read GetSubSchema;
+    // unevaluatedItems keyword
+    property UnevaluatedItems : TJSONSchema Index Ord(ssUnevaluatedItems) read GetSubSchema;
+    // unevaluatedProperties keyword
+    property UnevaluatedProperties : TJSONSchema Index Ord(ssUnevaluatedProperties) read GetSubSchema;
+    // Not in any vocabulary:
+    // Can be filled by reader with unknown properties.
+    property UnknownKeywordData : TJSONObject Read GetUnknownKeywordData;
+  end;
+  TJsonSchemaClass = Class of TJsonSchema;
+
+  { TJSONSchemaList }
+
+  TJSONSchemaList = Class(TFPObjectList)
+  private
+    FKeyword: TJSONSchemaKeyword;
+    FSchemaOwner: TJSONSchema;
+    function GetSchema(aIndex : integer): TJSONSchema;
+    procedure SetSchema(aIndex : integer; AValue: TJSONSchema);
+  Public
+    Constructor Create(aOwner : TJSONSchema; aKeyWord : TJSONSchemaKeyword); overload;
+    Function FindIDOrNames(aPath : String) : TJSONSchema;
+    Function Add(const aName : string = ''): TJSONSchema; overload;
+    Function Add(Schema : TJSONSchema): Integer; overload;
+    property SchemaOwner : TJSONSchema Read FSchemaOwner;
+    property Keyword : TJSONSchemaKeyword Read FKeyword;
+    Property Schemas[aIndex : integer] : TJSONSchema Read GetSchema Write SetSchema; default;
+  end;
+
+implementation
+
+uses FpJson.Schema.Consts;
+
+{ TSchemaValue }
+
+(*
+
+procedure TSchemaValue.SetSchema(AValue: TJSONSchema);
+begin
+  if FSchema=AValue then Exit;
+  FreeAndNil(Fschema);
+  FSchema:=AValue;
+  if Assigned(FSchema) then
+    begin
+    FreeAndNil(FValue);
+    FreeAndNil(FList);
+    end;
+  DoOnChanged;
+end;
+
+procedure TSchemaValue.SetList(AValue: TSchemaValueList);
+begin
+  if FList=AValue then Exit;
+  FreeAndNil(FList);
+  FList:=AValue;
+  if Assigned(FList) then
+    begin
+    FreeAndNil(FSchema);
+    FreeAndNil(FValue);
+    end;
+  DoOnChanged;
+end;
+
+procedure TSchemaValue.SetValue(AValue: TJSONData);
+begin
+  if FValue=AValue then Exit;
+  if aValue.JSONType in StructuredJSONTypes then
+    Raise EJSONSchema.Create(SErrOnlySimpleValues);
+  FreeAndNil(FValue);
+  FValue:=AValue;
+  if Assigned(FValue) then
+    begin
+    FreeAndNil(FSchema);
+    FreeAndNil(FList);
+    end;
+  DoOnChanged;
+end;
+
+procedure TSchemaValue.DoOnChanged;
+begin
+  If Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
+constructor TSchemaValue.Create;
+begin
+  // Assign nothing
+end;
+
+constructor TSchemaValue.Create(aValue: TJSONData);
+begin
+  FValue:=aValue;
+end;
+
+constructor TSchemaValue.Create(aSchema: TJSONSchema);
+begin
+  FSchema:=aSchema;
+end;
+
+constructor TSchemaValue.Create(aList: TSchemaValueList);
+begin
+  FList:=aList;
+end;
+
+destructor TSchemaValue.Destroy;
+begin
+  FreeAndNil(FValue);
+  FreeAndNil(FList);
+  FreeAndNil(FSchema);
+  inherited Destroy;
+end;
+
+procedure TSchemaValue.Clear;
+begin
+  SimpleValue:=Nil;
+  Schema:=Nil;
+  List:=Nil;
+end;
+
+function TSchemaValue.ValueType: TSchemaValueType;
+begin
+  Result:=svtEmpty;
+  if (FValue<>Nil) then
+    Result:=svtSimple
+  else if (FSchema<>Nil) then
+    Result:=svtSchema
+  else if (FList<>Nil) then
+    Result:=svtList;
+end;
+
+function TSchemaValue.IsEmpty: Boolean;
+begin
+  Result:=(FValue=Nil) and (FSchema=Nil) and (FList=Nil);
+end;
+
+function TSchemaValue.IsSimpleValue: Boolean;
+begin
+  Result:=(FValue<>Nil);
+end;
+
+function TSchemaValue.IsSchema: Boolean;
+begin
+  Result:=(FSchema<>Nil);
+end;
+
+function TSchemaValue.IsList: Boolean;
+begin
+  Result:=(FList<>Nil);
+end;
+
+{ TSchemaValueList }
+
+function TSchemaValueList.GetValue(aIndex : integer): TSchemaValue;
+begin
+  Result:=Items[aIndex] as TSchemaValue;
+end;
+
+procedure TSchemaValueList.SetValue(aIndex : integer; AValue: TSchemaValue);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+procedure TSchemaValueList.DoOnAdd;
+begin
+  If assigned(FOnAdd) then FOnAdd(Self);
+end;
+
+constructor TSchemaValueList.create(aKeyword: TJSONSchemaKeyword);
+begin
+  Inherited Create(True);
+  FKeyword:=aKeyword;
+end;
+
+function TSchemaValueList.Add(aSchema: TJSONSchema): TSchemaValue;
+begin
+  Result:=TSchemaValue.Create(aSchema);
+  Inherited Add(Result);
+  DoOnAdd;
+end;
+
+function TSchemaValueList.Add(aValue: TJSONData): TSchemaValue;
+begin
+  Result:=TSchemaValue.Create(aValue);
+  Inherited Add(Result);
+  DoOnAdd;
+end;
+*)
+{ TJSONSchemaMetadata }
+
+
+procedure TJSONSchemaMetadata.SetConstrained;
+
+begin
+  if Assigned(Schema) then
+    Schema.MatchType:=smConstrained;
+end;
+
+(*
+function TJSONSchemaMetadata.GetDefaultValue: TSchemaValue;
+begin
+  if FDefaultValue=Nil then
+    begin
+    FDefaultValue:=TSchemaValue.Create(TJSONData(Nil));
+    SetConstrained;
+    end;
+  Result:=FDefaultValue;
+end;
+*)
+procedure TJSONSchemaMetadata.DoAddExample(Sender: TObject);
+begin
+  SetConstrained;
+end;
+
+procedure TJSONSchemaMetadata.SetDefaultValue(AValue: TJSONData);
+begin
+  if FDefaultValue=AValue then Exit;
+  FreeAndNil(FDefaultValue);
+  FDefaultValue:=AValue;
+  if Assigned(FDefaultValue) then
+    SetKeywordData(jskDefault);
+end;
+
+(*
+procedure TJSONSchemaMetadata.DoValueChanged(Sender: TObject);
+begin
+  if not TSchemaValue(Sender).IsEmpty then
+    SetConstrained;
+end;
+*)
+
+procedure TJSONSchemaMetadata.SetDeprecated(AValue: Boolean);
+begin
+  SetKeywordData(jskDeprecated);
+  if FDeprecated=AValue then Exit;
+  FDeprecated:=AValue;
+end;
+
+procedure TJSONSchemaMetadata.SetDescription(AValue: String);
+begin
+  if FDescription=AValue then Exit;
+  FDescription:=AValue;
+  SetKeywordData(jskDescription);
+end;
+
+procedure TJSONSchemaMetadata.SetExamples(AValue: TJSONArray);
+begin
+  if FExamples=AValue then Exit;
+  FreeAndNil(FExamples);
+  FExamples:=AValue;
+  if FExamples=Nil then
+    FExamples:=TJSONArray.Create;
+  SetKeywordData(jskExamples);
+end;
+
+procedure TJSONSchemaMetadata.SetReadOnly(AValue: Boolean);
+begin
+  SetKeywordData(jskReadOnly);
+  if FReadOnly=AValue then Exit;
+  FReadOnly:=AValue;
+end;
+
+procedure TJSONSchemaMetadata.SetTitle(AValue: String);
+begin
+  if FTitle=AValue then Exit;
+  FTitle:=AValue;
+  SetKeywordData(jskTitle);
+end;
+
+procedure TJSONSchemaMetadata.SetWriteOnly(AValue: Boolean);
+begin
+  SetKeywordData(jskWriteOnly);
+  if FWriteOnly=AValue then Exit;
+  FWriteOnly:=AValue;
+end;
+
+procedure TJSONSchemaMetadata.SetKeywordData(aKeyword: TJSONSchemaKeyword);
+begin
+  Include(FKeywordData,aKeyword);
+  SetConstrained;
+end;
+
+procedure TJSONSchemaMetadata.UnSetKeywordData(aKeyword: TJSONSchemaKeyword);
+begin
+  Exclude(FKeywordData,aKeyword);
+  if Assigned(Schema) then
+    Schema.CheckConstrained;
+end;
+
+procedure TJSONSchemaMetadata.Assign(Source: TPersistent);
+var
+  aSource: TJSONSchemaMetadata absolute source;
+begin
+  if Source is TJSONSchemaMetadata then
+    begin
+    FKeywordData:=[];
+    WriteOnly:=aSource.FWriteOnly;
+    Title:=aSource.FTitle;
+    ReadOnly:=aSource.FReadOnly;
+    Description:=aSource.FDescription;
+    Deprecated:=aSource.FDeprecated;
+    DefaultValue:=aSource.DefaultValue.Clone;
+    Examples:=aSource.Examples.Clone as TJSONArray;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+constructor TJSONSchemaMetadata.Create(aSchema: TJSONSchema);
+begin
+  FSchema:=aSchema;
+  Fexamples:=TJSONArray.Create;
+end;
+
+destructor TJSONSchemaMetadata.Destroy;
+begin
+  inherited Destroy;
+  FreeAndNil(FDefaultValue);
+  FreeAndNil(FExamples);
+end;
+
+function TJSONSchemaMetadata.GetOwner: TPersistent;
+begin
+  Result:=FSchema;
+end;
+
+function TJSONSchemaMetadata.Keywords: TJSONSchemaKeywords;
+begin
+  Result:=MetadataKeywords;
+end;
+
+function TJSONSchemaMetadata.KeywordsWithData: TJSONSchemaKeywords;
+
+var
+  K : TJSONSchemaKeyword;
+
+begin
+  Result:=[];
+  For K in Keywords do
+    if HasKeywordData(K) then
+      Include(Result,K);
+end;
+
+function TJSONSchemaMetadata.HasKeywordData(aKeyword: TJSONSchemaKeyword): boolean;
+begin
+  Case aKeyword of
+    jskDefault: Result:=Assigned(FDefaultValue);
+    jskExamples : Result:=(FExamples.Count>0);
+  else
+    Result:=aKeyword in FKeywordData;
+  end;
+end;
+
+
+{ TSchemaDependentRequired }
+
+procedure TSchemaDependentRequired.SetRequired(AValue: TStrings);
+begin
+  if FRequired=AValue then Exit;
+  FRequired.Assign(AValue);
+end;
+
+constructor TSchemaDependentRequired.Create(ACollection: TCollection);
+begin
+  inherited Create(ACollection);
+  FRequired:=TStringList.Create;
+end;
+
+destructor TSchemaDependentRequired.Destroy;
+begin
+  FreeAndNil(FRequired);
+  inherited Destroy;
+end;
+
+procedure TSchemaDependentRequired.Assign(Source: TPersistent);
+
+var
+  Src :TSchemaDependentRequired absolute Source;
+
+begin
+  if Source is TSchemaDependentRequired then
+    begin
+    Name:=Src.Name;
+    Required.Assign(Src.Required);
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TSchemaDependentRequiredList }
+
+function TSchemaDependentRequiredList.GetDependent(aIndex : integer): TSchemaDependentRequired;
+begin
+  Result:=Items[aIndex] as TSchemaDependentRequired;
+end;
+
+function TSchemaDependentRequiredList.GetValidations: TJSONSchemaValidations;
+begin
+  if owner is TJSONSchemaValidations then
+    Result:=TJSONSchemaValidations(Owner)
+  else
+    Result:=Nil;
+end;
+
+procedure TSchemaDependentRequiredList.SetDependent(aIndex : integer; AValue: TSchemaDependentRequired);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TSchemaDependentRequiredList.AddDependent(const aName: String): TSchemaDependentRequired;
+begin
+  Result:=Add as TSchemaDependentRequired;
+  Result.Name:=aName;
+  if Assigned(SchemaValidations) and Assigned(SchemaValidations.Schema) then
+    SchemaValidations.Schema.MatchType:=smConstrained;
+end;
+
+{ TJsonSchemaValidations }
+
+procedure TJSONSchemaValidations.SetConstValue(AValue: TJSONData);
+begin
+  if FConstValue=AValue then Exit;
+  FreeAndNil(FConstValue);
+  FConstValue:=AValue;
+  SetKeyWordData(jskConst);
+end;
+
+procedure TJSONSchemaValidations.SetcontentEncoding(AValue: String);
+begin
+  if FcontentEncoding=AValue then Exit;
+  FcontentEncoding:=AValue;
+  SetKeywordData(jskContentEncoding);
+end;
+
+procedure TJSONSchemaValidations.SetcontentMediaType(AValue: String);
+begin
+  if FcontentMediaType=AValue then Exit;
+  FcontentMediaType:=AValue;
+  SetKeywordData(jskContentMediaType);
+end;
+
+procedure TJSONSchemaValidations.SetEnum(AValue: TJSONArray);
+begin
+  if FEnum=AValue then Exit;
+  FreeAndNil(FEnum);
+  FEnum:=AValue;
+  if FEnum=Nil then
+    FEnum:=TJSONArray.Create;
+  SetKeywordData(jskEnum);
+end;
+
+procedure TJSONSchemaValidations.SetExclusiveMaximum(AValue: Double);
+begin
+  if FExclusiveMaximum=AValue then Exit;
+  FExclusiveMaximum:=AValue;
+  SetKeywordData(jskExclusiveMaximum);
+end;
+
+procedure TJSONSchemaValidations.SetExclusiveMinimum(AValue: Double);
+begin
+  if FExclusiveMinimum=AValue then Exit;
+  FExclusiveMinimum:=AValue;
+  SetKeywordData(jskExclusiveMinimum);
+end;
+
+procedure TJSONSchemaValidations.SetFormat(AValue: String);
+begin
+  if FFormat=AValue then Exit;
+  FFormat:=AValue;
+  SetKeywordData(jskFormat);
+end;
+
+procedure TJSONSchemaValidations.SetFormatValidator(AValue: TStringFormatValidator);
+begin
+  Format:=aValue.AsString;
+end;
+
+procedure TJSONSchemaValidations.SetMaxContains(AValue: Integer);
+begin
+  if FMaxContains=AValue then Exit;
+  FMaxContains:=AValue;
+  SetKeywordData(jskMaxContains);
+end;
+
+procedure TJSONSchemaValidations.SetMaximum(AValue: Double);
+begin
+  if FMaximum=AValue then Exit;
+  FMaximum:=AValue;
+  SetKeywordData(jskMaximum);
+end;
+
+procedure TJSONSchemaValidations.SetMaxItems(AValue: Cardinal);
+begin
+  if FMaxItems=AValue then Exit;
+  FMaxItems:=AValue;
+  SetKeywordData(jskMaxItems);
+end;
+
+procedure TJSONSchemaValidations.SetMaxLength(AValue: Cardinal);
+begin
+  if FMaxLength=AValue then Exit;
+  FMaxLength:=AValue;
+  SetKeywordData(jskMaxLength);
+end;
+
+procedure TJSONSchemaValidations.SetMaxProperties(AValue: Cardinal);
+begin
+  if FMaxProperties=AValue then Exit;
+  FMaxProperties:=AValue;
+  SetKeywordData(jskMaxProperties);
+end;
+
+procedure TJSONSchemaValidations.SetMinContains(AValue: Integer);
+begin
+  if FMinContains=AValue then Exit;
+  FMinContains:=AValue;
+  SetKeywordData(jskMinContains);
+end;
+
+procedure TJSONSchemaValidations.SetMinimum(AValue: Double);
+begin
+  if FMinimum=AValue then Exit;
+  FMinimum:=AValue;
+  SetKeywordData(jskMinimum);
+end;
+
+procedure TJSONSchemaValidations.SetMinItems(AValue: Cardinal);
+begin
+  if FMinItems=AValue then Exit;
+  FMinItems:=AValue;
+  SetKeywordData(jskMinItems);
+end;
+
+procedure TJSONSchemaValidations.SetMinLength(AValue: Cardinal);
+begin
+  if FMinLength=AValue then Exit;
+  FMinLength:=AValue;
+  SetKeywordData(jskMinLength);
+end;
+
+procedure TJSONSchemaValidations.SetMinProperties(AValue: Cardinal);
+begin
+  if FMinProperties=AValue then Exit;
+  FMinProperties:=AValue;
+  SetKeywordData(jskMinProperties);
+end;
+
+procedure TJSONSchemaValidations.SetMultipleOf(AValue: Double);
+begin
+  if FMultipleOf=AValue then Exit;
+  FMultipleOf:=AValue;
+  SetKeywordData(jskMultipleOf);
+end;
+
+procedure TJSONSchemaValidations.SetPattern(AValue: String);
+begin
+  if FPattern=AValue then Exit;
+  FPattern:=AValue;
+  SetKeywordData(jskPattern);
+end;
+
+procedure TJSONSchemaValidations.SetRequired(AValue: TStrings);
+begin
+  if FRequired=AValue then Exit;
+  FRequired.Assign(AValue);
+  SetKeywordData(jskRequired);
+end;
+
+procedure TJSONSchemaValidations.SetTypes(AValue: TSchemaSimpleTypes);
+begin
+  if FTypes=AValue then Exit;
+  FTypes:=AValue;
+  SetKeywordData(jskType);
+end;
+
+procedure TJSONSchemaValidations.SetUniqueItems(AValue: Boolean);
+begin
+  if FUniqueItems=AValue then Exit;
+  FUniqueItems:=AValue;
+  SetKeywordData(jskUniqueItems);
+end;
+
+procedure TJSONSchemaValidations.SetConstrained;
+begin
+  if Assigned(Schema) then
+    Schema.MatchType:=smConstrained;
+end;
+
+procedure TJSONSchemaValidations.SetKeywordData(aKeyword: TJSONSchemaKeyword);
+begin
+  Include(FKeywordData,aKeyword);
+  SetConstrained;
+end;
+
+procedure TJSONSchemaValidations.UnSetKeywordData(aKeyword: TJSONSchemaKeyword);
+begin
+  Exclude(FKeywordData,aKeyword);
+end;
+
+function TJSONSchemaValidations.GetContentSchema: TJSONSchema;
+begin
+  if FcontentSchema=Nil then
+    begin
+    if Assigned(Schema) then
+      FcontentSchema:=Schema.CreateChildSchema(jskContentSchema)
+    else
+      begin
+      FContentSchema:=TJSONSchema.Create(Nil);
+      FContentSchema.Name:=jskContentSchema.AsString;
+      end;
+    SetConstrained;
+    end;
+  Result:=FcontentSchema;
+end;
+
+procedure TJSONSchemaValidations.DoRequiredChange(Sender: TObject);
+begin
+  if HasKeywordData(jskRequired) then
+     SetConstrained;
+end;
+
+procedure TJSONSchemaValidations.DoAdd(Sender: TObject);
+begin
+  SetConstrained;
+end;
+
+function TJSONSchemaValidations.GetFormatValidator: TStringFormatValidator;
+begin
+  Result:=TStringFormatValidator.FromString(Format);
+end;
+
+
+constructor TJSONSchemaValidations.Create(aSchema: TJSONSchema);
+begin
+  FSchema:=aSchema;
+  FRequired:=TStringList.Create;
+  TStringList(FRequired).OnChange:=@DoRequiredChange;
+  FEnum:=TJSONArray.Create;
+  FDependentRequired:=CreateDependentRequired;
+end;
+
+destructor TJSONSchemaValidations.Destroy;
+begin
+  ConstValue:=Nil;
+  FreeAndNil(FDependentRequired);
+  FreeAndNil(FRequired);
+  FreeAndNil(FEnum);
+  FreeAndNil(FcontentSchema);
+  inherited Destroy;
+end;
+
+function TJSONSchemaValidations.KeywordsWithData: TJSONSchemaKeywords;
+
+var
+  K : TJSONSchemaKeyword;
+
+begin
+  Result:=[];
+  For K in Keywords do
+    if HasKeyWordData(K) then
+      Include(Result,K);
+end;
+
+function TJSONSchemaValidations.HasKeywordData(aKeyword: TJSONSchemaKeyword): Boolean;
+begin
+  case aKeyword of
+    jskEnum : Result:=Assigned(FEnum) and (FEnum.Count>0);
+    jskRequired : Result:=Assigned(FRequired) and (Required.Count>0);
+    jskDependentRequired : Result:=Assigned(FDependentRequired) and (FDependentRequired.Count>0);
+    jskContentSchema : Result:=Assigned(FContentSchema);
+  else
+    Result:=aKeyword in FKeywordData
+  end;
+end;
+
+{ TJSONSChemaVocabulary }
+
+procedure TJSONSchemaVocabulary.Assign(Source: TPersistent);
+var
+  aSource: TJSONSChemaVocabulary absolute source;
+begin
+  if Source is TJSONSChemaVocabulary then
+    begin
+    URL:=aSource.URL;
+    Enabled:=aSource.Enabled;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+function TJSONSchemaVocabulary.ToString: String;
+begin
+  Result:=URL+': '+BoolToStr(Enabled,'True','False');
+end;
+
+{ TJSONSChemaVocabularyList }
+
+function TJSONSchemaVocabularyList.GetSchema: TJSONSchema;
+begin
+  if Owner is TJSONSchema then
+    Result:=TJSONSchema(Owner)
+  else
+    Result:=Nil;
+end;
+
+function TJSONSchemaVocabularyList.GetVocabulary(aIndex : integer): TJSONSchemaVocabulary;
+begin
+  Result:=TJSONSchemaVocabulary(Items[aIndex])
+end;
+
+procedure TJSONSchemaVocabularyList.SetVocabulary(aIndex : integer; AValue: TJSONSchemaVocabulary);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+function TJSONSchemaVocabularyList.IndexOfVocabulary(const aURL: String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and not SameText(aURL,GetVocabulary(Result).URL) do
+    Dec(Result);
+end;
+
+function TJSONSchemaVocabularyList.FindVocabulary(aURL: String): TJSONSchemaVocabulary;
+
+var
+  Idx : Integer;
+begin
+  Idx:=IndexOfVocabulary(aURL);
+  if Idx=-1 then
+    Result:=Nil
+  else
+    Result:=GetVocabulary(Idx);
+end;
+
+function TJSONSchemaVocabularyList.AddVocabulary(const aURL: String): TJSONSchemaVocabulary;
+begin
+  Result:=add as TJSONSchemaVocabulary;
+  Result.URL:=aURL;
+  if assigned(Schema) then
+    Schema.MatchType:=smConstrained;
+end;
+
+function TJSONSchemaVocabularyList.ToString: String;
+
+var
+  I : Integer;
+
+begin
+  Result:='';
+  For I:=0 to Count-1 do
+    if Vocabularies[I].Enabled then
+      Result:=Result+Vocabularies[I].ToString;
+end;
+
+{ TJsonSchema }
+
+
+function TJsonSchema.GetAdditionalProperties: TJSONSchema;
+begin
+  if Not Assigned(FAdditionalproperties) then
+    FAdditionalproperties:=CreateChildSchema(jskAdditionalProperties);
+  Result:=FAdditionalproperties;
+end;
+
+function TJsonSchema.GetChildSchema(aIndex : Integer): TJSONSchema;
+begin
+  Result:=TJSONSchema(FChildren[aIndex]);
+end;
+
+function TJsonSchema.GetChildSchemaCount: Integer;
+begin
+  Result:=FChildren.Count;
+end;
+
+function TJsonSchema.GetDependentSchemas: TJSONSchemaList;
+begin
+  if FDependentSchemas=Nil then
+    FDependentSchemas:=TJSONSchemaList.Create(Self,jskDependentSchemas);
+  Result:=FDependentSchemas;
+end;
+
+function TJsonSchema.GetPatternProperties: TJsonSchemaList;
+begin
+  if FPatternProperties=Nil then
+    FPatternProperties:=TJSONSchemaList.Create(Self,jskPatternProperties);
+  Result:=FPatternProperties;
+end;
+
+function TJsonSchema.GetUnknownKeywordData: TJSONObject;
+begin
+  if FUnknownKeywordData=Nil then
+    FUnknownKeywordData:=TJSONObject.Create;
+  Result:=FUnknownKeywordData;
+end;
+
+procedure TJsonSchema.SetMetadata(AValue: TJSONSchemaMetadata);
+begin
+  if FMetaData=AValue then Exit;
+  FMetaData.Assign(AValue);
+end;
+
+procedure TJsonSchema.SetString(AIndex: Integer; AValue: String);
+
+var
+  KW : TJSONSchemaKeyword;
+
+begin
+  kw:=TJSONSchemaKeyword(aIndex);
+  SetKeyWordData(kw);
+  Case kw of
+    jskSchema: FSchema:=aValue;
+    jskId: FId:=aValue;
+    jskRef: FRef:=aValue;
+    jskComment: FComment:=aValue;
+    jskAnchor: FAnchor:=aValue;
+    jskDynamicAnchor: FDynamicAnchor:=aValue;
+    jskDynamicRef: FDynamicRef:=aValue;
+  end;
+end;
+
+procedure TJsonSchema.SetValidations(AValue: TJsonSchemaValidations);
+begin
+  if FValidations=AValue then Exit;
+  FValidations.Assign(AValue);
+end;
+
+procedure TJsonSchema.SetVocabulary(AValue: TJSONSchemaVocabularyList);
+begin
+  if FVocabulary=AValue then Exit;
+  FVocabulary.Assign(AValue);
+end;
+
+procedure TJsonSchema.SetKeyWordData(akeyWord: TJSONSchemaKeyword);
+begin
+  Include(FKeywordData,aKeyword);
+  FMatchType:=smConstrained;
+end;
+
+procedure TJsonSchema.UnsetKeyWordData(akeyWord: TJSONSchemaKeyword);
+begin
+  Exclude(FKeywordData,aKeyword);
+end;
+
+function TJsonSchema.GetSubSchema(aIndex: Integer): TJSONSchema;
+
+var
+  SS : TJSONSubSchema;
+
+begin
+  SS:=TJSONSubSchema(aindex);
+  if Not Assigned(FSubSchemas[SS]) then
+    begin
+    FSubSchemas[SS]:=CreateChildSchema(SS.AsSchemaKeyword);
+    SetKeyWordData(SS.AsSchemaKeyword);
+    end;
+  Result:=FSubSchemas[SS];
+end;
+
+function TJsonSchema.CreateChildSchema(aName: string): TJsonSchema;
+begin
+  Result:=CreateChildSchema();
+  Result.Name:=aName;
+end;
+
+function TJsonSchema.CreateChildSchema(aKeyword: TJSONSchemaKeyword): TJsonSchema;
+begin
+  Result:=CreateChildSchema(aKeyWord.AsString);
+end;
+
+function TJsonSchema.CreateVocabulary: TJSONSchemaVocabularyList;
+begin
+  Result:=TJSONSchemaVocabularyList.Create(Self,TJSONSchemaVocabulary);
+end;
+
+constructor TJsonSchema.Create(AParent: TJsonSchema);
+begin
+  FParent:=aParent;
+  if Assigned(FParent) then
+    FParent.FChildren.Add(Self);
+  FDefs:=TJsonSchemaList.Create(Self,jskDefs);
+  FItems:=TJsonSchemaList.Create(Self,jskItems);
+  FAllOf:=TJsonSchemaList.Create(Self,jskAllof);
+  FAnyOf:=TJsonSchemaList.Create(Self,jskAnyOf);
+  FOneOf:=TJsonSchemaList.Create(Self,jskOneOf);
+  FProperties:=TJsonSchemaList.Create(Self,jskProperties);
+  FPrefixItems:=TJsonSchemaList.Create(Self,jskPrefixItems);
+  FVocabulary:=CreateVocabulary;
+  FMetaData:=CreateMetaData;
+  FValidations:=CreateValidations;
+  FChildren:=TFPList.Create;
+end;
+
+constructor TJsonSchema.Create;
+begin
+  Create(Nil);
+end;
+
+destructor TJsonSchema.Destroy;
+
+var
+  SS :TJSONSubschema;
+  I : Integer;
+
+begin
+  if Assigned(FParent) then
+    FParent.FChildren.Remove(Self);
+  For I:=0 to FChildren.Count-1 do
+    TJsonSchema(FChildren[I]).FParent:=Nil;
+  For SS in TJSONSubschema do
+    FreeAndNil(FSubSchemas[SS]);
+  FreeAndNil(FValidations);
+  FreeAndNil(FItems);
+  FreeAndNil(FAllOf);
+  FreeAndNil(FAnyOf);
+  FreeAndNil(FOneOf);
+  FreeAndNil(FProperties);
+  FreeAndNil(FPrefixItems);
+  FreeAndNil(FVocabulary);
+  FreeAndNil(FMetaData);
+  FreeAndNil(FPrefixItems);
+  FreeAndNil(FAdditionalProperties);
+  FreeAndNil(FPatternProperties);
+  FreeAndNil(FDependentSchemas);
+  FreeAndNil(FDefs);
+  FreeAndNil(FUnknownKeywordData);
+  FreeAndNil(FChildren);
+  inherited Destroy;
+end;
+
+function TJsonSchema.HasKeywordData(aKeyword: TJSONSchemaKeyword): Boolean;
+begin
+  if aKeyword in Validations.Keywords then
+    Result:=Validations.HasKeywordData(aKeyWord)
+  else if aKeyword in MetaData.Keywords then
+    Result:=MetaData.HasKeywordData(aKeyWord)
+  else
+    begin
+    Case aKeyword of
+      jskPrefixItems: Result:=FPrefixItems.Count>0;
+      jskProperties : Result:=FProperties.Count>0;
+      jskItems : Result:=FItems.Count>0;
+      jskAllOf : Result:=FAllOf.Count>0;
+      jskAnyOf : Result:=FAnyOf.Count>0;
+      jskOneOf : Result:=FOneOf.Count>0;
+      jskDependentSchemas: Result:=Assigned(FDependentSchemas) and (FDependentSchemas.Count>0);
+      jskPatternProperties: Result:=Assigned(FPatternProperties) and (FPatternProperties.Count>0);
+      jskDefs : Result:=FDefs.Count>0;
+      jskVocabulary : Result:=Assigned(FVocabulary) and (FVocabulary.Count>0);
+    else
+      Result:=aKeyword in FKeywordData;
+    end;
+    end;
+end;
+
+function TJsonSchema.KeywordsWithData: TJSONSchemaKeywords;
+begin
+  Result:=FKeywordData+Validations.FKeywordData+MetaData.Keywords;
+end;
+
+
+function TJSONSchemaValidations.CreateDependentRequired: TSchemaDependentRequiredList;
+begin
+  Result:=TSchemaDependentRequiredList.Create(Self,TSchemaDependentRequired);
+end;
+
+function TJSONSchemaValidations.GetOwner: TPersistent;
+begin
+  Result:=FSchema;
+end;
+
+function TJSONSchemaValidations.Keywords: TJSONSchemaKeywords;
+begin
+  Result:=ValidatorKeywords;
+end;
+
+procedure TJSONSchemaValidations.Assign(Source: TPersistent);
+var
+  aSource: TJSONSchemaValidations absolute Source;
+begin
+  if Source is TJSONSchemaValidations then
+  begin
+    FKeywordData:=[];
+    UniqueItems:=aSource.UniqueItems;
+    Types:=aSource.Types;
+    Required:=aSource.Required;
+    Pattern:=aSource.Pattern;
+    MultipleOf:=aSource.MultipleOf;
+    MinProperties:=aSource.MinProperties;
+    MinLength:=aSource.MinLength;
+    MinItems:=aSource.MinItems;
+    Minimum:=aSource.Minimum;
+    MinContains:=aSource.MinContains;
+    MaxProperties:=aSource.MaxProperties;
+    MaxLength:=aSource.MaxLength;
+    MaxItems:=aSource.MaxItems;
+    Maximum:=aSource.Maximum;
+    MaxContains:=aSource.MaxContains;
+    Format:=aSource.Format;
+    ExclusiveMinimum:=aSource.ExclusiveMinimum;
+    ExclusiveMaximum:=aSource.ExclusiveMaximum;
+    contentMediaType:=aSource.contentMediaType;
+    contentEncoding:=aSource.contentEncoding;
+    constValue:=aSource.constValue.Clone;
+    enum:=aSource.Enum.Clone as TJSONArray;
+  end else
+    inherited Assign(Source);
+end;
+
+function TJsonSchema.CreateMetadata: TJSONSchemaMetadata;
+begin
+  Result:=TJSONSchemaMetadata.Create(Self);
+end;
+
+function TJsonSchema.CreateValidations: TJsonSchemaValidations;
+
+begin
+  Result:=TJsonSchemaValidations.Create(Self);
+end;
+
+procedure TJsonSchema.CheckConstrained;
+
+
+begin
+
+end;
+
+function TJsonSchema.CreateChildSchema: TJsonSchema;
+begin
+  Result:=TJsonSchemaClass(ClassType).Create(Self);
+end;
+
+function TJsonSchema.RootSchema: TJSONSchema;
+begin
+  Result:=Self;
+  While Assigned(Result.Parent) do
+    Result:=Result.Parent;
+end;
+
+function TJsonSchema.GetNamedList(const aName : string) : TJSONSchemaList;
+
+  Function TestList(aList : TJSONSchemaList; out aRes : TJSONSchemaList) : Boolean;
+
+  begin
+    Result:=Assigned(aList) and (aList.Keyword<>jskUnknown) and (aName=aList.Keyword.AsString);
+    if Result then
+      aRes:=aList;
+  end;
+
+begin
+  Result:=Nil;
+  If TestList(FPatternProperties,Result) then exit;
+  If TestList(FPrefixItems,Result) then exit;
+  If TestList(FProperties,Result) then exit;
+  If TestList(FItems,Result) then exit;
+  If TestList(FAllOf,Result) then exit;
+  If TestList(FAnyOf,Result) then exit;
+  If TestList(FOneOf,Result) then exit;
+  If TestList(FDependentSchemas,Result) then exit;
+  If TestList(FDefs,Result) then exit;
+
+end;
+
+function TJsonSchema.Find(const aPath: String): TJSONSchema;
+
+var
+  P : Integer;
+  aSubPath,aName : string;
+  SchemaList : TJSONSchemaList;
+
+begin
+  Result:=Nil;
+  aSubPath:='';
+  P:=Pos('/',aPath);
+  if P=0 then
+    aName:=aPath
+  else
+    begin
+    aName:=Copy(aPath,1,P-1);
+    aSubPath:=Copy(aPath,P+1);
+    end;
+  if aName='' then
+    Result:=Self
+  else if aName='#' then
+    Result:=RootSchema
+  else
+    begin
+    SchemaList:=GetNamedList(aName);
+    if Assigned(SchemaList) then
+      Exit(SchemaList.FindIDOrNames(aSubPath))
+    else
+      Result:=FindChild(aName);
+    end;
+  if Assigned(Result) and (aSubPath<>'') then
+    Result:=Result.Find(aSubPath);
+end;
+
+function TJsonSchema.IndexOfChild(const aName: String): Integer;
+begin
+  Result:=FChildren.Count-1;
+  While (Result>=0) and (ChildSchemas[Result].Name<>aName) do
+    Dec(Result);
+end;
+
+function TJsonSchema.FindChild(const aName : String) : TJSONSchema;
+
+var
+  Idx : integer;
+
+begin
+  Idx:=IndexOfChild(aName);
+  if Idx=-1 then
+    Result:=nil
+  else
+    Result:=ChildSchemas[Idx];
+end;
+
+function TJsonSchema.GetPath: String;
+
+begin
+  if Parent=Nil then
+    Result:='#'
+  else
+    Result:=Parent.Path+'/'+Name;
+end;
+
+{ TJSONSchemaList }
+
+function TJSONSchemaList.GetSchema(aIndex : integer): TJSONSchema;
+begin
+  Result:=Items[aIndex] as TJSONSchema;
+end;
+
+procedure TJSONSchemaList.SetSchema(aIndex : integer; AValue: TJSONSchema);
+begin
+  Items[aIndex]:=aValue;
+end;
+
+constructor TJSONSchemaList.Create(aOwner: TJSONSchema; aKeyWord: TJSONSchemaKeyword);
+begin
+  Inherited Create(True);
+  FSchemaOwner:=aOwner;
+  FKeyword:=aKeyword;
+end;
+
+function TJSONSchemaList.FindIDOrNames(aPath: String): TJSONSchema;
+
+var
+  I,P : Integer;
+  aSubPath,aName : string;
+
+begin
+  Result:=Nil;
+  aSubPath:='';
+  P:=Pos('/',aPath);
+  if (P=0) then
+    aName:=aPath
+  else
+    begin
+    aName:=Copy(aPath,1,P-1);
+    aSubPath:=Copy(aPath,P+1);
+    end;
+  if aName='' then
+    exit;
+  I:=Count-1;
+  While (Result=Nil) and (I>=0) do
+    begin
+    Result:=Schemas[I];
+    if (Result.ID<>aName) and (Result.Name<>aName) then
+      Result:=Nil;
+    Dec(I);
+    end;
+  if Assigned(Result) and (aSubPath<>'') then
+    Result.Find(aSubPath);
+end;
+
+function TJSONSchemaList.Add(const aName: string): TJSONSchema;
+begin
+  if FSchemaOwner=Nil then
+    Result:=TJSONSchema.Create
+  else
+    begin
+    Result:=SchemaOwner.CreateChildSchema(aName);
+    if Keyword<>jskUnknown then
+      SchemaOwner.SetKeyWordData(Keyword);
+    end;
+  Inherited Add(Result);
+end;
+
+function TJSONSchemaList.Add(Schema: TJSONSchema): Integer;
+begin
+  Result:=Inherited Add(Schema);
+  if Keyword<>jskUnknown then
+    SchemaOwner.SetKeyWordData(Keyword);
+end;
+
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.types.pp

@@ -0,0 +1,454 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema basic types and helpers
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FpJson.Schema.Types;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils;
+  {$ELSE}
+  SysUtils;
+  {$ENDIF}
+
+Type
+  EJSONSchema = Class(exception);
+
+  TJSONSchemaKeyword = (
+    jskUnknown,
+    jskId,
+    jskAnchor,
+    jskIdDraft4,
+    jskSchema,
+    jskDefs,
+    jskTitle,
+    jskDescription,
+    jskDefault,
+    jskMultipleOf,
+    jskMaximum,
+    jskExclusiveMaximum,
+    jskMinimum,
+    jskExclusiveMinimum,
+    jskMaxLength,
+    jskMinLength,
+    jskPattern,
+    jskAdditionalItems, //old
+    jskItems,
+    jskPrefixItems,
+    jskMaxItems,
+    jskMinItems,
+    jskUniqueItems,
+    jskMaxProperties,
+    jskMinProperties,
+    jskMaxContains,
+    jskMinContains,
+    jskRequired,
+    jskDefinitions,
+    jskProperties,
+    jskPatternProperties,
+    jskAdditionalProperties,
+    jskPropertyNames,
+    jskDependentSchemas,
+    jskDependentRequired,
+    jskEnum,
+    jskType,
+    jskAllOf,
+    jskAnyOf,
+    jskOneOf,
+    jskNot,
+    jskFormat,
+    jskRef,
+    jskIf,
+    jskElse,
+    jskThen,
+    jskDynamicRef,
+    jskDynamicAnchor,
+    jskContains,
+    jskComment,
+    jskConst,
+    jskUnevaluatedItems,
+    jskUnevaluatedProperties,
+    jskContentEncoding,
+    jskContentMediaType,
+    jskContentSchema,
+    jskExamples,
+    jskDeprecated,
+    jskReadOnly,
+    jskWriteOnly,
+    jskVocabulary
+  );
+  TJSONSchemaKeywords = Set of TJSONSchemaKeyword;
+
+  TJSONSubschema = (
+   ssNot,
+   ssIf,
+   ssThen,
+   ssElse,
+   ssContains,
+   ssUnevaluatedItems,
+   ssUnevaluatedProperties,
+   ssPropertyNames,
+   ssAdditionalProperties
+  );
+  TJSONSubschemas = set of TJSONSubschema;
+
+  TStringFormatValidator = (
+   sfvCustom,
+   sfvDatetime,
+   sfvDate,
+   sfvTime,
+   sfvDuration,
+   sfvEmail,
+   sfvIdnEmail,
+   sfvHostname,
+   sfvIdnHostname,
+   sfvIPV4,
+   sfvIPV6,
+   sfvURI,
+   sfvURIReference,
+   sfvIRI,
+   sfvIRIReference,
+   sfvUUID,
+   sfvURITemplate,
+   sfvJSONPointer,
+   sfvRelativeJSONPointer,
+   sfvRegex
+  );
+  TStringFormatValidators = set of TStringFormatValidator;
+
+  TSchemaSimpleType = (
+   sstNone,
+   sstNull,
+   sstBoolean,
+   sstInteger,
+   sstNumber,
+   sstString,
+   sstArray,
+   sstObject,
+   sstAny
+  );
+  TSchemaSimpleTypes = set of TSchemaSimpleType;
+
+  TSchemaMatchType = (smAny,smNone,smConstrained); // corresponds to True, false or object schemas
+  TSchemaMatchTypes = set of TSchemaMatchType;
+
+  { TJSONSchemaKeywordHelper }
+
+  TJSONSchemaKeywordHelper = Type helper for TJSONSchemaKeyword
+    Function GetAsString: String;
+    procedure SetAsString(const aValue: String);
+    class function FromString(const aValue : String) : TJSONSchemaKeyword; static;
+    property AsString : String Read GetAsString Write SetAsString;
+  end;
+
+  { TStringFormatValidatorHelper }
+
+  TStringFormatValidatorHelper = Type helper for TStringFormatValidator
+    Function GetAsString: String;
+    procedure SetAsString(const aValue: String);
+    class function FromString(const aValue : String) : TStringFormatValidator; static;
+    property AsString : String Read GetAsString Write SetAsString;
+  end;
+
+  { TSchemaSimpleTypeHelper }
+  TSchemaSimpleTypeHelper = Type Helper for TSchemaSimpleType
+    Function GetAsString: String;
+    procedure SetAsString(const aValue: String);
+    class function FromString(const aValue : String) : TSchemaSimpleType; static;
+    property AsString : String Read GetAsString Write SetAsString;
+  end;
+
+  TSchemaSimpleTypesHelper = Type Helper for TSchemaSimpleTypes
+    Function ToString: String;
+    property AsString : String Read ToString;
+  end;
+
+
+  { TJSONSubschemaHelper }
+
+  TJSONSubschemaHelper = Type helper for TJSONSubschema
+  private
+    function GetAsSchemaKeyword: TJSONSchemaKeyword;
+  Public
+    Function GetAsString: String;
+    procedure SetAsString(const aValue: String);
+    class function FromString(const aValue : String) : TJSONSubschema; static;
+    property AsString : String Read GetAsString Write SetAsString;
+    property AsSchemaKeyword : TJSONSchemaKeyword Read GetAsSchemaKeyword;
+  end;
+
+const
+  ValidatorKeywords = [
+    jskType, jskconst, jskEnum, jskExclusiveMaximum, jskExclusiveMinimum, jskMaximum,
+    jskMinimum, jskMaxItems, jskMinItems, jskRequired, jskMaxLength, jskMinLength, jskMaxProperties,
+    jskMinProperties, jskPattern, jskUniqueItems, jskMinContains, jskMaxContains, jskMultipleOf,
+    jskDependentRequired, jskFormat, jskcontentMediaType, jskcontentEncoding, jskcontentSchema];
+  MetadataKeywords = [
+    jskTitle,jskDescription,jskDefault,jskDeprecated,jskExamples,jskReadOnly,jskWriteOnly
+    ];
+
+
+
+implementation
+
+uses fpjson.schema.consts;
+
+const
+  SimpleTypeNames : Array[TSchemaSimpleType] of string = (
+    STNone,
+    STNull,
+    STBoolean,
+    STInteger,
+    STNumber,
+    STString,
+    STArray,
+    STObject,
+    STAny
+  );
+
+  KeywordNames : Array[TJSONSchemaKeyWord] of string = (
+    SJKWUnknown, { jskUnknown }
+    SJKWId, { jskId }
+    SJKWAnchor, { jskAnchor }
+    SJKWOldId, { jskId }
+    SJKWSchema, { jskSchema }
+    SJKWDefs, { jskDefs }
+    SJKWTitle, { jskTitle }
+    SJKWDescription, { jskDescription }
+    SJKWDefault, { jskDefault }
+    SJKWMultipleOf, { jskMultipleOf }
+    SJKWMaximum, { jskMaximum }
+    SJKWExclusiveMaximum, { jskExclusiveMaximum }
+    SJKWMinimum, { jskMinimum }
+    SJKWExclusiveMinimum, { jskExclusiveMinimum }
+    SJKWMaxLength, { jskMaxLength }
+    SJKWMinLength, { jskMinLength }
+    SJKWPattern, { jskPattern }
+    SJKWAdditionalItems, { jskAdditionalItems }
+    SJKWItems, { jskItems }
+    SJKWPrefixItems, { jskPrefixItems }
+    SJKWMaxItems, { jskMaxItems }
+    SJKWMinItems, { jskMinItems }
+    SJKWUniqueItems, { jskUniqueItems }
+    SJKWMaxProperties, { jskMaxProperties }
+    SJKWMinProperties, { jskMinProperties }
+    SJKWMaxContains,  { jskMaxContains }
+    SJKWMinContains,  { jskMinContains }
+    SJKWRequired, { jskRequired }
+    SJKWDefinitions, { jskDefinitions }
+    SJKWProperties, { jskProperties }
+    SJKWPatternProperties, { jskPatternProperties }
+    SJKWAdditionalProperties, { jskAdditionalProperties }
+    SJKWPropertyNames, { jskPropertyNames  }
+    SJKWDependentSchemas, { jskDependentSchemas }
+    SJKWDependentRequired, { jskDependentRequired }
+    SJKWEnum, { jskEnum }
+    SJKWType, { jskType }
+    SJKWAllOf, { jskAllOf }
+    SJKWAnyOf, { jskAnyOf }
+    SJKWOneOf, { jskOneOf }
+    SJKWNot, { jskNot }
+    SJKWFormat, { jskFormat }
+    SJKWRef, { jskRef }
+    SJKWIf, { jskIf }
+    SJKWElse, { jskElse }
+    SJKWThen, { jskThen }
+    SJKWDynamicRef, { jskDynamicRef }
+    SJKWDynamicAnchor,  { jskDynamicAnchor }
+    SJKWContains,  { jskContains }
+    SJKWComment, { jskComment }
+    SJKWConst, { jskConst}
+    SJKWUnevaluatedItems, { jskUnevaluatedItems }
+    SJKWUnevaluatedProperties, {jskUnevaluatedProperties}
+    SJKWContentEncoding, { jskContentEncoding }
+    SJKWContentMediaType, { jskContentMediaType }
+    SJKWContentSchema, { jskContentSchema }
+    SJKWExamples, { jskExamples }
+    SJKWDeprecated, { jskDeprecated}
+    SJKWReadOnly, {jskReadOnly }
+    SJKWWriteOnly, {jskWriteOnly }
+    SJKWVocabulary { jskVocabulary }
+  );
+
+  JSONSubschemaKeys : Array[TJSONSubschema] of TJSONSchemaKeyWord = (
+    jskNot,
+    jskIf,
+    jskThen,
+    jskElse,
+    jskContains,
+    jskUnevaluatedItems,
+    jskUnevaluatedProperties,
+    jskPropertyNames,
+    jskAdditionalProperties
+  );
+
+  StringFormatValidatorNames : Array[TStringFormatValidator] of string = (
+    '',
+    SFmtDatetime,
+    SFmtDate,
+    SFmtTime,
+    SFmtDuration,
+    SFmtEmail,
+    SFmtIdnEmail,
+    SFmtHostname,
+    SFmtIdnHostname,
+    SFmtIPV4,
+    SFmtIPV6,
+    SFmtURI,
+    SFmtURIReference,
+    SFmtIRI,
+    SFmtIRIReference,
+    SFmtUUID,
+    SFmtURITemplate,
+    SFmtJSONPointer,
+    SFmtRelativeJSONPointer,
+    SFmtRegex
+  );
+
+{ TJSONSchemaKeywordHelper }
+
+function TJSONSchemaKeywordHelper.GetAsString: String;
+begin
+  Result:=KeyWordNames[Self];
+end;
+
+procedure TJSONSchemaKeywordHelper.SetAsString(const aValue: String);
+var
+  Kw : TJSONSchemaKeyword;
+begin
+  Self:=jskUnknown;
+  for Kw in TJSONSchemaKeyword do
+    if aValue=KeywordNames[kw] then
+      begin
+      Self:=kw;
+      Exit;
+      end;
+end;
+
+class function TJSONSchemaKeywordHelper.FromString(const aValue: String): TJSONSchemaKeyword;
+begin
+  Result:=jskUnknown;
+  Result.SetAsString(aValue);
+end;
+
+{ TStringFormatValidatorHelper }
+
+function TStringFormatValidatorHelper.GetAsString: String;
+begin
+  Result:=StringFormatValidatorNames[Self];
+end;
+
+procedure TStringFormatValidatorHelper.SetAsString(const aValue: String);
+
+var
+  sfv : TStringFormatValidator;
+begin
+  Self:=sfvCustom;
+  For sfv in TStringFormatValidator do
+    if StringFormatValidatorNames[sfv]=aValue then
+      begin
+      Self:=sfv;
+      Exit;
+      end;
+end;
+
+class function TStringFormatValidatorHelper.FromString(const aValue: String): TStringFormatValidator;
+begin
+  Result:=sfvCustom;
+  Result.AsString:=aValue;
+end;
+
+{ TSchemaSimpleTypeHelper }
+
+function TSchemaSimpleTypeHelper.GetAsString: String;
+begin
+  Result:=SimpleTypeNames[Self]
+end;
+
+procedure TSchemaSimpleTypeHelper.SetAsString(const aValue: String);
+var
+  st : TSchemaSimpleType;
+begin
+  Self:=sstNone;
+  for ST in TSchemaSimpleType do
+    if aValue=SimpleTypeNames[st] then
+      begin
+      Self:=st;
+      Exit;
+      end;
+end;
+
+class function TSchemaSimpleTypeHelper.FromString(const aValue: String): TSchemaSimpleType;
+begin
+  Result:=sstNone;
+  Result.AsString:=aValue;
+end;
+
+function TSchemaSimpleTypesHelper.ToString: String;
+
+var
+  s : TSchemaSimpleType;
+
+begin
+  Result:='';
+  For S in Self do
+    begin
+    if (Result<>'') then
+      Result:=Result+',';
+    Result:=Result+S.AsString;
+    end;
+end;
+
+{ TJSONSubschemaHelper }
+
+function TJSONSubschemaHelper.GetAsSchemaKeyword: TJSONSchemaKeyword;
+begin
+  Result:=JSONSubschemaKeys[Self];
+end;
+
+function TJSONSubschemaHelper.GetAsString: String;
+begin
+  Result:=GetAsSchemaKeyword.AsString;
+end;
+
+procedure TJSONSubschemaHelper.SetAsString(const aValue: String);
+
+var
+  Kw : TJSONSchemaKeyword;
+  T : TJSONSubschema;
+begin
+  Kw.AsString:=aValue;
+  For T in TJSONSubSchema do
+    if JSONSubschemaKeys[T]=kw then
+      begin
+      Self:=T;
+      exit;
+      end;
+end;
+
+class function TJSONSubschemaHelper.FromString(const aValue: String): TJSONSubschema;
+begin
+  Result:=ssNot;
+  Result.AsString:=aValue;
+end;
+
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.validator.pp

@@ -0,0 +1,1336 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema validator - validate JSON data
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FpJson.Schema.Validator;
+
+{$mode ObjFPC}
+{$H+}
+{$modeswitch typehelpers}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, System.Contnrs, FpJson.Data, FpJson.Schema.Types, FpJson.Schema.Schema;
+  {$ELSE}
+  Classes, SysUtils, contnrs, fpjson, FpJson.Schema.Types, FpJson.Schema.Schema;
+  {$ENDIF}
+
+Type
+  TValidationMessageType = (vmtInfo,vmtWarning,vmtError);
+  TValidationMessageTypes = set of TValidationMessageType;
+
+  { TValidationMessageTypeHelper }
+
+  TValidationMessageTypeHelper = type helper for TValidationMessageType
+  private
+    Function ToString: String;
+  public
+    Property AsString : String Read ToString;
+  end;
+
+  { TValidationMessage }
+
+  TValidationMessage = Class(TObject)
+  private
+    FKeyword: TJSONSchemaKeyword;
+    FMessage: String;
+    FPath: TJSONStringType;
+    FSchema: TJSONSchema;
+    FType: TValidationMessageType;
+  Public
+    Constructor Create(aSchema :TJSONSchema; aKeyword : TJSONSchemaKeyword; aType : TValidationMessageType; const aMessage : string; const aPath : TJSONStringType);
+    procedure AsJSON(aJSON : TJSONObject); virtual;
+    function AsJSON : TJSONObject;
+    Property Schema : TJSONSchema Read FSchema Write FSchema;
+    Property Keyword : TJSONSchemaKeyword Read FKeyword Write FKeyword;
+    Property MessageType : TValidationMessageType Read FType Write FType;
+    Property Message : String Read FMessage Write FMessage;
+    Property Path : TJSONStringType Read FPath Write FPath;
+  end;
+
+  { TValidationMessageList }
+
+  TValidationMessageList = Class sealed (TFPObjectList)
+  private
+    function GetMessage(aIndex : Integer): TValidationMessage;
+  Public
+    procedure AddMessages(aList:TValidationMessageList);
+    Procedure Add(aMessage : TValidationMessage); reintroduce;
+    procedure AsJSON(aJSON : TJSONArray); virtual;
+    function AsJSON : TJSONArray;
+    function AddMessage(aSchema : TJSONSchema; aKeyword : TJSONSchemaKeyword; aType: TValidationMessageType; const aMessage : String; const aPath : TJSONStringType) : TValidationMessage;
+    Function ErrorCount(StartAt : Integer = 0) : Integer;
+    Property Messages[aIndex : Integer] : TValidationMessage Read GetMessage; default;
+  end;
+
+  { TJSONSchemaValidator }
+  TResolveSchemaEvent = Procedure (Sender : TObject; const aRef : String; Var aSchema : TJSONSchema) of object;
+  TJSONSchemaValidator = class(TComponent)
+  private
+    FEpsilon: Double;
+    FMessages: TValidationMessageList;
+    FMessageTypes: TValidationMessageTypes;
+    FOnResolveSchemaURI: TResolveSchemaEvent;
+    FPath : Array of String;
+    FPathCount : Integer;
+    FLastArr : TJSONArray;
+    FLastContains : TJSONSchema;
+    FLastContainsCount : Integer;
+    procedure CleanUpValidation;
+    function GetCurrentPath: String;
+  protected
+    procedure PushPath(aPath : String);
+    procedure PopPath;
+    function CreateMessageList : TValidationMessageList;
+    function SaveMessages : TValidationMessageList;
+    procedure RestoreMessages(aList : TValidationMessageList);
+    function AddMessage(aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword; aType: TValidationMessageType; const aMessage: String;
+      const aPath: TJSONStringType): TValidationMessage;
+    function AddMessage(aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword; aType: TValidationMessageType; const aMessage: String
+      ): TValidationMessage;
+    procedure Info(aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword; aValue: string);
+    function EqualData(aData1, aData2: TJSONData): Boolean; virtual;
+    // Other checks. To be overridden
+    function CheckOtherKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONStringType) : Boolean; virtual;
+    function CheckOtherKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword) : Boolean; virtual;
+    // String value checks
+    function CheckFormat(aSchema: TJSONSchema; aValue: TJSONStringType; aFormat: TStringFormatValidator) : Boolean; virtual;
+    function CheckString(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword) : Boolean; virtual;
+    // Numerical value checks
+    function CheckNumerical(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean; virtual;
+    // Array value checks
+    function CheckArray(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean; virtual;
+    function CheckArrayItems(Arr: TJSONArray; aStart: Integer; aItems: TJSONSchemaList): Integer; virtual;
+    function CheckArrayPrefixItems(Arr: TJSONArray; aItems: TJSONSchemaList): Integer; virtual;
+    function CheckArrayUniqueItems(Arr: TJSONArray): Integer; virtual;
+    function GetArrayContainsCount(Arr: TJSONArray; aContains: TJSONSchema): Integer; virtual;
+    // Object checks
+    function CheckObject(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean; virtual;
+    function CheckObjectPatternProperties(Obj: TJSONObject; aProperties: TJSONSchemaList): Boolean; virtual;
+    function CheckObjectProperties(Obj: TJSONObject; aProperties: TJSONSchemaList): Boolean; virtual;
+    function CheckObjectproperty(Obj: TJSONObject; aIndex: Integer; aSchema: TJSONSchema): Boolean; virtual;
+    function CheckObjectAdditionalProperties(Obj: TJSONObject; aSchema: TJSONSchema): Boolean;
+    function CheckObjectPropertyNames(Obj: TJSONObject; aSchema: TJSONSchema): Boolean;
+    procedure CollectObjectProperties(Obj: TJSONObject; aProperties: TJSONSchemaList; aList: TStrings);
+    procedure CollectPatternProperties(Obj: TJSONObject; aProperties: TJSONSchemaList; aList: TStrings);
+    function GetMissingObjectProperties(Obj: TJSONObject; aList: TStrings): String; virtual;
+    function CheckObjectDependentRequired(Obj: TJSONObject; aSchema: TJSONSchema): Boolean;
+    function CheckObjectDependentSchemas(Obj: TJSONObject; aList: TJSONSchemaList): Boolean;
+    // General checks
+    function CheckConst(aJSON: TJSONData; aSchema: TJSONSchema): Boolean;
+    function CheckEnum(aJSON: TJSONData; aSchema: TJSONSchema; aList : TJSONArray): Boolean;
+    function CheckType(aJSON: TJSONData; aSchema: TJSONSchema) : Boolean; virtual;
+    function CheckInList(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+    function CheckNot(aJSON: TJSONData; aNotSchema: TJSONSchema): Boolean;
+    function CheckIf(aJSON: TJSONData; aSchema: TJSONSchema): Boolean;
+    // Entry point for keywords
+    function CheckKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword) : Boolean; virtual;
+     //
+    function ResolveSchema(aSchema: TJSONSchema): TJSONSchema; virtual;
+
+    procedure DoValidateJSON(aJSON : TJSONData; aSchema : TJSONSchema); virtual;
+    property CurrentPath : String Read GetCurrentPath;
+  Public
+    constructor Create(aOwner : TComponent); override;
+    Destructor Destroy; override;
+    Procedure Reset;
+    Function ValidateJSON(aJSON : TJSONData; aSchema : TJSONSchema) : Boolean;
+    property Messages : TValidationMessageList Read FMessages;
+    Property MessageTypes : TValidationMessageTypes Read FMessageTypes Write FMessageTypes;
+    Property Epsilon : Double Read FEpsilon Write FEpsilon;
+    Property OnResolveSchemaURI : TResolveSchemaEvent Read FOnResolveSchemaURI Write FOnResolveSchemaURI;
+  end;
+
+implementation
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  FpJson.Schema.Consts, System.Regexpr, Fcl.UriParser
+  {$ELSE}
+  FpJson.Schema.Consts, RegExpr, URIParser
+  {$ENDIF}
+  ;
+
+
+{ TValidationMessageTypeHelper }
+
+function TValidationMessageTypeHelper.ToString: String;
+
+Const
+  Names : Array[TValidationMessageType] of string = ('Info','Warning','Error');
+
+begin
+  Result:=Names[Self];
+end;
+
+{ TValidationMessage }
+
+constructor TValidationMessage.Create(aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword; aType: TValidationMessageType;
+  const aMessage: string; const aPath: TJSONStringType);
+begin
+  FType:=aType;
+  FSchema:=aSchema;
+  FMessage:=aMessage;
+  FPath:=aPath;
+  FKeyword:=aKeyword;
+end;
+
+procedure TValidationMessage.AsJSON(aJSON: TJSONObject);
+begin
+  aJSON.Add('schema',Schema.Path);
+  if Schema.HasKeywordData(jskID) then
+    aJSON.Add('schemaID',Schema.ID);
+  aJSON.Add('keyword',Keyword.AsString);
+  aJSON.Add('type',MessageType.AsString);
+  aJSON.Add('path',Path);
+  aJSON.Add('message',Message);
+end;
+
+function TValidationMessage.AsJSON: TJSONObject;
+begin
+  Result:=TJSONObject.Create;
+  try
+    asJSON(Result);
+  except
+    Result.Free;
+    Raise;
+  end;
+end;
+
+{ TValidationMessageList }
+
+function TValidationMessageList.GetMessage(aIndex : Integer): TValidationMessage;
+begin
+  Result:=Items[aIndex] as TValidationMessage;
+end;
+
+procedure TValidationMessageList.AddMessages(aList: TValidationMessageList);
+
+var
+  Msg : TValidationMessage;
+  I : Integer;
+
+begin
+  For I:=0 to aList.Count-1 do
+    begin
+    Msg:=aList.Extract(aList[i]) as TValidationMessage;
+    Add(Msg);
+    end;
+end;
+
+procedure TValidationMessageList.Add(aMessage: TValidationMessage);
+begin
+  Inherited add(aMessage);
+end;
+
+procedure TValidationMessageList.AsJSON(aJSON: TJSONArray);
+
+var
+  I : integer;
+
+begin
+  For I:=0 to Count-1 do
+    aJSON.Add(Messages[i].AsJSON);
+end;
+
+function TValidationMessageList.AsJSON: TJSONArray;
+begin
+  Result:=TJSONArray.Create;
+  try
+    AsJSON(Result);
+  except
+    Result.Free;
+    Raise;
+  end;
+end;
+
+function TValidationMessageList.AddMessage(aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword; aType: TValidationMessageType;
+  const aMessage: String; const aPath: TJSONStringType): TValidationMessage;
+begin
+  Result:=TValidationMessage.Create(aSchema,aKeyword,aType,aMessage,aPath);
+  Add(Result);
+end;
+
+function TValidationMessageList.ErrorCount(StartAt: Integer): Integer;
+
+var
+  i : Integer;
+
+begin
+  Result:=0;
+  For I:=StartAt to Count-1 do
+    if GetMessage(I).MessageType=vmtError then
+      inc(Result);
+end;
+
+{ TJSONSchemaValidator }
+
+function TJSONSchemaValidator.GetCurrentPath: String;
+
+var
+  i : Integer;
+
+begin
+  Result:='';
+  if FPathCount=0 then Exit;
+  Result:=FPath[0];
+  For I:=1 to FPathCount-1 do
+    Result:=Result+'.'+FPath[i];
+end;
+
+procedure TJSONSchemaValidator.PushPath(aPath: String);
+begin
+  if FPathCount=Length(FPath) then
+    SetLength(FPath,FPathCount+10);
+  FPath[FPathCount]:=aPath;
+  inc(FPathCount);
+end;
+
+procedure TJSONSchemaValidator.PopPath;
+begin
+  if FPathCount>0 then
+    Dec(FPathCount);
+end;
+
+function TJSONSchemaValidator.CreateMessageList: TValidationMessageList;
+begin
+  Result:=TValidationMessageList.Create(True);
+end;
+
+function TJSONSchemaValidator.SaveMessages: TValidationMessageList;
+begin
+  Result:=FMessages;
+  FMessages:=CreateMessageList;
+end;
+
+procedure TJSONSchemaValidator.RestoreMessages(aList: TValidationMessageList);
+begin
+  FreeAndNil(FMessages);
+  FMessages:=aList;
+end;
+
+function TJSONSchemaValidator.ResolveSchema(aSchema: TJSONSchema): TJSONSchema;
+
+var
+  aRef,OurID : String;
+  S : TJSONSchema;
+
+  URI : TURI;
+  I : Integer;
+
+begin
+  if Not (aSchema.HasKeywordData(jskRef) or aSchema.HasKeywordData(jskDynamicRef)) then
+    Exit(aSchema);
+  aRef:=aSchema.Ref;
+  if aRef='' then
+    aRef:=aSchema.DynamicRef;
+  if aRef='' then
+    Exit(aSchema);
+  Result:=Nil;
+  if aSchema.HasKeywordData(jskId) then
+    OurID:=aSchema.ID;
+  if Pos(ourID,aRef)=1 then
+    Delete(aRef,1,Length(OurID));
+
+  URI:=ParseURI(aRef,'',0,True);
+  if (Uri.Protocol='') then
+    begin
+    // Local ref
+    if (Uri.Path='') and (Uri.Document='') then
+      Result:=aSchema.Find('#'+Uri.BookMark)
+    else
+      begin
+      // search defs
+      I:=0;
+      While (Result=Nil) and (I<aSchema.Defs.Count) do
+        begin
+        S:=aSchema.Defs[i];
+        if S.HasKeywordData(jskAnchor) and (Uri.BookMark=S.Anchor) then
+          Result:=S
+        else if S.HasKeywordData(jskDynamicAnchor) and (Uri.BookMark=S.DynamicAnchor) then
+          Result:=S
+        else if (S.Name<>'') and (Uri.BookMark=S.Name) then
+          Result:=S;
+        Inc(I);
+        end;
+      end;
+    end
+  else
+    Result:=Nil;
+  if (Result=Nil) and Assigned(OnResolveSchemaURI) then
+    OnResolveSchemaURI(Self,aRef,Result);
+end;
+
+function TJSONSchemaValidator.CheckOtherKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONStringType): Boolean;
+
+begin
+  // Do nothing
+
+end;
+
+function TJSONSchemaValidator.CheckOtherKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+begin
+  CheckOtherKeyword(aJSON,aSchema,aKeyword.AsString);
+end;
+
+function TJSONSchemaValidator.CheckType(aJSON: TJSONData; aSchema: TJSONSchema): Boolean;
+
+Const
+  JSONTypes : Array[TSchemaSimpleType] of TJSONType = (
+    jtUnknown, jtNull,jtBoolean,jtNumber,jtNumber,jtString,jtArray,jtObject,jtUnknown
+  );
+
+var
+  St : TSchemaSimpleType;
+  Found : Boolean;
+
+begin
+  if aSchema.Validations.Types=[] then
+    exit;
+  Found:=False;
+  for St in aSchema.Validations.Types do
+    if st<>sstNone then
+      begin
+      if st=sstAny then
+        Found:=True
+      else
+        begin
+        Found:=Found or (aJSON.JSONType=JSONTypes[st]);
+        if Found and (ST=sstInteger) then
+          Found:=TJSONNumber(aJSON).NumberType=ntInteger;
+        end;
+      end;
+  if not Found then
+    AddMessage(aSchema,jskType,vmtError,Format(SErrTypeMismatch,[JSONTypeName(aJSON.JSONType),aSchema.Validations.Types.AsString]));
+  Result:=Found;
+end;
+
+procedure TJSONSchemaValidator.Info(aSchema : TJSONSchema; aKeyword : TJSONSchemaKeyword; aValue : string);
+
+begin
+  if vmtInfo in MessageTypes then
+    AddMessage(aSchema,aKeyword,vmtInfo,Format(SSchemaInfo,[aKeyword.AsString,aValue]),CurrentPath);
+end;
+
+function TJSONSchemaValidator.CheckFormat(aSchema: TJSONSchema; aValue: TJSONStringType; aFormat: TStringFormatValidator): Boolean;
+
+var
+  OK : Boolean;
+
+begin
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.CheckString(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+var
+  sCheck,sCond : TJSONStringType;
+  OK : Boolean;
+  Rex : TRegExpr;
+
+begin
+  if aJSON.JSONType<>jtString then
+    begin
+    AddMessage(aSchema, aKeyword, vmtWarning, Format(SNotStringData, [aJSON.AsJSON, aKeyword.AsString]), CurrentPath);
+    exit(False);
+    end;
+  sCheck:=aJSON.AsString;
+  case aKeyword of
+    jskMinLength :
+      begin
+      Ok:=Length(sCheck)>=aSchema.Validations.MinLength;
+      sCond:=IntToStr(aSchema.Validations.MinLength);
+      end;
+    jskMaxLength :
+      begin
+      Ok:=Length(sCheck)<=aSchema.Validations.MaxLength;
+      sCond:=IntToStr(aSchema.Validations.MaxLength);
+      end;
+    jskPattern:
+      begin
+      sCond:=aSchema.Validations.Pattern;
+      Rex:=TRegExpr.Create(sCond);
+      try
+        Ok:=Rex.Exec(sCheck);
+      finally
+        Rex.Free;
+      end;
+      end;
+    jskFormat:
+      begin
+      OK:=CheckFormat(aSchema,sCheck,aSchema.Validations.FormatValidator);
+      end;
+    jskContentEncoding,
+    jskContentMediaType,
+    jskContentSchema:
+       info(aSchema,aKeyword,Format(SNotImplementedInValidator,[ClassName]));
+  end;
+  if not OK then
+    AddMessage(aSchema, aKeyword, vmtError, Format(SViolatesStringCondition, [sCheck, aKeyword.AsString, sCond]));
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.CheckNumerical(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+var
+  OK : Boolean;
+  Tmp,TValue,CondValue : double;
+begin
+  if aJSON.JSONType<>jtNumber then
+    begin
+    AddMessage(aSchema, aKeyword, vmtWarning, Format(SNotNumericalData, [aJSON.AsJSON, aKeyword.AsString]), CurrentPath);
+    exit(False);
+    end;
+  TValue:=aJSON.AsFloat;
+  case aKeyword of
+    jskMultipleOf :
+       begin
+       CondValue:=aschema.Validations.MultipleOf;
+       Tmp:=TValue/CondValue;
+       OK:=Frac(Tmp)<Epsilon;
+       end;
+    jskMaximum :
+       begin
+       CondValue:=aschema.Validations.Maximum;
+       OK:=(TValue<=CondValue);
+       end;
+    jskExclusiveMaximum :
+      begin
+      CondValue:=aschema.Validations.ExclusiveMaximum;
+      OK:=(CondValue-TValue)>FEpsilon;
+      end;
+    jskMinimum :
+      begin
+      CondValue:=aschema.Validations.Minimum;
+      OK:=(TValue>=CondValue);
+      end;
+    jskExclusiveMinimum :
+      begin
+      CondValue:=aschema.Validations.ExclusiveMinimum;
+      OK:=(TValue-CondValue)>FEpsilon;
+      end;
+  end;
+  if not OK then
+    AddMessage(aSchema, aKeyword, vmtError, Format(SViolatesNumericalCondition, [TValue, aKeyword.AsString, condValue]));
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.CheckArrayUniqueItems(Arr : TJSONArray) : Integer;
+// Return index of element that does not correspond.
+
+var
+  S : TJSONStringType;
+  HT : TFPStringHashTable;
+  I,aCount : Integer;
+
+begin
+  Result:=-1;
+  aCount:=Arr.Count;
+  if aCount<2 then
+    exit;
+  HT:=TFPStringHashTable.Create;
+  try
+    I:=0;
+    While (Result=-1) and (I<aCount) do
+      begin
+      S:=Arr.Items[I].AsJSON;
+      if HT.Items[S]='' then
+        HT.Add(S,'Present')
+      else
+        Result:=I;
+      Inc(I);
+      end;
+  finally
+    HT.Free;
+  end;
+end;
+
+function TJSONSchemaValidator.GetArrayContainsCount(Arr : TJSONArray; aContains : TJSONSchema) : Integer;
+
+var
+  M : TValidationMessageList;
+  I : Integer;
+
+begin
+  if ((Arr=FLastArr) and (aContains=FLastContains)) then
+    Exit(FLastContainsCount);
+  FLastArr:=Arr;
+  FLastContains:=aContains;
+  FLastContainsCount:=0;
+  M:=SaveMessages;
+  try
+    For I:=0 to Arr.Count-1 do
+      begin
+      DoValidateJSON(Arr[i],aContains);
+      if (Messages.ErrorCount=0) then
+        inc(FLastContainsCount);
+      Messages.Clear;
+      end;
+  finally
+    RestoreMessages(M);
+  end;
+  Result:=FLastContainsCount;
+end;
+
+
+function TJSONSchemaValidator.GetMissingObjectProperties(Obj : TJSONObject; aList : TStrings) : String;
+
+var
+  N : String;
+
+begin
+  Result:='';
+  For N in aList do
+    if Obj.IndexOfName(N)=-1 then
+      begin
+      if (Result<>'') then
+        Result:=Result+',';
+      Result:=Result+N;
+      end;
+end;
+
+function TJSONSchemaValidator.CheckObjectproperty(Obj : TJSONObject; aIndex : Integer; aSchema :TJSONSchema) : Boolean;
+
+var
+  aCount : Integer;
+
+begin
+  aCount:=Messages.Count;
+  PushPath(Obj.Names[aIndex]);
+  ValidateJSON(Obj.Items[aIndex],aSchema);
+  Result:=Messages.ErrorCount(aCount)=0;
+  PopPath;
+end;
+
+function TJSONSchemaValidator.CheckObjectProperties(Obj : TJSONObject; aProperties: TJSONSchemaList) : Boolean;
+
+var
+  I,Idx : Integer;
+
+begin
+  Result:=True;
+  for I:=0 to aProperties.Count-1 do
+    begin
+    Idx:=Obj.IndexOfName(aProperties[I].Name);
+    if Idx<>-1 then
+      Result:=CheckObjectproperty(Obj,Idx,aProperties[i]) and Result;
+    end;
+end;
+
+procedure TJSONSchemaValidator.CollectObjectProperties(Obj : TJSONObject; aProperties: TJSONSchemaList; aList : TStrings);
+
+var
+  I,Idx : integer;
+
+begin
+  For I:=0 to aProperties.Count-1 do
+    begin
+    Idx:=Obj.IndexOfName(aProperties[I].Name);
+    if Idx<>-1 then
+      aList.Add(Obj.Names[Idx]);
+    end;
+end;
+
+procedure TJSONSchemaValidator.CollectPatternProperties(Obj : TJSONObject; aProperties: TJSONSchemaList; aList : TStrings);
+
+var
+  I,Idx : integer;
+  Rex : TRegExpr;
+
+begin
+  For I:=0 to aProperties.Count-1 do
+    begin
+    Rex:=TRegExpr.Create(aProperties[i].Name);
+    try
+      for Idx:=0 to Obj.Count-1 do
+        begin
+        if Rex.Exec(Obj.Names[Idx]) then
+          aList.AddObject(Obj.Names[Idx],Obj.Items[Idx]);
+        end;
+    finally
+      Rex.Free;
+    end;
+    end;
+end;
+
+function TJSONSchemaValidator.CheckObjectAdditionalProperties(Obj : TJSONObject; aSchema : TJSONSchema) : Boolean;
+
+var
+  List : TStringList;
+  lSchema : TJSONSchema;
+  I : Integer;
+
+begin
+  Result:=True;
+  lSchema:=aSchema.AdditionalProperties;
+  if (lSchema=Nil) or (lSchema.MatchType=smAny) then
+    exit;
+  List:=TstringList.Create;
+  try
+    CollectObjectProperties(Obj,aSchema.Properties,List);
+    CollectPatternProperties(Obj,aSchema.PatternProperties,List);
+    for I:=0 to Obj.Count-1 do
+      if List.IndexOf(Obj.Names[I])<>-1 then
+        Result:=ValidateJSON(Obj.Items[i],lSchema) and Result
+  finally
+    List.Free;
+  end;
+end;
+
+function TJSONSchemaValidator.CheckObjectPatternProperties(Obj : TJSONObject; aProperties: TJSONSchemaList) : Boolean;
+
+var
+  I,Idx : Integer;
+  Rex : TRegexpr;
+
+begin
+  Result:=True;
+  For I:=0 to aProperties.Count-1 do
+    begin
+    Rex:=TRegExpr.Create(aProperties[i].Name);
+    try
+      for Idx:=0 to Obj.Count-1 do
+        begin
+          if Rex.Exec(Obj.Names[Idx]) then
+            Result:=CheckObjectproperty(Obj,Idx,aProperties[i]) and Result;
+          end;
+      finally
+        Rex.Free;
+      end;
+    end;
+end;
+
+function TJSONSchemaValidator.CheckObjectDependentRequired(Obj: TJSONObject; aSchema: TJSONSchema) : Boolean;
+
+var
+  I : Integer;
+  D : TSchemaDependentRequired;
+  Itm : TJSONData;
+  N : String;
+
+
+begin
+  Result:=True;
+  if (aSchema.Validations.DependentRequired.Count=0) then exit;
+  For I:=0 to aSchema.Validations.DependentRequired.Count-1 do
+    begin
+    D:=aSchema.Validations.DependentRequired[I];
+    Itm:=Obj.Find(D.Name);
+    if Assigned(Itm) then
+      begin
+      PushPath(D.Name);
+      For N in D.Required do
+        if Obj.IndexOfName(N)=-1 then
+          begin
+          Result:=False;
+          AddMessage(aSchema,jskDependentRequired, vmtError,Format(SErrMissingRequiredDependent,[N]));
+          end;
+      PopPath;
+      end;
+    end;
+end;
+
+function TJSONSchemaValidator.CheckObjectDependentSchemas(Obj: TJSONObject; aList: TJSONSchemaList): Boolean;
+
+var
+  I,Current : Integer;
+  S : TJSONSchema;
+  Itm : TJSONData;
+
+begin
+  Result:=True;
+  if (aList.Count=0) then exit;
+  For I:=0 to aList.Count-1 do
+    begin
+    S:=aList[I];
+    if S.Name<>'' then
+      begin
+      Itm:=Obj.Find(S.Name);
+      if Assigned(Itm) then
+        begin
+        PushPath(S.Name);
+        Current:=Messages.Count;
+        DoValidateJSON(Itm,S);
+        if Messages.ErrorCount(Current)>0 then
+          Result:=False;
+        PopPath;
+        end;
+      end;
+    end;
+end;
+
+function TJSONSchemaValidator.CheckObjectPropertyNames(Obj: TJSONObject; aSchema: TJSONSchema): Boolean;
+
+var
+  J : TJSONString;
+  I : Integer;
+
+begin
+  Result:=True;
+  if aSchema.MatchType=smAny then exit;
+  J:=TJSONString.Create('');
+  Try
+    For I:=0 to Obj.Count-1 do
+      begin
+      J.AsString:=Obj.names[I];
+      PushPath(Obj.names[I]);
+      ValidateJSON(J,aSchema);
+      PopPath;
+      end;
+  finally
+    J.Free;
+  end;
+end;
+
+
+function TJSONSchemaValidator.CheckObject(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+var
+  ShowError,OK : Boolean;
+  Obj : TJSONObject absolute aJSON;
+  sValue,sCond : String;
+
+begin
+  if aJSON.JSONType<>jtObject then
+    begin
+    AddMessage(aSchema, aKeyword, vmtWarning, Format(SNotArrayData, [aJSON.AsJSON, aKeyword.AsString]), CurrentPath);
+    exit(False);
+    end;
+  ShowError:=True;
+  case aKeyword of
+    jskMaxProperties:
+      begin
+      ok:=aJSON.Count<=aSchema.Validations.MaxProperties;
+      if not OK then
+        begin
+        sValue:=IntToStr(aJSON.Count);
+        sCond:=IntToStr(aSchema.Validations.MaxProperties);
+        end;
+      end;
+    jskMinProperties:
+      begin
+      ok:=aJSON.Count>=aSchema.Validations.MinProperties;
+      if not OK then
+        begin
+        sValue:=IntToStr(aJSON.Count);
+        sCond:=IntToStr(aSchema.Validations.MinProperties);
+        end;
+      end;
+    jskRequired:
+      begin
+      SValue:=GetMissingObjectProperties(Obj,aSchema.Validations.Required);
+      OK:=sValue='';
+      if not OK then
+        sCond:=aSchema.Validations.Required.CommaText;
+      end;
+    jskAdditionalProperties:
+      begin
+      OK:=CheckObjectAdditionalProperties(Obj,aSchema);
+      ShowError:=False;
+      end;
+    jskPropertyNames:
+      begin
+      OK:=CheckObjectPropertyNames(Obj,aSchema.PropertyNames);
+      ShowError:=False;
+      end;
+    jskPatternProperties:
+      begin
+      OK:=CheckObjectPatternProperties(Obj,aSchema.PatternProperties);
+      ShowError:=False;
+      end;
+    jskProperties:
+       begin
+       CheckObjectProperties(Obj,aSchema.Properties);
+       ShowError:=False;
+       end;
+    jskDependentRequired :
+      begin
+      CheckObjectDependentRequired(Obj,aSchema);
+      ShowError:=False;
+      end;
+    jskDependentSchemas:
+      begin
+      CheckObjectDependentSchemas(Obj,aSchema.DependentSchemas);
+      ShowError:=False;
+      end;
+    jskUnevaluatedProperties:
+      // Todo
+      ;
+  end;
+  if ShowError and not OK then
+    AddMessage(aSchema,aKeyword,vmtError,Format(SViolatesObjectCondition,[sValue,aKeyword.AsString,sCond]));
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.CheckArrayItems(Arr : TJSONArray; aStart : Integer; aItems : TJSONSchemaList) : Integer;
+// Return index of element that does not correspond to schema.
+var
+  M : TValidationMessageList;
+  I,aCount : Integer;
+  aSchema: TJSONSchema;
+
+begin
+  Result:=-1;
+  if aItems.Count<1 then exit;
+  aSchema:=aItems[0];
+  aCount:=Arr.Count;
+  M:=SaveMessages;
+  try
+    I:=aStart;
+    While (Result=-1) and (I<aCount) do
+      begin
+      Messages.Clear;
+      DoValidateJSON(Arr[i],aSchema);
+      if (Messages.ErrorCount>0) then
+        Result:=I;
+      inc(I);
+      end;
+    M.AddMessages(Messages);
+  finally
+    RestoreMessages(M);
+  end;
+end;
+
+function TJSONSchemaValidator.CheckArrayPrefixItems(Arr : TJSONArray; aItems : TJSONSchemaList) : Integer;
+// Return index of first element that does not correspond to schema in aItems.
+var
+  M : TValidationMessageList;
+  I,aCount : Integer;
+
+begin
+  // if there are less items than in prefix count, this is OK.
+  aCount:=aItems.Count;
+  if aCount>Arr.Count then
+    aCount:=Arr.Count;
+  Result:=-1;
+  M:=SaveMessages;
+  try
+    I:=0;
+    While (Result=-1) and (I<aCount) do
+      begin
+      Messages.Clear;
+      PushPath(IntToStr(I));
+      DoValidateJSON(Arr[i],aItems[I]);
+      if (Messages.ErrorCount>0) then
+        Result:=I;
+      Inc(I);
+      PopPath;
+      end;
+    M.AddMessages(Messages);
+  finally
+    RestoreMessages(M);
+  end;
+end;
+
+function TJSONSchemaValidator.CheckArray(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+var
+  OK : Boolean;
+  Arr : TJSONArray absolute aJSON;
+  sCond,sValue : String;
+  aStartAt,aCount : Integer;
+
+begin
+  if aJSON.JSONType<>jtArray then
+    begin
+    AddMessage(aSchema, aKeyword, vmtWarning, Format(SNotArrayData, [aJSON.AsJSON, aKeyword.AsString]), CurrentPath);
+    exit(False);
+    end;
+  OK:=true;
+  case aKeyword of
+  jskUniqueItems :
+    begin
+    if aSchema.Validations.UniqueItems then
+      begin
+      aCount:=CheckArrayUniqueItems(arr);
+      OK:=(aCount=-1);
+      if Not OK then
+        begin
+        sCond:='';
+        sValue:=Format('%d',[aCount]);
+        end;
+      end;
+    end;
+  jskMaxItems :
+    begin
+    aCount:=aSchema.Validations.MaxItems;
+    OK:=Arr.Count<=aCount;
+    if not OK then
+      begin
+      sCond:=IntToStr(aCount);
+      sValue:=IntToStr(Arr.Count);
+      end;
+    end;
+  jskMinItems :
+    begin
+    aCount:=aSchema.Validations.MinItems;
+    OK:=Arr.Count>=aCount;
+    if not OK then
+      begin
+      sCond:=IntToStr(aCount);
+      sValue:=IntToStr(Arr.Count);
+      end;
+    end;
+  jskContains:
+    begin
+    aCount:=GetArrayContainsCount(Arr,aSchema.Contains);
+    if (aCount=0) then
+      begin
+      OK:=(aSchema.HasKeywordData(jskMinContains) and
+          (aSchema.Validations.MinContains=0));
+      if not OK then
+        begin
+        sCond:='';
+        sValue:='0';
+        end;
+      end;
+    end;
+  jskMaxContains :
+    if aSchema.HasKeywordData(jskContains) then
+      begin
+      aCount:=GetArrayContainsCount(Arr,aSchema.Contains);
+      OK:=aCount<=aSchema.Validations.MaxContains;
+      if not Ok then
+        begin
+        sCond:=IntToStr(aSchema.Validations.MaxContains);
+        sValue:=IntToStr(aCount);
+        end;
+      end;
+  jskMinContains :
+    if aSchema.HasKeywordData(jskContains) then
+      begin
+      aCount:=GetArrayContainsCount(Arr,aSchema.Contains);
+      OK:=aCount>=aSchema.Validations.MinContains;
+      if not Ok then
+        begin
+        sCond:=IntToStr(aSchema.Validations.MinContains);
+        sValue:=IntToStr(aCount);
+        end;
+      end;
+  jskItems:
+     begin
+     if aSchema.HasKeywordData(jskPrefixItems) then
+       aStartAt:=aSchema.PrefixItems.Count
+     else
+       aStartAt:=0;
+     aCount:=CheckArrayItems(Arr,aStartAt,aSchema.Items);
+     OK:=aCount=-1;
+     if Not OK then
+       begin
+       sCond:='<Items list>';
+       sValue:=Format('Item %d',[aCount]);
+       end;
+     end;
+  jskPrefixItems:
+     begin
+     acount:=CheckArrayPrefixItems(Arr,aSchema.PrefixItems);
+     OK:=aCount=-1;
+     if Not OK then
+       begin
+       sCond:='<Items list>';
+       sValue:=Format('Item %d',[aCount]);
+       end;
+     end;
+  jskUnevaluatedItems:
+    // Todo
+    ;
+  end;
+  if not OK then
+    AddMessage(aSchema, aKeyword,vmtError, Format(SViolatesArrayCondition, [sValue, aKeyword.AsString,sCond]));
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.CheckNot(aJSON : TJSONData; aNotSchema : TJSONSchema) : Boolean;
+
+var
+  M : TValidationMessageList;
+
+begin
+  M:=SaveMessages;
+  try
+    DoValidateJSON(aJSON,aNotSchema);
+    Result:=Messages.ErrorCount>0;
+  finally
+    RestoreMessages(M);
+  end;
+  if not Result then
+    AddMessage(aNotSchema,jskNot,vmtError,SErrSchemaMatchesNot)
+end;
+
+function TJSONSchemaValidator.CheckIf(aJSON: TJSONData; aSchema: TJSONSchema): Boolean;
+var
+  M : TValidationMessageList;
+  CondSchema : TJSONSchema;
+  IfOK : Boolean;
+
+
+begin
+  Result:=True;
+  // Exit if no conditon
+  if not Assigned(aSchema.IfSchema) then
+    exit;
+  // Exit if no conditions
+  if not (Assigned(aSchema.ThenSchema) or Assigned(aSchema.ThenSchema)) then
+    exit;
+  M:=SaveMessages;
+  try
+    DoValidateJSON(aJSON,aSchema.IfSchema);
+    IfOK:=Messages.ErrorCount=0;
+    Info(aSchema.IfSchema,jskIf,Format(SIfResult,[aSchema.IfSchema.Path,BoolToStr(IfOK,'True','False')]));
+    Messages.Clear;
+    if IfOK then
+      CondSchema:=aSchema.ThenSchema
+    else
+      CondSchema:=aSchema.ElseSchema;
+    if Assigned(CondSchema) then
+      begin
+      DoValidateJSON(aJSON,condSchema);
+      Result:=Messages.ErrorCount=0;
+      end;
+    if not Result then
+      M.AddMessages(Messages);
+  finally
+    RestoreMessages(M);
+  end;
+end;
+
+function TJSONSchemaValidator.CheckInList(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+
+var
+  aList : TJSONSchemaList;
+  i,aCount : Integer;
+  M : TValidationMessageList;
+
+begin
+  Result:=True;
+  aList:=Nil;
+  Case aKeyword of
+    jskAnyOf : aList:=aSchema.AnyOf;
+    jskAllOf : aList:=aSchema.AllOf;
+    jskOneOf : aList:=aSchema.OneOf;
+  end;
+  if (Not Assigned(aList)) or (aList.Count=0) then
+    Exit;
+  M:=SaveMessages;
+  try
+    aCount:=0;
+    for I:=0 to aList.Count-1 do
+      begin
+      Messages.Clear;
+      DoValidateJSON(aJSON,AList[i]);
+      if Messages.ErrorCount=0 then
+        Inc(aCount);
+      end;
+    Case aKeyword of
+      jskAnyOf : Result:=(aCount>0);
+      jskAllOf : Result:=(aCount=aList.Count);
+      jskOneOf : Result:=(aCount=1);
+    end
+  finally
+    RestoreMessages(M);
+  end;
+  if not Result then
+    AddMessage(aSchema,aKeyword,vmtError,Format(SErrListCountMismatch,[aKeyword.AsString,aCount,aList.Count]));
+end;
+
+function TJSONSchemaValidator.EqualData(aData1,aData2 : TJSONData) : Boolean;
+
+begin
+  Result:=aData1.asJSON=aData2.AsJSON;
+end;
+
+function TJSONSchemaValidator.CheckConst(aJSON: TJSONData; aSchema : TJSONSchema) : Boolean;
+
+var
+  aData : TJSONData;
+
+begin
+  Result:=True;
+  aData:=aSchema.Validations.constValue;
+  if not assigned(aData) then exit;
+  Result:=EqualData(aJSON,aData);
+  if not Result then
+    AddMessage(aSchema,jskConst,vmtError,Format(SErrNotEqual,[aData.AsJSON]));
+end;
+
+function TJSONSchemaValidator.CheckEnum(aJSON: TJSONData; aSchema: TJSONSchema; aList: TJSONArray): Boolean;
+var
+  I,aCount : Integer;
+
+begin
+  aCount:=aList.Count;
+  if aCount=0 then
+    exit;
+  Result:=False;
+  I:=0;
+  While (Not Result) and (I<aCount) do
+    begin
+    Result:=EqualData(aJSON,aList[i]);
+    Inc(I);
+    end;
+  if not Result then
+    AddMessage(aSchema,jskConst,vmtError,Format(SErrNotInList,[aList.AsJSON]));
+end;
+
+function TJSONSchemaValidator.CheckKeyword(aJSON: TJSONData; aSchema: TJSONSchema; aKeyword: TJSONSchemaKeyword): Boolean;
+var
+  OK : Boolean;
+
+begin
+  OK:=True;
+  Case aKeyword of
+    jskUnknown : ;
+    jskId : Info(aSchema,jskID,aSchema.Id);
+    jskAnchor : Info(aSchema,jskAnchor,aSchema.Anchor);
+    jskIdDraft4 : Info(aSchema,jskID,aSchema.Id);
+    jskSchema : Info(aSchema,jskID,aSchema.Schema);
+    jskTitle : Info(aSchema,jskTitle,aSchema.Metadata.Title);
+    jskDescription : Info(aSchema,jskDescription,aSchema.MetaData.Description);
+    jskType : CheckType(aJSON,aSchema);
+    jskRef: Info(aSchema,jskRef,aSchema.Ref);
+    jskDynamicRef : Info(aSchema,jskRef,aSchema.DynamicRef);
+    jskDynamicAnchor : Info(aSchema,jskRef,aSchema.DynamicAnchor);
+    jskComment : Info(aSchema,jskComment,aSchema.Comment);
+    jskVocabulary : Info(aSchema,jskComment,aSchema.Vocabulary.ToString);
+    jskReadOnly : Info(aSchema,jskReadOnly,BoolToStr(aSchema.MetaData.ReadOnly,'True','False'));
+    jskWriteOnly : Info(aSchema,jskWriteOnly,BoolToStr(aSchema.MetaData.WriteOnly,'True','False'));
+    jskExamples : Info(aSchema,jskExamples,IntToStr(aSchema.Metadata.Examples.Count));
+    jskDeprecated : Info(aSchema,jskDeprecated,BoolToStr(aSchema.MetaData.Deprecated,'True','False'));
+    jskConst : CheckConst(aJSON,aSchema);
+    jskDefinitions,
+    jskDefs : Info(aSchema,jskDefs,IntToStr(aSchema.Defs.Count));
+    jskDefault : Info(aSchema,jskDefault,'Yes');
+    jskMultipleOf,
+    jskMaximum,
+    jskExclusiveMaximum,
+    jskMinimum,
+    jskExclusiveMinimum : Ok:=CheckNumerical(aJSON,aSchema,aKeyWord);
+    jskMaxLength,
+    jskMinLength,
+    jskFormat,
+    jskPattern,
+    jskContentEncoding,
+    jskContentMediaType,
+    jskContentSchema : Ok:=CheckString(aJSON,aSchema,aKeyWord);
+    jskContains,
+    jskUniqueItems,
+    jskMaxItems,
+    jskMinItems,
+    jskMaxContains,
+    jskMinContains,
+    jskItems,
+    jskPrefixItems : Ok:=CheckArray(aJSON,aSchema,aKeyWord);
+    jskDependentRequired,
+    jskDependentSchemas,
+    jskMaxProperties,
+    jskMinProperties,
+    jskRequired,
+    jskAdditionalProperties,
+    jskPropertyNames,
+    jskPatternProperties,
+    jskUnevaluatedProperties,
+    jskProperties : Ok:=CheckObject(aJSON,aSchema,aKeyWord);
+    jskEnum : OK:=CheckEnum(aJSON,aSchema,aSchema.Validations.Enum);
+    jskAllOf,
+    jskAnyOf,
+    jskOneOf : OK:=CheckInList(aJSON,aSchema,aKeyword);
+    jskNot : OK:=CheckNot(aJSON,aSchema.NotSchema);
+    jskIf : OK:=CheckIf(aJSON,aSchema);
+    jskThen,
+    jskElse : ;
+
+    jskAdditionalItems: //Old
+      ;
+  end;
+  Result:=OK;
+end;
+
+function TJSONSchemaValidator.AddMessage(aSchema: TJSONSchema; aKeyword : TJSONSchemaKeyword; aType: TValidationMessageType; const aMessage: String; const aPath : TJSONStringType): TValidationMessage;
+
+begin
+  Result:=Messages.AddMessage(aSchema,aKeyword,aType,aMessage,aPath);
+end;
+
+function TJSONSchemaValidator.AddMessage(aSchema: TJSONSchema; aKeyword : TJSONSchemaKeyword; aType: TValidationMessageType; const aMessage: String): TValidationMessage;
+begin
+  Result:=AddMessage(aSchema,aKeyword, aType,aMessage,CurrentPath);
+end;
+
+procedure TJSONSchemaValidator.DoValidateJSON(aJSON: TJSONData; aSchema: TJSONSchema);
+
+var
+  aKeyword : TJSONSchemaKeyWord;
+  lSchema : TJSONSchema;
+
+begin
+  // If no schema, any data matches
+  if (aSchema=Nil) then
+    exit;
+  lSchema:=ResolveSchema(aSchema);
+  // If no schema, cannot go further
+  if (lSchema=Nil) then
+    exit;
+  case aSchema.MatchType of
+    smAny : ;
+    smNone : AddMessage(lSchema,jskUnknown,vmtError,SErrNoFalseMatch);
+    smConstrained :
+      begin
+      for akeyword in TJSonSchemaKeyword do
+        if lSchema.HasKeywordData(aKeyword) then
+          CheckKeyword(aJSON,aSchema,aKeyword);
+      CleanUpValidation;
+      end;
+ end;
+end;
+
+procedure TJSONSchemaValidator.CleanUpValidation;
+
+begin
+  FLastArr:=Nil;
+  FLastContains:=Nil;
+end;
+
+constructor TJSONSchemaValidator.Create(aOwner: TComponent);
+begin
+  inherited Create(aOwner);
+  FMessages:=CreateMessageList;
+  FEpsilon:=1E-14;
+  FMessageTypes:=[Low(TValidationMessageType)..High(TValidationMessageType)];
+end;
+
+destructor TJSONSchemaValidator.Destroy;
+begin
+  FreeAndNil(FMessages);
+  inherited Destroy;
+end;
+
+procedure TJSONSchemaValidator.Reset;
+begin
+  FPathCount:=0;
+  SetLength(FPath,0);
+  FMessages.Clear;
+end;
+
+function TJSONSchemaValidator.ValidateJSON(aJSON: TJSONData; aSchema: TJSONSchema): Boolean;
+begin
+  FMessages.Clear;
+  DoValidateJSON(aJSON,aSchema);
+  Result:=FMessages.ErrorCount=0;
+end;
+
+end.
+

packages/fcl-jsonschema/src/fpjson.schema.writer.pp

@@ -0,0 +1,676 @@
+{
+    This file is part of the Free Component Library
+
+    JSON Schema - Write as JSON or to stream
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit FpJson.Schema.Writer;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  {$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.SysUtils, FpJson.Data, FpJson.Schema.Types, FpJson.Schema.Schema;
+  {$ELSE}
+  Classes, SysUtils, fpjson, FpJson.Schema.Types, FpJson.Schema.Schema;
+  {$ENDIF}
+
+Type
+  EJSONSchemaWriter = class(EJSONSchema);
+
+  { TJSONSchemaWriter }
+
+  TJSONSchemaWriter = class(TComponent)
+  private
+  Protected
+    Procedure WriteProperty(const aName : TJSONStringType);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : Boolean);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : Integer);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : Int64);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : Double);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : String);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TJSONSchema);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TJSONSchemaList);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TStrings);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TJSONData);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TSchemaDependentRequiredList);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TJSONSchemaVocabularyList);
+    Procedure WriteProperty(const aName : TJSONStringType; aValue : TSchemaSimpleTypes);
+    procedure WriteValue(aValue: TJSONData);
+    procedure WriteValue(aValue: TStrings);
+    // Override in descendants
+    Procedure WriteValue(); virtual; abstract;
+    Procedure WriteValue(aValue : Boolean); virtual; abstract;
+    Procedure WriteValue(aValue : Integer); virtual; abstract;
+    Procedure WriteValue(aValue : Int64); virtual; abstract;
+    Procedure WriteValue(aValue : Double); virtual; abstract;
+    Procedure WriteValue(const aValue : String); virtual; abstract;
+    Procedure StartProperty(const aName: string); virtual; abstract;
+    Procedure EndProperty; virtual; abstract;
+    Procedure StartArray; virtual; abstract;
+    Procedure EndArray; virtual; abstract;
+    Procedure NextElement; virtual; abstract;
+    Procedure StartObject; virtual; abstract;
+    Procedure EndObject; virtual; abstract;
+    Procedure DoWriteSchema(aSchema : TJSONSchema);
+  end;
+
+  { TJSONSchemaWriterJSON }
+
+  TJSONSchemaWriterJSON = class(TJSONSchemaWriter)
+  Private
+    FStack : Array of TJSONData;
+    FCount : Integer;
+    FPropertyName : String;
+  protected
+    function CurrentStruct : TJSONData;
+    Procedure PushData(Obj : TJSONData);
+    Procedure PopData;
+    procedure EndArray; override;
+    procedure EndObject; override;
+    procedure EndProperty; override;
+    procedure NextElement; override;
+    procedure StartArray; override;
+    procedure StartObject; override;
+    procedure StartProperty(const aName: string); override;
+    procedure WriteValue(aValue: Boolean); override;
+    procedure WriteValue(aValue: Double); override;
+    procedure WriteValue(aValue: Int64); override;
+    procedure WriteValue(aValue: Integer); override;
+    procedure WriteValue(const aValue: String); override;
+    procedure WriteValue; override;
+  Public
+    function WriteSchema(aSchema : TJSONSchema) : TJSONData;
+  end;
+
+  { TJSONSchemaWriterStream }
+
+  TJSONSchemaWriterStream = class(TJSONSchemaWriter)
+  private
+    FStream: TStream;
+    FCounts : Array of Integer;
+    FLen : Integer;
+    FStrictStrings: Boolean;
+  Protected
+    Procedure PushElCount;
+    Procedure PopElCount;
+    Procedure IncElCount;
+    Function ElCount : Integer;
+    procedure WriteString(const aString : TJSONStringType);
+    Procedure WriteValue(); override;
+    Procedure WriteValue(aValue : Boolean); override;
+    Procedure WriteValue(aValue : Integer); override;
+    Procedure WriteValue(aValue : Int64); override;
+    Procedure WriteValue(aValue : Double); override;
+    Procedure WriteValue(const aValue : String); override;
+    Procedure StartProperty(const aName: string); override;
+    Procedure EndProperty; override;
+    Procedure StartArray; override;
+    Procedure EndArray; override;
+    Procedure NextElement; override;
+    Procedure StartObject; override;
+    Procedure EndObject; override;
+    Property Stream : TStream Read FStream;
+  Public
+    procedure WriteSchema(aSchema : TJSONSchema; aStream : TStream);
+    property StrictStrings : Boolean Read FStrictStrings Write FStrictStrings;
+  end;
+
+implementation
+
+uses FpJson.Schema.Consts;
+
+{ TJSONSchemaWriter }
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType);
+begin
+  WriteValue(aName);
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: Boolean);
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: Integer);
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: Int64);
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: Double);
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: String);
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TJSONSchema);
+begin
+ case aValue.MatchType of
+   smNone,smAny : WriteProperty(aName,aValue.MatchType=smAny);
+ else
+   begin
+   StartProperty(aName);
+   DoWriteSchema(aValue);
+   EndProperty;
+   end;
+ end;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TJSONSchemaList);
+
+var
+  I : Integer;
+
+begin
+  StartProperty(aName);
+  StartArray;
+  for I:=0 to aValue.Count-1 do
+    begin
+    NextElement;
+    DoWriteSchema(aValue.Schemas[i]);
+    end;
+  EndArray;
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteValue(aValue: TStrings);
+
+var
+  S : String;
+
+begin
+  StartArray;
+  For S in aValue do
+    begin
+    NextElement;
+    WriteValue(S);
+    end;
+  EndArray;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TStrings);
+
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TJSONData);
+
+begin
+  StartProperty(aName);
+  WriteValue(aValue);
+  EndProperty();
+end;
+
+procedure TJSONSchemaWriter.WriteValue(aValue: TJSONData);
+
+var
+  Enum : TJSONEnum;
+
+begin
+  Case aValue.JSONType of
+    jtNull : WriteValue();
+    jtBoolean : WriteValue(aValue.AsBoolean);
+    jtString : WriteValue(aValue.AsString);
+    jtNumber :
+      case TJSONNumber(aValue).NumberType of
+       ntInteger : WriteValue(aValue.AsInteger);
+       ntInt64 : WriteValue(aValue.AsInt64);
+       ntFloat : WriteValue(aValue.AsFloat);
+       ntQword : WriteValue(aValue.AsInt64);
+      end;
+    jtObject :
+      begin
+      StartObject;
+      For Enum in aValue do
+        WriteProperty(Enum.Key,enum.Value);
+      EndObject;
+      end;
+    jtArray :
+      begin
+      StartArray;
+      For Enum in aValue do
+        begin
+        NextElement;
+        WriteValue(Enum.Value);
+        end;
+      EndArray;
+      end;
+  end;
+
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TSchemaDependentRequiredList);
+var
+  I : Integer;
+  D : TSchemaDependentRequired;
+
+begin
+  if aValue.Count=0 then
+    exit;
+  StartProperty(aName);
+  StartObject;
+  For I:=0 to aValue.Count-1 do
+    begin
+    D:=aValue[I];
+    StartProperty(D.Name);
+    WriteValue(D.Required);
+    EndProperty;
+    end;
+  EndObject;
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TJSONSchemaVocabularyList);
+
+var
+  I : Integer;
+  V : TJSONSchemaVocabulary;
+
+begin
+  if aValue.Count=0 then
+    exit;
+  StartProperty(aName);
+  StartObject;
+  For I:=0 to aValue.Count-1 do
+    begin
+    V:=aValue[I];
+    StartProperty(V.URL);
+    WriteValue(V.Enabled);
+    EndProperty;
+    end;
+  EndObject;
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.WriteProperty(const aName: TJSONStringType; aValue: TSchemaSimpleTypes);
+
+var
+  St : TSchemaSimpleType;
+
+begin
+  StartProperty(aName);
+  StartArray;
+  For ST in aValue do
+    begin
+    NextElement;
+    WriteValue(ST.AsString);
+    end;
+  EndArray;
+  EndProperty;
+end;
+
+procedure TJSONSchemaWriter.DoWriteSchema(aSchema: TJSONSchema);
+
+var
+  aKeyword : TJSONSchemaKeyword;
+  PropName : TJSONStringType;
+
+begin
+  if (aSchema.MatchType in [smAny,smNone]) then
+    WriteValue(aSchema.MatchType=smAny)
+  else
+    begin
+    StartObject;
+    For aKeyword in TJSONSchemaKeyword do
+      if aSchema.HasKeywordData(aKeyWord) then
+        begin
+        PropName:=aKeyword.AsString;
+        Case aKeyword of
+        jskUnknown : ;
+        jskId : WriteProperty(PropName,aSchema.ID);
+        jskAnchor : WriteProperty(PropName,aSchema.Anchor);
+        jskSchema : WriteProperty(PropName,aSchema.Schema);
+        jskDefs : WriteProperty(PropName,aSchema.Defs);
+        jskTitle : WriteProperty(PropName,aSchema.Metadata.Title);
+        jskDescription : WriteProperty(PropName,aSchema.Metadata.Description);
+        jskDefault : WriteProperty(PropName,aSchema.MetaData.DefaultValue);
+        jskMultipleOf : WriteProperty(PropName,aSchema.Validations.MultipleOf);
+        jskMaximum : WriteProperty(PropName,aSchema.Validations.Maximum);
+        jskExclusiveMaximum : WriteProperty(PropName,aSchema.Validations.ExclusiveMaximum);
+        jskMinimum : WriteProperty(PropName,aSchema.Validations.Minimum);
+        jskExclusiveMinimum : WriteProperty(PropName,aSchema.Validations.ExclusiveMinimum);
+        jskMaxLength : WriteProperty(PropName,aSchema.Validations.MaxLength);
+        jskMinLength : WriteProperty(PropName,aSchema.Validations.MinLength);
+        jskPattern : WriteProperty(PropName,aSchema.Validations.Pattern);
+        // jskAdditionalItems : WriteProperty(PropName,aSchema.Validations.AdditionalItems);
+        jskItems : WriteProperty(PropName,aSchema.Items);
+        jskPrefixItems : WriteProperty(PropName,aSchema.PrefixItems);
+        jskMaxItems : WriteProperty(PropName,aSchema.Validations.MaxItems);
+        jskMinItems : WriteProperty(PropName,aSchema.Validations.MinItems);
+        jskUniqueItems : WriteProperty(PropName,aSchema.Validations.UniqueItems);
+        jskMaxProperties : WriteProperty(PropName,aSchema.Validations.MaxProperties);
+        jskMinProperties : WriteProperty(PropName,aSchema.Validations.MinProperties);
+        jskMaxContains : WriteProperty(PropName,aSchema.Validations.MaxContains);
+        jskMinContains : WriteProperty(PropName,aSchema.Validations.MinContains);
+        jskRequired : WriteProperty(PropName,aSchema.Validations.Required);
+        jskAdditionalProperties : WriteProperty(PropName,aSchema.AdditionalProperties);
+        jskProperties : WriteProperty(PropName,aSchema.Properties);
+        jskPatternProperties: WriteProperty(PropName,aSchema.PatternProperties);
+        jskPropertyNames : WriteProperty(PropName,aSchema.PropertyNames);
+        jskDependentSchemas : WriteProperty(PropName,aSchema.DependentSchemas);
+
+        jskDependentRequired : WriteProperty(PropName,aSchema.Validations.DependentRequired);
+        jskEnum: WriteProperty(PropName,aSchema.Validations.Enum);
+        jskType : WriteProperty(PropName,aSchema.Validations.Types);
+
+        jskAllOf : WriteProperty(PropName,aSchema.AllOf);
+        jskAnyOf : WriteProperty(PropName,aSchema.AnyOf);
+        jskOneOf : WriteProperty(PropName,aSchema.OneOf);
+        jskNot : WriteProperty(PropName,aSchema.NotSchema);
+        jskFormat  : WriteProperty(PropName,aSchema.Validations.Format);
+        jskRef : WriteProperty(PropName,aSchema.Ref);
+        jskIf : WriteProperty(PropName,aSchema.IfSchema);
+        jskElse : WriteProperty(PropName,aSchema.ElseSchema);
+        jskThen : WriteProperty(PropName,aSchema.ThenSchema);
+        jskDynamicRef : WriteProperty(PropName,aSchema.DynamicRef);
+        jskDynamicAnchor : WriteProperty(PropName,aSchema.DynamicAnchor);
+        jskContains : WriteProperty(PropName,aSchema.Contains);
+        jskComment : WriteProperty(PropName,aSchema.Comment);
+        jskConst : WriteProperty(PropName,aSchema.Validations.constValue);
+        jskUnevaluatedItems : WriteProperty(PropName,aSchema.UnevaluatedItems);
+        jskUnevaluatedProperties : WriteProperty(PropName,aSchema.UnevaluatedProperties);
+        jskContentEncoding : WriteProperty(PropName,aSchema.Validations.contentEncoding);
+        jskContentMediaType : WriteProperty(PropName,aSchema.Validations.contentMediaType);
+        jskContentSchema : WriteProperty(PropName,aSchema.Validations.contentSchema);
+        jskExamples : WriteProperty(PropName,aSchema.Metadata.Examples);
+        jskDeprecated : WriteProperty(PropName,aSchema.Metadata.Deprecated);
+        jskReadOnly : WriteProperty(PropName,aSchema.Metadata.ReadOnly);
+        jskWriteOnly : WriteProperty(PropName,aSchema.Metadata.WriteOnly);
+        jskVocabulary : WriteProperty(PropName,aSchema.Vocabulary);
+        end;
+        end;
+    EndObject;
+    end;
+end;
+
+{ TJSONSchemaWriterJSON }
+
+function TJSONSchemaWriterJSON.CurrentStruct: TJSONData;
+begin
+  Result:=Nil;
+  if FCount>0 then
+    begin
+    Result:=FStack[FCount-1];
+    if not (Result.JSONType in StructuredJSONTypes) then
+      Result:=Nil;
+    end;
+end;
+
+procedure TJSONSchemaWriterJSON.PushData(Obj: TJSONData);
+
+var
+  D : TJSONData;
+  O : TJSONObject absolute D;
+  A : TJSONArray absolute D;
+  AddToStack : Boolean;
+
+begin
+  AddToStack:=(Obj.JSONType in StructuredJSONTypes) or (FCount=0);
+  D:=CurrentStruct;
+  if (D=Nil) then
+    begin
+    if (FCount>0) then
+      Raise EJSONSchemaWriter.Create(SErrNoPushOnSimpleValue);
+    end
+  else
+    Case D.JSONType of
+    jtObject:
+      begin
+      if FPropertyName = '' then
+        Raise EJSONSchemaWriter.Create(SErrNoPropertyNameForPush);
+      O.Add(FPropertyName,Obj);
+      FPropertyName:='';
+      end;
+    jtArray:
+      begin
+      A.Add(Obj);
+      FPropertyName:='';
+      end;
+    end;
+  if AddToStack then
+    begin
+    if FCount=Length(FStack) then
+      SetLength(FStack,FCount+10);
+    FStack[FCount]:=Obj;
+    Inc(FCount);
+    end;
+end;
+
+procedure TJSONSchemaWriterJSON.PopData;
+begin
+ if FCount=0 then
+   Raise EJSONSchemaWriter.Create(SErrCannotPop);
+ Dec(FCount);
+end;
+
+procedure TJSONSchemaWriterJSON.EndArray;
+begin
+  PopData;
+end;
+
+procedure TJSONSchemaWriterJSON.EndObject;
+begin
+  PopData;
+end;
+
+procedure TJSONSchemaWriterJSON.EndProperty;
+begin
+  If CurrentStruct=Nil then
+    Raise EJSONSchemaWriter.Create(SErrNotAtStructuredValue);
+end;
+
+procedure TJSONSchemaWriterJSON.NextElement;
+begin
+  If CurrentStruct=Nil then
+    Raise EJSONSchemaWriter.Create(SErrNotAtStructuredValue);
+end;
+
+procedure TJSONSchemaWriterJSON.StartArray;
+begin
+  PushData(TJSONArray.Create);
+end;
+
+procedure TJSONSchemaWriterJSON.StartObject;
+begin
+  PushData(TJSONObject.Create);
+end;
+
+procedure TJSONSchemaWriterJSON.StartProperty(const aName: string);
+begin
+  if FPropertyName<>'' then
+    Raise EJSONSchemaWriter.CreateFmt(SPropertyNameAlreadySet,[aName,FPropertyName]);
+  FPropertyName:=aName;
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue(aValue: Boolean);
+begin
+  PushData(TJSONBoolean.Create(aValue));
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue(aValue: Double);
+begin
+  PushData(TJSONFloatNumber.Create(aValue));
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue(aValue: Int64);
+begin
+  PushData(TJSONInt64Number.Create(aValue));
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue(aValue: Integer);
+begin
+  PushData(TJSONIntegerNumber.Create(aValue));
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue(const aValue: String);
+begin
+  PushData(TJSONString.Create(aValue));
+end;
+
+procedure TJSONSchemaWriterJSON.WriteValue;
+begin
+  PushData(TJSONNull.Create);
+end;
+
+function TJSONSchemaWriterJSON.WriteSchema(aSchema: TJSONSchema): TJSONData;
+begin
+  DoWriteSchema(aSchema);
+  if (Length(FStack)=0) or Not Assigned(FStack[0]) then
+    Raise EJSONSchemaWriter.Create(SErrNoObjectsOnStack);
+  Result:=FStack[0];
+end;
+
+{ TJSONSchemaWriterStream }
+
+procedure TJSONSchemaWriterStream.WriteSchema(aSchema: TJSONSchema; aStream: TStream);
+begin
+  FStream:=aStream;
+  DoWriteSchema(aSchema);
+end;
+
+procedure TJSONSchemaWriterStream.PushElCount;
+begin
+  if FLen=Length(FCounts) then
+    SetLength(FCounts,FLen+10);
+  FCounts[FLen]:=0;
+  Inc(Flen);
+end;
+
+procedure TJSONSchemaWriterStream.PopElCount;
+begin
+  if FLen>0 then
+    Dec(FLen);
+end;
+
+procedure TJSONSchemaWriterStream.IncElCount;
+begin
+  if Flen>0 then
+    Inc(FCounts[FLen-1]);
+end;
+
+function TJSONSchemaWriterStream.ElCount: Integer;
+begin
+  Result:=FCounts[FLen-1];
+end;
+
+procedure TJSONSchemaWriterStream.WriteString(const aString: TJSONStringType);
+begin
+  if Length(aString)>0 then
+    FStream.WriteBuffer(aString[1],Length(aString))
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue();
+begin
+  WriteString('null');
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue(aValue: Boolean);
+begin
+  WriteString(BoolToStr(aValue,'true','false'));
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue(aValue: Integer);
+begin
+  WriteString(IntToStr(aValue));
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue(aValue: Int64);
+begin
+  WriteString(IntToStr(aValue));
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue(aValue: Double);
+
+var
+  s : String;
+begin
+  Str(aValue,s);
+  WriteString(S);
+end;
+
+procedure TJSONSchemaWriterStream.WriteValue(const aValue: String);
+
+begin
+  WriteString('"'+StringToJSONString(aValue,StrictStrings)+'"');
+end;
+
+procedure TJSONSchemaWriterStream.StartProperty(const aName: string);
+begin
+  if ElCount>0 then
+    NextElement;
+  WriteString('"'+StringToJSONString(aName,StrictStrings)+'":');
+  IncElCount;
+end;
+
+procedure TJSONSchemaWriterStream.EndProperty;
+begin
+  // Nothing
+end;
+
+procedure TJSONSchemaWriterStream.StartArray;
+begin
+  WriteString('[');
+  PushElCount;
+end;
+
+procedure TJSONSchemaWriterStream.EndArray;
+begin
+  PopElCount;
+  WriteString(']');
+end;
+
+procedure TJSONSchemaWriterStream.NextElement;
+begin
+  if ElCount>0 then
+    WriteString(',');
+  IncElCount;
+end;
+
+
+procedure TJSONSchemaWriterStream.StartObject;
+begin
+  WriteString('{');
+  PushElCount;
+end;
+
+procedure TJSONSchemaWriterStream.EndObject;
+begin
+  WriteString('}');
+  PopElCount;
+end;
+
+end.
+

packages/fcl-jsonschema/tests/fpjson.schema.testutils.pp

@@ -0,0 +1,166 @@
+unit fpjson.schema.testutils;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, contnrs,fpcunit, fpjson, fpjson.schema.types;
+
+type
+
+  { TTestDef }
+
+  TTestDef = Class(TObject)
+  private
+    FFileName : String;
+    FDescription: string;
+    FSchema: TJSONData;
+  Public
+    constructor create (const aDescription : String; aSchema : TJSONData);
+    destructor Destroy; override;
+    Property FileName : String Read FFileName Write FFileName;
+    Property Description : string read FDescription;
+    Property Schema : TJSONData Read FSchema;
+  end;
+
+  { TTestDefs }
+
+  TTestDefs = Class(TFPObjectList)
+  private
+    function GetDef(aIndex : Integer): TTestDef;
+  Public
+    Property Defs[aIndex : Integer] : TTestDef Read GetDef; default;
+  end;
+
+  TSchemaTestCase = class(TTestCase)
+  Public
+    class Procedure AssertEquals(aMsg : String; aExpected,aActual : TJSONSchemaKeyword); overload;
+    class Procedure AssertEquals(aMsg : String; aExpected,aActual : TJSONSubSchema); overload;
+    class Procedure AssertEquals(aMsg : String; aExpected,aActual : TStringFormatValidator); overload;
+    class Procedure AssertEquals(aMsg : String; aExpected,aActual : TSchemaSimpleType); overload;
+  end;
+
+Function ExtractTestsFromStream(aStream : TStream; aList : TTestDefs; const aFileName : string = '') : Integer;
+Function ExtractTestsFromFile(const aFileName : String; aList : TTestDefs) : Integer;
+
+implementation
+
+uses typinfo;
+
+function GetTestDef(aObj : TJSONObject) : TTestDef;
+
+var
+  Descr : String;
+  Schema : TJSONData;
+
+begin
+  Descr:=aObj.Get('description','');
+  Schema:=aObj.Extract('schema');
+  if Schema<>Nil then
+    Result:=TTestDef.Create(Descr,Schema);
+end;
+
+function ExtractTestsFromStream(aStream: TStream; aList: TTestDefs; const aFileName : string = ''): Integer;
+
+var
+  D : TJSONData;
+  Enum : TJSONEnum;
+  O : TJSONObject absolute D;
+  A : TJSONArray absolute D;
+  Def : TTestDef;
+
+begin
+  Result:=0;
+  D:=GetJSON(aStream);
+  try
+    if D is TJSONArray then
+      For Enum in A do
+        if Enum.Value is TJSONObject then
+          begin
+          Def:=GetTestDef(TJSONObject(Enum.Value));
+          if Assigned(Def) then
+            begin
+            Def.FileName:=aFileName;
+            inc(Result);
+             aList.Add(Def);
+            end;
+          end;
+    if D is TJSONObject then
+      begin
+      Def:=GetTestDef(O);
+      if Assigned(Def) then
+        begin
+        inc(Result);
+        Def.FileName:=aFileName;
+        aList.Add(Def);
+        end;
+      end;
+  finally
+    D.Free;
+  end;
+end;
+
+function ExtractTestsFromFile(const aFileName : String; aList: TTestDefs): Integer;
+
+var
+  F : TFileStream;
+
+begin
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    Result:=ExtractTestsFromStream(F,aList,aFileName);
+  finally
+    F.Free;
+  end;
+end;
+
+{ TTestDef }
+
+constructor TTestDef.create(const aDescription: String; aSchema: TJSONData);
+begin
+  FDescription:=aDescription;
+  FSchema:=aSchema;
+end;
+
+destructor TTestDef.Destroy;
+begin
+  FreeAndNil(FSchema);
+  inherited Destroy;
+end;
+
+{ TTestDefs }
+
+function TTestDefs.GetDef(aIndex : Integer): TTestDef;
+begin
+  Result:=Items[aIndex] as TTestDef;
+end;
+
+{ TSchemaTestCase }
+
+class procedure TSchemaTestCase.AssertEquals(aMsg: String; aExpected, aActual: TJSONSchemaKeyword);
+begin
+  AssertEquals(aMsg,GetEnumName(TypeInfo(TJSONSchemaKeyword),Ord(aExpected)),
+                    GetEnumName(TypeInfo(TJSONSchemaKeyword),Ord(aActual)));
+end;
+
+class procedure TSchemaTestCase.AssertEquals(aMsg: String; aExpected, aActual: TJSONSubSchema);
+begin
+  AssertEquals(aMsg,GetEnumName(TypeInfo(TJSONSubSchema),Ord(aExpected)),
+                    GetEnumName(TypeInfo(TJSONSubSchema),Ord(aActual)));
+end;
+
+class procedure TSchemaTestCase.AssertEquals(aMsg: String; aExpected, aActual: TStringFormatValidator);
+begin
+  AssertEquals(aMsg,GetEnumName(TypeInfo(TStringFormatValidator),Ord(aExpected)),
+                    GetEnumName(TypeInfo(TStringFormatValidator),Ord(aActual)));
+end;
+
+class procedure TSchemaTestCase.AssertEquals(aMsg: String; aExpected, aActual: TSchemaSimpleType);
+begin
+  AssertEquals(aMsg,GetEnumName(TypeInfo(TSchemaSimpleType),Ord(aExpected)),
+                    GetEnumName(TypeInfo(TSchemaSimpleType),Ord(aActual)));
+end;
+
+end.
+

packages/fcl-jsonschema/tests/testschema.lpi

@@ -0,0 +1,127 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <MainUnitHasScaledStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="testschema"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <BuildModes>
+      <Item Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages>
+      <Item>
+        <PackageName Value="LCL"/>
+      </Item>
+    </RequiredPackages>
+    <Units>
+      <Unit>
+        <Filename Value="testschema.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.schema.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Schema"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.consts.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Consts"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.reader.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Reader"/>
+      </Unit>
+      <Unit>
+        <Filename Value="fpjson.schema.testutils.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utOfficialTests.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.loader.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Loader"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.types.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Types"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utSchemaTypes.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utSchema.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.writer.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Writer"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utSchemaWriter.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.validator.pp"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="FpJson.Schema.Validator"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utSchemaValidator.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="testschema"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <OtherUnitFiles Value="../src"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions>
+      <Item>
+        <Name Value="EAbort"/>
+      </Item>
+      <Item>
+        <Name Value="ECodetoolError"/>
+      </Item>
+      <Item>
+        <Name Value="EFOpenError"/>
+      </Item>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

packages/fcl-jsonschema/tests/testschema.lpr

@@ -0,0 +1,61 @@
+{
+    This file is part of the Free Component Library
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    JSONSchema fpcunit tester program
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{$h+}
+program testschema;
+
+uses
+  {$ifdef unix}
+  cwstring,
+  {$endif}
+  SysUtils, Classes, jsonparser, consoletestrunner, fpjson.schema.schema, fpjson.schema.consts, fpjson.schema.reader,
+  fpjson.schema.loader, fpjson.schema.testutils, utOfficialTests, fpjson.schema.types, utSchemaTypes, utSchema,
+  fpjson.schema.writer, utSchemaWriter, fpjson.schema.validator, utSchemaValidator;
+
+type
+
+  { TMyTestRunner }
+
+  TMyTestRunner = Class(TTestRunner)
+    Constructor Create(aOwner : TComponent); override;
+  end;
+var
+  Application: TTestRunner;
+
+{ TMyTestRunner }
+
+constructor TMyTestRunner.Create(aOwner: TComponent);
+
+var
+  aDir: String;
+
+begin
+  inherited Create(aOwner);
+  Longopts.Add('testdir:');
+  aDir:=GetEnvironmentVariable('SCHEMATESTDIR');
+  if HasOption(#0,'testdir') then
+    aDir:=GetOptionValue(#0,'testdir');
+  if aDir<>'' then
+    RegisterTestFiles(aDir);
+end;
+
+begin
+  DefaultFormat := fPlain;
+  DefaultRunAllTests := True;
+  Application := TMyTestRunner.Create(nil);
+  Application.Initialize;
+  Application.Run;
+  Application.Free;
+end.

packages/fcl-jsonschema/tests/utOfficialTests.pp

@@ -0,0 +1,257 @@
+{
+    This file is part of the Free Component Library
+
+    Testsuite to load schema from official testsuite
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utOfficialTests;
+
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson.schema.testutils;
+
+Type
+  
+  { TSchemaFileTest }
+
+  TSchemaFileTest = class(TAssert)
+  Private
+    FIgnores: Boolean;
+    FTestDef: TTestDef;
+  protected
+    function GetTestName: string; override;
+    function GetTestSuiteName: string; override;
+    function GetEnableIgnores: boolean; override;
+    procedure SetEnableIgnores(Value: boolean); override;
+    procedure SetTestSuiteName(const aName: string); override;
+    procedure TestSchema; virtual; abstract;
+  Public
+    constructor Create(aTestDef : TTestDef);
+    function CountTestCases: integer; override;
+    procedure Run(AResult: TTestResult); override;
+    property TestDef : TTestDef Read FTestDef;
+  end;
+
+  TSchemaReaderFileTest = class(TSchemaFileTest)
+    procedure TestSchema; override;
+  end;
+
+  TSchemaLoaderFileTest = class(TSchemaFileTest)
+    procedure TestSchema; override;
+  end;
+
+
+  { TSchemaFileTests }
+
+  TSchemaFileTests = class(TTestSuite)
+  private
+    FList : TTestDefs;
+  Protected
+    procedure FindTestFiles(const aDir : String; aFiles : TStrings);
+    procedure AddAllTests(const aDir : string);
+    procedure DoAddTestDef(aTest : TTestDef); virtual; abstract;
+  Public
+    Constructor Create(const aTestDir : String); reintroduce;
+    destructor destroy; override;
+  end;
+
+  { TSchemaFileReaderTests }
+
+  TSchemaFileReaderTests = class(TSchemaFileTests)
+  protected
+    procedure DoAddTestDef(aTest : TTestDef); override;
+  end;
+
+  { TSchemaFileLoaderTests }
+
+  TSchemaFileLoaderTests = class(TSchemaFileTests)
+  protected
+    procedure DoAddTestDef(aTest : TTestDef); override;
+  end;
+
+
+Procedure RegisterTestFiles(const aDir : String);
+
+implementation
+
+uses fpjson.schema.loader,  fpjson.schema.reader, fpjson.schema.schema;
+
+procedure RegisterTestFiles(const aDir: String);
+begin
+  RegisterTest('Reader JSONSchema testsuite',TSchemaFileReaderTests.Create(aDir));
+  RegisterTest('Loader JSONSchema testsuite',TSchemaFileLoaderTests.Create(aDir));
+end;
+
+{ TSchemaFileTest }
+
+function TSchemaFileTest.CountTestCases: integer;
+begin
+  Result:=1;
+end;
+
+function TSchemaFileTest.GetTestName: string;
+begin
+  Result:=ChangeFileExt(ExtractFileName(FTestDef.FileName),'')+' : '+FTestDef.Description;
+end;
+
+function TSchemaFileTest.GetTestSuiteName: string;
+begin
+  Result:='';
+end;
+
+function TSchemaFileTest.GetEnableIgnores: boolean;
+begin
+  Result:=FIgnores;
+end;
+
+procedure TSchemaFileTest.SetEnableIgnores(Value: boolean);
+begin
+  FIgnores:=Value
+end;
+
+procedure TSchemaFileTest.SetTestSuiteName(const aName: string);
+begin
+  // Do nothing
+end;
+
+Procedure DoRun(aTest: TTest; aResult: TTestResult);
+
+begin
+  TSchemaFileTest(aTest).TestSchema;
+end;
+
+procedure TSchemaFileTest.Run(AResult: TTestResult);
+begin
+  aResult.StartTest(Self);
+  AResult.RunProtected(Self,@DoRun);
+  aResult.EndTest(Self);
+end;
+
+constructor TSchemaFileTest.Create(aTestDef: TTestDef);
+begin
+  FTestDef:=aTestDef;
+end;
+
+{ TSchemaFileTests }
+
+
+procedure TSchemaFileTests.FindTestFiles(const aDir: String; aFiles: TStrings);
+
+var
+  Info : TSearchRec;
+  D : String;
+
+begin
+  D:=IncludeTrailingPathDelimiter(aDir);
+  if FindFirst(D+'*.json',faNormal,Info)=0 then
+    try
+      Repeat
+        aFiles.Add(D+Info.Name);
+      until FindNext(Info)<>0;
+    finally
+      FindClose(Info);
+    end;
+end;
+
+procedure TSchemaReaderFileTest.TestSchema;
+
+var
+  S : TJSONSchema;
+  Reader : TJsonSchemaReader;
+
+begin
+  Reader:=Nil;
+  S:=TJSONSchema.Create;
+  try
+    Reader:=TJSONSChemaReader.Create(Nil);
+    Reader.ReadFromString(S,TestDef.Schema.AsJSON);
+  finally
+    S.Free;
+    Reader.Free;
+  end;
+end;
+
+procedure TSchemaLoaderFileTest.TestSchema;
+
+var
+  S : TJSONSchema;
+  Loader : TJsonSchemaLoader;
+
+begin
+  Loader:=Nil;
+  S:=TJSONSchema.Create;
+  try
+    Loader:=TJSONSChemaLoader.Create(Nil);
+    Loader.ReadFromJSON(S,TestDef.Schema);
+  finally
+    S.Free;
+    Loader.Free;
+  end;
+end;
+
+
+procedure TSchemaFileTests.AddAllTests(const aDir: string);
+Var
+  aFile : String;
+  aFiles : TStrings;
+  i : integer;
+
+begin
+  if aDir='' then
+    Ignore('No test dir specified');
+  aFiles:=TStringList.Create;
+  try
+    FindTestFiles(aDir,aFiles);
+    FList.Clear;
+    for aFile in aFiles do
+      ExtractTestsFromFile(aFile,FList);
+    For I:=0 to FList.Count-1 do
+      DoAddTestDef(FList[I]);
+
+  finally
+    aFiles.Free;
+  end;
+end;
+
+constructor TSchemaFileTests.Create(const aTestDir: String);
+begin
+  Inherited Create();
+  FList:=TTestDefs.Create(True);
+  AddAllTests(aTestDir);
+end;
+
+destructor TSchemaFileTests.destroy;
+begin
+  FreeAndNil(FList);
+  inherited destroy;
+end;
+
+{ TSchemaFileReaderTests }
+
+procedure TSchemaFileReaderTests.DoAddTestDef(aTest: TTestDef);
+begin
+  AddTest(TSchemaReaderFileTest.Create(aTest));
+end;
+
+{ TSchemaFileLoaderTests }
+
+procedure TSchemaFileLoaderTests.DoAddTestDef(aTest: TTestDef);
+begin
+  AddTest(TSchemaLoaderFileTest.Create(aTest));
+end;
+
+end.
+

packages/fcl-jsonschema/tests/utSchema.pp

@@ -0,0 +1,953 @@
+{
+    This file is part of the Free Component Library
+
+    Testsuite for JSONSchema class
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utSchema;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, fpjson.schema.types, fpjson.schema.schema,
+  fpjson.schema.testutils;
+
+type
+
+  { TTestSchemaObject }
+
+  TTestSchemaObject = class(TSchemaTestcase)
+  private
+    FSchema: TJSONSchema;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Property Schema : TJSONSchema Read FSchema;
+  end;
+
+  TTestJSONSchemaMetadata = class(TJSONSchemaMetadata)
+  Public
+    Property AVailableKeywords : TJSONSchemaKeywords Read Keywords;
+  end;
+
+  { TTestMetadata }
+
+  TTestMetadata = class(TTestSchemaObject)
+  private
+    FData: TJSONSchemaMetadata;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure TestHavekeyword(aKeyword : TJSONSchemaKeyword);
+    property Data : TJSONSchemaMetadata Read FData;
+  Published
+    Procedure TestHookup;
+    Procedure TestTitle;
+    Procedure TestKeywords;
+    Procedure TestDescription;
+    Procedure TestDefaultValue;
+    Procedure TestDeprecated;
+    Procedure TestExamples;
+    Procedure TestReadOnly;
+    Procedure TestWriteOnly;
+    Procedure TestAssign;
+  end;
+
+  { TTestSchemaValidations }
+
+  TTestSchemaValidations = class(TTestSchemaObject)
+  private
+    FData: TJSONSchemaValidations;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure TestHavekeyword(aKeyword : TJSONSchemaKeyword);
+    property Data : TJSONSchemaValidations Read FData;
+  Published
+    Procedure TestHookup;
+    Procedure TestTypes;
+    Procedure TestconstValue;
+    Procedure TestEnum;
+    Procedure TestExclusiveMaximum;
+    Procedure TestExclusiveMinimum;
+    Procedure TestMaximum;
+    Procedure TestMinimum;
+    Procedure TestMaxItems;
+    Procedure TestMinItems;
+    Procedure TestRequired;
+    Procedure TestMaxLength;
+    Procedure TestMinLength;
+    Procedure TestMaxProperties;
+    Procedure TestMinProperties;
+    Procedure TestPattern;
+    Procedure TestUniqueItems;
+    Procedure TestMinContains;
+    Procedure TestMaxContains;
+    Procedure TestMultipleOf;
+    Procedure TestDependentRequired;
+    Procedure TestFormat;
+    Procedure TestFormatValidator;
+    Procedure TestcontentMediaType;
+    Procedure TestcontentEncoding;
+    Procedure TestcontentSchema;
+    Procedure TestAssign;
+  end;
+
+  TTestSchema = Class(TTestSchemaObject)
+  private
+    procedure CheckKeyword(aKeyword: TJSONSchemaKeyword);
+  Published
+    Procedure TestHookup;
+    Procedure TestCreateChildSchemaName;
+    Procedure TestCreateChildSchemaKeyword;
+    Procedure TestCreateChildSchemaNoName;
+    Procedure TestRootSchema;
+    Procedure TestFind;
+    Procedure TestIndexOfChild;
+    Procedure TestFindChild;
+    Procedure TestPath;
+    // Vocabulary
+    Procedure TestValidation;
+    Procedure TestMetaData;
+    Procedure TestID;
+    Procedure TestSchema;
+    Procedure TestRef;
+    Procedure TestComment;
+    Procedure TestAnchor;
+    Procedure TestDefs;
+    Procedure TestDynamicAnchor;
+    Procedure TestDynamicRef;
+    Procedure TestVocabulary;
+    Procedure TestAllof;
+    Procedure TestAnyOf;
+    Procedure TestOneOf;
+    Procedure TestNotSchema;
+    Procedure TestIfSchema;
+    Procedure TestThenSchema;
+    Procedure TestElseSchema;
+    Procedure TestProperties;
+    Procedure TestItems;
+    Procedure TestPrefixItems;
+    Procedure TestPatternProperties;
+    Procedure TestPropertyNames;
+    Procedure TestAdditionalProperties;
+    Procedure TestDependentSchemas;
+    Procedure TestContains;
+    Procedure TestUnevaluatedItems;
+    Procedure TestUnevaluatedProperties;
+  end;
+
+
+implementation
+
+{ TTestSchemaObject }
+
+procedure TTestSchemaObject.SetUp;
+begin
+  inherited SetUp;
+  FSchema:=TJSONSchema.Create;
+end;
+
+procedure TTestSchemaObject.TearDown;
+begin
+  FreeAndNil(FSchema);
+  inherited TearDown;
+end;
+
+{ TTestMetadata }
+
+procedure TTestMetadata.SetUp;
+begin
+  inherited SetUp;
+  FData:=TTestJSONSchemaMetadata.Create(Schema);
+end;
+
+procedure TTestMetadata.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestMetadata.TestHavekeyword(aKeyword: TJSONSchemaKeyword);
+begin
+  AssertTrue('Have '+aKeyword.AsString+' data',Data.HasKeywordData(aKeyword));
+  AssertTrue('Keywords',Data.KeywordsWithData=[aKeyWord]);
+  AssertTrue('Schema constrained',Data.Schema.MatchType=smConstrained);
+end;
+
+procedure TTestMetadata.TestHookup;
+
+var
+  T : TJSONSchemaKeyword;
+
+begin
+  AssertNotNull('Have data',Data);
+  AssertSame('Schema',Schema,Data.Schema);
+  For T in TJSONSchemaKeyword do
+    AssertFalse('No '+t.AsString+' data on init',Data.HasKeywordData(T));
+end;
+
+procedure TTestMetadata.TestTitle;
+begin
+  Data.Title:='Solo';
+  TestHavekeyword(jskTitle);
+  AssertTrue('Sets constrained',Schema.MatchType=smConstrained);
+end;
+
+procedure TTestMetadata.TestKeywords;
+
+const
+  KW = [jskTitle,jskDescription,jskDefault,jskDeprecated,
+        jskExamples,jskReadOnly,jskWriteOnly];
+begin
+  AssertTrue('Correct keyword list',Kw=TTestJSONSchemaMetadata(Data).AvailableKeywords)
+end;
+
+procedure TTestMetadata.TestDescription;
+begin
+  Data.Description:='Solo';
+  TestHavekeyword(jskDescription);
+end;
+
+procedure TTestMetadata.TestDefaultValue;
+begin
+  Data.DefaultValue:=TJSONIntegerNumber.Create(12);
+  TestHavekeyword(jskDefault);
+end;
+
+procedure TTestMetadata.TestDeprecated;
+begin
+  Data.Deprecated:=False;
+  TestHavekeyword(jskDeprecated);
+end;
+
+procedure TTestMetadata.TestExamples;
+begin
+  // Needs to be done manually, we do not detect changes to
+//  Schema.MatchType:=smConstrained;
+  Data.Examples:=TJSONArray.Create(['Example1']);
+  TestHavekeyword(jskExamples);
+end;
+
+procedure TTestMetadata.TestReadOnly;
+begin
+  Data.ReadOnly:=True;
+  TestHavekeyword(jskReadOnly);
+end;
+
+procedure TTestMetadata.TestWriteOnly;
+begin
+  Data.WriteOnly:=True;
+  TestHavekeyword(jskWriteOnly);
+end;
+
+procedure TTestMetadata.TestAssign;
+
+var
+  M : TJSONSchemaMetadata;
+
+begin
+  M:=TJSONSchemaMetadata.Create(Schema);
+  try
+    Data.Title:='Solo';
+    Data.Description:='Solo2';
+    Data.DefaultValue:=TJSONIntegerNumber.Create(12);
+    Data.Deprecated:=True;
+    Data.Examples.Add(TJSONString.Create('Example1'));
+    Data.ReadOnly:=True;
+    Data.WriteOnly:=True;
+    M.Assign(Data);
+
+    AssertEquals('Title',Data.Title,M.Title);
+    AssertEquals('Description',Data.Description,m.Description);
+    AssertEquals('Deprecated',Data.Deprecated,m.Deprecated);
+    AssertEquals('ReadOnly',Data.ReadOnly,m.ReadOnly);
+    AssertEquals('WriteOnly',Data.WriteOnly,m.WriteOnly);
+    AssertNotNull('Default copied',M.DefaultValue);
+    AssertEquals('Correct value',12,m.DefaultValue.AsInteger);
+    AssertEquals('Examples copied',Data.Examples.Count,M.Examples.Count);
+
+  finally
+    M.Free;
+  end;
+end;
+
+{ TTestSchemaValidations }
+
+procedure TTestSchemaValidations.SetUp;
+begin
+  inherited SetUp;
+  FData:=TJSONSchemaValidations.Create(Schema);
+end;
+
+procedure TTestSchemaValidations.TearDown;
+begin
+  FreeAndNil(FData);
+  inherited TearDown;
+end;
+
+procedure TTestSchemaValidations.TestHavekeyword(aKeyword: TJSONSchemaKeyword);
+begin
+  AssertTrue('Have '+aKeyword.AsString+' data',Data.HasKeywordData(aKeyword));
+  AssertTrue('Correct keywords ',Data.KeywordsWithData=[aKeyword]);
+  AssertTrue('Schema set to constrained',Schema.MatchType=smConstrained);
+end;
+
+procedure TTestSchemaValidations.TestHookup;
+var
+  T : TJSONSchemaKeyword;
+
+begin
+  AssertNotNull('Have data',Data);
+  AssertSame('Schema',Schema,Data.Schema);
+  For T in TJSONSchemaKeyword do
+    AssertFalse('No '+t.AsString+' data on init',Data.HasKeywordData(T));
+end;
+
+procedure TTestSchemaValidations.TestTypes;
+begin
+  Data.Types:=[sstObject,sstString];
+  TestHavekeyword(jskType);
+  AssertTrue('Sets constrained',Schema.MatchType=smConstrained);
+end;
+
+procedure TTestSchemaValidations.TestconstValue;
+begin
+  Data.ConstValue:=TJSONObject.Create(['me','you']);
+  TestHavekeyword(jskConst);
+end;
+
+procedure TTestSchemaValidations.TestEnum;
+begin
+  Data.Enum:=TJSONArray.Create([TJSONObject.Create(['me','you'])]);
+  TestHavekeyword(jskEnum);
+end;
+
+procedure TTestSchemaValidations.TestExclusiveMaximum;
+begin
+  Data.ExclusiveMaximum:=10.0;
+  TestHavekeyword(jskExclusiveMaximum);
+end;
+
+procedure TTestSchemaValidations.TestExclusiveMinimum;
+begin
+  Data.ExclusiveMinimum:=10.0;
+  TestHavekeyword(jskExclusiveMinimum);
+end;
+
+procedure TTestSchemaValidations.TestMaximum;
+begin
+  Data.Maximum:=10.0;
+  TestHavekeyword(jskMaximum);
+end;
+
+procedure TTestSchemaValidations.TestMinimum;
+begin
+  Data.Minimum:=10.0;
+  TestHavekeyword(jskMinimum);
+end;
+
+procedure TTestSchemaValidations.TestMaxItems;
+begin
+  Data.MaxItems:=10;
+  TestHavekeyword(jskMaxItems);
+end;
+
+procedure TTestSchemaValidations.TestMinItems;
+begin
+  Data.MaxItems:=13;
+  TestHavekeyword(jskMaxItems);
+end;
+
+procedure TTestSchemaValidations.TestRequired;
+begin
+  Data.Required.Add('type');
+  TestHavekeyword(jskRequired);
+end;
+
+procedure TTestSchemaValidations.TestMaxLength;
+begin
+  Data.MaxLength:=10;
+  TestHavekeyword(jskMaxLength);
+end;
+
+procedure TTestSchemaValidations.TestMinLength;
+begin
+  Data.MinLength:=10;
+  TestHavekeyword(jskMinLength);
+end;
+
+procedure TTestSchemaValidations.TestMaxProperties;
+begin
+  Data.MaxProperties:=10;
+  TestHavekeyword(jskMaxProperties);
+end;
+
+procedure TTestSchemaValidations.TestMinProperties;
+begin
+  Data.MinProperties:=10;
+  TestHavekeyword(jskMinProperties);
+end;
+
+procedure TTestSchemaValidations.TestPattern;
+begin
+  Data.MinProperties:=10;
+  TestHavekeyword(jskMinProperties);
+end;
+
+procedure TTestSchemaValidations.TestUniqueItems;
+begin
+  Data.UniqueItems:=True;
+  TestHavekeyword(jskUniqueItems);
+end;
+
+procedure TTestSchemaValidations.TestMinContains;
+begin
+  Data.MinContains:=10;
+  TestHavekeyword(jskMinContains);
+end;
+
+procedure TTestSchemaValidations.TestMaxContains;
+begin
+  Data.MaxContains:=10;
+  TestHavekeyword(jskMaxContains);
+end;
+
+procedure TTestSchemaValidations.TestMultipleOf;
+begin
+  Data.MultipleOf:=10.1;
+  TestHavekeyword(jskMultipleOf);
+end;
+
+procedure TTestSchemaValidations.TestDependentRequired;
+begin
+  Data.DependentRequired.AddDependent('xyz');
+  TestHavekeyword(jskDependentRequired);
+end;
+
+procedure TTestSchemaValidations.TestFormat;
+begin
+  Data.Format:='uri';
+  TestHavekeyword(jskFormat);
+end;
+
+procedure TTestSchemaValidations.TestFormatValidator;
+begin
+  Data.FormatValidator:=sfvUri;
+  TestHavekeyword(jskFormat);
+  AssertEquals('String','uri',Data.Format);
+end;
+
+procedure TTestSchemaValidations.TestcontentMediaType;
+begin
+  Data.contentMediaType:='application/json';
+  TestHavekeyword(jskContentMediaType);
+end;
+
+procedure TTestSchemaValidations.TestcontentEncoding;
+begin
+  Data.contentEncoding:='utf8';
+  TestHavekeyword(jskContentEncoding);
+end;
+
+procedure TTestSchemaValidations.TestcontentSchema;
+begin
+  Data.contentSchema.MatchType:=smAny;
+  TestHavekeyword(jskContentSchema);
+end;
+
+procedure TTestSchemaValidations.TestAssign;
+
+var
+  V : TJSONSchemaValidations;
+
+begin
+  Data.UniqueItems:=True;
+  Data.Types:=[sstObject];
+  Data.Required.Add('x');
+  Data.Pattern:='Pattern';
+  Data.MultipleOf:=10;
+  Data.MinProperties:=11;
+  Data.MinLength:=12;
+  Data.MinItems:=13;
+  Data.Minimum:=14;
+  Data.MinContains:=15;
+  Data.MaxProperties:=16;
+  Data.MaxLength:=17;
+  Data.MaxItems:=18;
+  Data.Maximum:=19;
+  Data.MaxContains:=20;
+  Data.Format:='uri';
+  Data.ExclusiveMinimum:=12;
+  Data.ExclusiveMaximum:=13;
+  Data.contentMediaType:='application/json';
+  Data.contentEncoding:='utf8';
+  Data.constValue:=TJSONBoolean.Create(True);
+  V:=TJSONSchemaValidations.Create(Schema);
+  try
+    V.Assign(data);
+    With Data do
+      begin
+      AssertEquals('UniqueItems',UniqueItems,V.UniqueItems);
+      AssertTrue('Types',Types=V.Types);
+      AssertEquals('Required',Required.Text,V.Required.Text);
+      AssertEquals('Pattern',Pattern,V.Pattern);
+      AssertEquals('MultipleOf',MultipleOf,V.MultipleOf);
+      AssertEquals('MinProperties',MinProperties,V.MinProperties);
+      AssertEquals('MinLength',MinLength,V.MinLength);
+      AssertEquals('MinItems',MinItems,V.MinItems);
+      AssertEquals('Minimum',Minimum,V.Minimum);
+      AssertEquals('MinContains',MinContains,V.MinContains);
+      AssertEquals('MaxProperties',MaxProperties,V.MaxProperties);
+      AssertEquals('MaxLength',MaxLength,V.MaxLength);
+      AssertEquals('MaxItems',MaxItems,V.MaxItems);
+      AssertEquals('Maximum',Maximum,V.Maximum);
+      AssertEquals('MaxContains',MaxContains,V.MaxContains);
+      AssertEquals('Format',Format,V.Format);
+      AssertEquals('ExclusiveMinimum',ExclusiveMinimum,V.ExclusiveMinimum);
+      AssertEquals('ExclusiveMaximum',ExclusiveMaximum,V.ExclusiveMaximum);
+      AssertEquals('contentMediaType',contentMediaType,V.contentMediaType);
+      AssertEquals('contentEncoding',contentEncoding,V.contentEncoding);
+      AssertEquals('constValue',constValue.asJSON,V.constValue.aSJSON);
+      end
+  finally
+    V.Free
+  end;
+end;
+
+procedure TTestSchema.TestHookup;
+
+var
+  K : TJSONSchemaKeyword;
+
+begin
+  AssertNotNull('Have schema',Schema);
+  AssertNotNull('Have metadata',Schema.MetaData);
+  AssertNotNull('Have validations',Schema.Validations);
+  for K in TJSONSchemaKeyword do
+    AssertFalse('No keyword '+K.AsString,Schema.HasKeywordData(k));
+  AssertSame('Metadata schema',Schema,Schema.Metadata.Schema);
+  AssertSame('Validations schema',Schema,Schema.Validations.Schema);
+  AssertEquals('No children',0,Schema.ChildSchemaCount);
+  AssertSame('root',Schema,Schema.RootSchema);
+end;
+
+procedure TTestSchema.TestCreateChildSchemaName;
+
+var
+  S : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema('ok');
+  try
+    AssertSame('Schema parent',schema,S.Parent);
+    AssertEquals('Name','ok',S.Name);
+    AssertEquals('Count',1,Schema.ChildSchemaCount);
+    AssertSame('Child',S,Schema.ChildSchemas[0]);
+  finally
+    S.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestCreateChildSchemaKeyword;
+var
+  S : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema(jskContentSchema);
+  try
+    AssertSame('Schema parent',schema,S.Parent);
+    AssertEquals('Name','contentSchema',S.Name);
+    AssertEquals('Count',1,Schema.ChildSchemaCount);
+    AssertSame('Child',S,Schema.ChildSchemas[0]);
+  finally
+    S.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestCreateChildSchemaNoName;
+var
+  S : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema();
+  try
+    AssertSame('Schema parent',schema,S.Parent);
+    AssertEquals('Name','',S.Name);
+    AssertEquals('Count',1,Schema.ChildSchemaCount);
+    AssertSame('Child',S,Schema.ChildSchemas[0]);
+  finally
+    S.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestRootSchema;
+
+var
+  S,S2 : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema();
+  try
+    AssertSame('Schema parent',schema,S.Parent);
+    AssertEquals('Name','',S.Name);
+    AssertEquals('Count 1',1,Schema.ChildSchemaCount);
+    AssertSame('Child ',S,Schema.ChildSchemas[0]);
+    S2:=S.CreateChildSchema();
+    AssertEquals('Count 1a',1,Schema.ChildSchemaCount);
+    AssertEquals('Count 2',1,S.ChildSchemaCount);
+    AssertSame('Child 2',S2,S.ChildSchemas[0]);
+    AssertSame('root',Schema,S2.RootSchema);
+  finally
+    S.Free;
+    S2.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestFind;
+
+  // Find schema using schema-local $Ref URI
+var
+  S,S2 : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema('x');
+  try
+    S2:=S.CreateChildSchema('y');
+    AssertSame('Find #/x/y',S2,Schema.Find('#/x/y'));
+  finally
+    S.Free;
+    S2.Free;
+  end;
+
+end;
+
+procedure TTestSchema.TestIndexOfChild;
+
+// Find index of direct child schema with given name
+var
+  S,S2 : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S2:=nil;
+  S:=Schema.CreateChildSchema('x');
+  try
+    S2:=Schema.CreateChildSchema('y');
+    AssertEquals('Count',2,Schema.ChildSchemaCount);
+    AssertEquals('Index',0,Schema.IndexOfChild('x'));
+    AssertEquals('Index',1,Schema.IndexOfChild('y'));
+  finally
+    S.Free;
+    S2.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestFindChild;
+
+  // Find direct child schema with given name
+  // function FindChild(const aName: String): TJSONSchema;
+var
+  S,S2 : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S2:=nil;
+  S:=Schema.CreateChildSchema('x');
+  try
+    S2:=Schema.CreateChildSchema('y');
+    AssertEquals('Count',2,Schema.ChildSchemaCount);
+    AssertSame('Index',S,Schema.FindChild('x'));
+    AssertSame('Index',S2,Schema.FindChild('y'));
+  finally
+    S.Free;
+    S2.Free;
+  end;
+  AssertEquals('Count',0,Schema.ChildSchemaCount);
+end;
+
+procedure TTestSchema.TestPath;
+  // Path till root schema.
+
+var
+  S,S2 : TJSONSchema;
+
+begin
+  // Create child schema with given name
+  // function CreateChildSchema(aName : string): TJsonSchema; overload;
+  S:=Schema.CreateChildSchema('x');
+  try
+    S2:=S.CreateChildSchema('y');
+    AssertEquals('Path','#/x/y',S2.Path);
+  finally
+    S.Free;
+    S2.Free;
+  end;
+end;
+
+procedure TTestSchema.TestValidation;
+begin
+  AssertNotNull('Have validation',Schema.Validations);
+  AssertSame('Schema correct',Schema,Schema.Validations.Schema);
+  Schema.Validations.Format:='uri';
+  AssertTrue('Keyword passes through',Schema.HasKeywordData(jskFormat));
+end;
+
+procedure TTestSchema.TestMetaData;
+begin
+  AssertNotNull('Have validation',Schema.Metadata);
+  AssertSame('Schema correct',Schema,Schema.Metadata.Schema);
+  Schema.Metadata.ReadOnly:=True;
+  AssertTrue('Keyword passes through',Schema.HasKeywordData(jskReadOnly));
+end;
+
+procedure TTestSchema.CheckKeyword(aKeyword : TJSONSchemaKeyword);
+
+begin
+  AssertTrue('Have Keyword '+aKeyword.AsString,Schema.HasKeywordData(aKeyword));
+  AssertTrue('Schema constrained',Schema.MatchType=smConstrained);
+end;
+
+
+procedure TTestSchema.TestID;
+begin
+  // ID of this schema
+  Schema.ID:='https://json-schema.org/draft/2020-12/schema';
+  CheckKeyword(jskID);
+end;
+
+procedure TTestSchema.TestSchema;
+begin
+  // Identifier of used JSON schema
+  Schema.Schema:='https://json-schema.org/draft/2020-12/schema';
+  CheckKeyword(jskSchema);
+end;
+
+procedure TTestSchema.TestRef;
+begin
+  // $ref
+  Schema.Ref:='#/solo';
+  CheckKeyword(jskRef);
+
+end;
+
+procedure TTestSchema.TestComment;
+begin
+  // $comment
+  Schema.Comment:=' A comment';
+  CheckKeyword(jskComment);
+
+end;
+
+procedure TTestSchema.TestAnchor;
+begin
+  // $anchor
+  Schema.anchor:='#/ref/two';
+  CheckKeyword(jskAnchor);
+
+end;
+
+procedure TTestSchema.TestDefs;
+begin
+  // $defs
+  // property Defs: TJSONSchemaList read FDefs;
+
+end;
+
+procedure TTestSchema.TestDynamicAnchor;
+begin
+  // $dynamicAnchor
+  Schema.DynamicAnchor:='#/ref/two';
+  CheckKeyword(jskDynamicAnchor);
+
+end;
+
+procedure TTestSchema.TestDynamicRef;
+begin
+  // $dynamicRef
+  Schema.DynamicRef:='#/ref/two';
+  CheckKeyword(jskDynamicRef);
+end;
+
+procedure TTestSchema.TestVocabulary;
+begin
+  // $vocabulary
+  Schema.Vocabulary.AddVocabulary('https://www.freepascal.org/').Enabled:=True;
+  CheckKeyword(jskVocabulary);
+  AssertEquals('Count',1,Schema.Vocabulary.Count);
+  AssertEquals('URL','https://www.freepascal.org/',Schema.Vocabulary[0].URL);
+  AssertEquals('Enabled',True,Schema.Vocabulary[0].Enabled);
+end;
+
+procedure TTestSchema.TestAllof;
+
+var
+  S1,S2 : TJSONSchema;
+begin
+  // allOf keyword
+  S1:=Schema.AllOf.Add('x');
+  CheckKeyword(jskAllOf);
+  S2:=Schema.AllOf.Add('y');
+  AssertEquals('Count',2,Schema.AllOf.Count);
+  AssertSame('Item 0',S1,Schema.AllOf[0]);
+  AssertSame('Item 1',S2,Schema.AllOf[1]);
+end;
+
+procedure TTestSchema.TestAnyOf;
+var
+  S1,S2 : TJSONSchema;
+begin
+  // anyOf keyword
+  S1:=Schema.AnyOf.Add('x');
+  CheckKeyword(jskAnyOf);
+  S2:=Schema.AnyOf.Add('y');
+  AssertEquals('Count',2,Schema.AnyOf.Count);
+  AssertSame('Item 0',S1,Schema.AnyOf[0]);
+  AssertSame('Item 1',S2,Schema.AnyOf[1]);
+end;
+
+procedure TTestSchema.TestOneOf;
+var
+  S1,S2 : TJSONSchema;
+begin
+  // oneOf keyword
+  S1:=Schema.OneOf.Add('x');
+  CheckKeyword(jskOneOf);
+  S2:=Schema.oneOf.Add('y');
+  AssertEquals('Count',2,Schema.OneOf.Count);
+  AssertSame('Item 0',S1,Schema.OneOf[0]);
+  AssertSame('Item 1',S2,Schema.OneOf[1]);
+end;
+
+procedure TTestSchema.TestNotSchema;
+begin
+  // not keyword
+  Schema.NotSchema.MatchType:=smAny;
+  CheckKeyword(jskNot);
+end;
+
+procedure TTestSchema.TestIfSchema;
+begin
+  // If keyword
+  Schema.IfSchema.MatchType:=smAny;
+  CheckKeyword(jskIf);
+end;
+
+procedure TTestSchema.TestThenSchema;
+begin
+  // then keyword
+  Schema.ThenSchema.MatchType:=smAny;
+  CheckKeyword(jskThen);
+
+end;
+
+procedure TTestSchema.TestElseSchema;
+begin
+  // else keyword
+  Schema.ElseSchema.MatchType:=smAny;
+  CheckKeyword(jskElse);
+end;
+
+procedure TTestSchema.TestProperties;
+begin
+  // properties keyword
+  // property Properties: TJsonSchemaList read FProperties;
+  Schema.Properties.Add('name');
+  CheckKeyword(jskProperties);
+end;
+
+procedure TTestSchema.TestItems;
+begin
+  // Declared in draft 2020-12 as schema, but we keep it a List, so we can handle earlier drafts.
+  Schema.Items.Add('name');
+  CheckKeyword(jskItems);
+end;
+
+procedure TTestSchema.TestPrefixItems;
+begin
+  // prefixItems keyword.
+  Schema.prefixItems.Add('name');
+  CheckKeyword(jskPrefixItems);
+end;
+
+procedure TTestSchema.TestPatternProperties;
+begin
+  // patternProperties keyword
+  Schema.PatternProperties.Add('ok').MatchType:=smAny;
+  CheckKeyword(jskPatternProperties);
+end;
+
+procedure TTestSchema.TestPropertyNames;
+begin
+  // propertyNames keyword
+  Schema.PropertyNames.MatchType:=smAny;
+  CheckKeyword(jskPropertyNames);
+end;
+
+procedure TTestSchema.TestAdditionalProperties;
+begin
+  // additionalProperties keyword
+  Schema.additionalProperties.MatchType:=smAny;
+  CheckKeyword(jskAdditionalProperties);
+end;
+
+procedure TTestSchema.TestDependentSchemas;
+begin
+  // dependentSchemas keyword
+  Schema.dependentSchemas.Add('name');
+  CheckKeyword(jskDependentSchemas);
+end;
+
+procedure TTestSchema.TestContains;
+begin
+  // contains keyword
+  Schema.PropertyNames.MatchType:=smAny;
+  CheckKeyword(jskPropertyNames);
+end;
+
+procedure TTestSchema.TestUnevaluatedItems;
+begin
+  // unevaluatedItems keyword
+  Schema.unevaluatedItems.MatchType:=smAny;
+  CheckKeyword(jskunevaluatedItems);
+end;
+
+procedure TTestSchema.TestUnevaluatedProperties;
+begin
+  // unevaluatedProperties keyword
+  Schema.unevaluatedProperties.MatchType:=smAny;
+  CheckKeyword(jskUnevaluatedProperties);
+end;
+
+initialization
+  RegisterTests([{TTestSchemaValue,}TTestMetadata,TTestSchemaValidations,TTestSchema]);
+end.
+

packages/fcl-jsonschema/tests/utSchemaTypes.pp

@@ -0,0 +1,224 @@
+{
+    This file is part of the Free Component Library
+
+    Testsuite for JSONSchema basic types
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utSchemaTypes;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson.schema.types, fpjson.schema.testutils;
+
+type
+
+  { TTestSimpleTypes }
+
+  TTestSimpleTypes = class(TSchemaTestcase)
+  Public
+  Published
+    Procedure TestSchemaKeywordToString;
+    Procedure TestJSONSubschemaToString;
+    Procedure TestStringFormatValidatorToString;
+    Procedure TestSchemaSimpleTypeToString;
+  end;
+
+
+
+implementation
+
+uses typinfo,fpjson.schema.consts;
+
+{ TTestSimpleTypes }
+
+
+procedure TTestSimpleTypes.TestSchemaKeywordToString;
+
+  Procedure TestAs(S : String; KW : TJSONSchemaKeyword);
+
+  var
+    tmp : TJSONSchemaKeyword;
+
+  begin
+    // kw -> string
+    tmp:=KW;
+    AssertEquals(S,S,tmp.AsString);
+    // string -> KW
+    tmp.AsString:=S;
+    AssertEquals(S,KW,tmp);
+  end;
+
+begin
+  TestAs('',jskUnknown);
+  TestAs('$id',jskId);
+  TestAs('$anchor',jskAnchor);
+  TestAs('id',jskIdDraft4);
+  TestAs('$schema',jskSchema);
+  TestAs('$defs',jskDefs);
+  TestAs('title',jskTitle);
+  TestAs('description',jskDescription);
+  TestAs('default',jskDefault);
+  TestAs('multipleOf',jskMultipleOf);
+  TestAs('maximum',jskMaximum);
+  TestAs('exclusiveMaximum',jskExclusiveMaximum);
+  TestAs('minimum',jskMinimum);
+  TestAs('exclusiveMinimum',jskExclusiveMinimum);
+  TestAs('maxLength',jskMaxLength);
+  TestAs('minLength',jskMinLength);
+  TestAs('pattern',jskPattern);
+  TestAs('additionalItems',jskAdditionalItems);
+  TestAs('items',jskItems);
+  TestAs('prefixItems',jskPrefixItems);
+  TestAs('maxItems',jskMaxItems);
+  TestAs('minItems',jskMinItems);
+  TestAs('uniqueItems',jskUniqueItems);
+  TestAs('maxProperties',jskMaxProperties);
+  TestAs('minProperties',jskMinProperties);
+  TestAs('maxContains',jskMaxContains);
+  TestAs('minContains',jskMinContains);
+  TestAs('required',jskRequired);
+  TestAs('additionalProperties',jskAdditionalProperties);
+  TestAs('definitions',jskDefinitions);
+  TestAs('properties',jskProperties);
+  TestAs('patternProperties',jskPatternProperties);
+  TestAs('propertyNames',jskPropertyNames);
+  TestAs('dependentSchemas',jskDependentSchemas);
+  TestAs('dependentRequired',jskDependentRequired);
+  TestAs('enum',jskEnum);
+  TestAs('type',jskType);
+  TestAs('allOf',jskAllOf);
+  TestAs('anyOf',jskAnyOf);
+  TestAs('oneOf',jskOneOf);
+  TestAs('not',jskNot);
+  TestAs('format',jskFormat);
+  TestAs('$ref',jskRef);
+  TestAs('if',jskIf);
+  TestAs('else',jskElse);
+  TestAs('then',jskThen);
+  TestAs('$dynamicRef',jskDynamicRef);
+  TestAs('$dynamicAnchor',jskDynamicAnchor);
+  TestAs('contains',jskContains);
+  TestAs('$comment',jskComment);
+  TestAs('const',jskConst);
+  TestAs('unevaluatedItems',jskUnevaluatedItems);
+  TestAs('unevaluatedProperties',jskUnevaluatedProperties);
+  TestAs('contentEncoding',jskContentEncoding);
+  TestAs('contentMediaType',jskContentMediaType);
+  TestAs('contentSchema',jskContentSchema);
+  TestAs('examples',jskExamples);
+  TestAs('deprecated',jskDeprecated);
+  TestAs('readOnly',jskReadOnly);
+  TestAs('writeOnly',jskWriteOnly);
+  TestAs('$vocabulary',jskVocabulary);
+end;
+
+procedure TTestSimpleTypes.TestJSONSubschemaToString;
+
+  Procedure TestAs(S : String; sst : TJSONSubschema);
+
+  var
+    tmp : TJSONSubschema;
+
+  begin
+    // subschema -> string
+    tmp:=sst;
+    AssertEquals(S,S,tmp.AsString);
+    // string -> subschema
+    tmp.AsString:=S;
+    AssertEquals(S,sst,tmp);
+  end;
+
+begin
+  TestAs('not',ssNot);
+  TestAs('if',ssIf);
+  TestAs('then',ssThen);
+  TestAs('else',ssElse);
+  TestAs('contains',ssContains);
+  TestAs('unevaluatedItems',ssUnevaluatedItems);
+  TestAs('unevaluatedProperties',ssUnevaluatedProperties);
+  TestAs('propertyNames',ssPropertyNames);
+end;
+
+procedure TTestSimpleTypes.TestStringFormatValidatorToString;
+
+  Procedure TestAs(S : String; sfv : TStringFormatValidator);
+
+  var
+    tmp : TStringFormatValidator;
+
+  begin
+    // validator -> string
+    tmp:=sfv;
+    AssertEquals(S,S,tmp.AsString);
+    // string -> validator
+    tmp.AsString:=S;
+    AssertEquals(S,sfv,tmp);
+  end;
+
+begin
+  TestAs('date-time',sfvDatetime);
+  TestAs('date',sfvDate);
+  TestAs('time',sfvTime);
+  TestAs('duration',sfvDuration);
+  TestAs('email',sfvEmail);
+  TestAs('idn-email',sfvIdnEmail);
+  TestAs('hostname',sfvHostname);
+  TestAs('idn-hostname',sfvIdnHostname);
+  TestAs('ipv4',sfvIPV4);
+  TestAs('ipv6',sfvIPV6);
+  TestAs('uri',sfvURI);
+  TestAs('uri-reference',sfvURIReference);
+  TestAs('iri',sfvIRI);
+  TestAs('iri-reference',sfvIRIReference);
+  TestAs('uuid',sfvUUID);
+  TestAs('uri-template',sfvURITemplate);
+  TestAs('json-pointer',sfvJSONPointer);
+  TestAs('relative-json-pointer',sfvRelativeJSONPointer);
+  TestAs('regex',sfvRegex);
+end;
+
+procedure TTestSimpleTypes.TestSchemaSimpleTypeToString;
+
+  Procedure TestAs(S : String; sst : TSchemaSimpleType);
+
+  var
+    tmp : TSchemaSimpleType;
+
+  begin
+    // simpletype -> string
+    tmp:=sst;
+    AssertEquals(S,S,tmp.AsString);
+    // string -> simpletype
+    tmp.AsString:=S;
+    AssertEquals(S,sst,tmp);
+  end;
+
+
+begin
+  TestAs('',sstNone);
+  TestAs('null',sstNull);
+  TestAs('boolean',sstBoolean);
+  TestAs('integer',sstInteger);
+  TestAs('number',sstNumber);
+  TestAs('string',sstString);
+  TestAs('array',sstArray);
+  TestAs('object',sstObject);
+  TestAs('any',sstAny);
+end;
+
+initialization
+  RegisterTest(TTestSimpleTypes);
+end.
+

packages/fcl-jsonschema/tests/utSchemaValidator.pp

@@ -0,0 +1,721 @@
+{
+    This file is part of the Free Component Library
+
+    Testsuite for JSONSchema validator
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utSchemaValidator;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, fpjson.schema.types, fpjson.schema.schema, fpjson.schema.validator,
+  fpjson.schema.testutils;
+
+Type
+
+  { TTestSchemaValidator }
+
+  TTestSchemaValidator = Class(TSchemaTestCase)
+  private
+    FSchema: TJSONSchema;
+    FValidator: TJSONSchemaValidator;
+    function AddPrefixItem(aType: TSchemaSimpleType): TJSONSchema;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    Procedure AssertValid(const Msg : String;aJSON : TJSONData);
+    Procedure AssertValid(const Msg : String;aJSON : TJSONStringType);
+    Procedure AssertInValid(const Msg : String;aJSON : TJSONData);
+    Procedure AssertInValid(const Msg : String;aJSON : TJSONStringType);
+    Procedure SetSchemaJSON(const aJSON : TJSONStringType);
+    Property Validator : TJSONSchemaValidator Read FValidator;
+    Property Schema : TJSONSchema Read FSchema;
+  Published
+    Procedure TestHookup;
+    Procedure TestAny;
+    Procedure TestNone;
+    procedure TestTypeString;
+    procedure TestTypeInteger;
+    procedure TestTypeBoolean;
+    procedure TestTypeNumber;
+    procedure TestTypeNull;
+    procedure TestTypeObject;
+    procedure TestTypeArray;
+    procedure TestTypes;
+    procedure TestConstString;
+    procedure TestConstBoolean;
+    procedure TestConstInteger;
+    procedure TestConstArray;
+    procedure TestConstObject;
+    Procedure TestNumericMinimum;
+    Procedure TestNumericExclusiveMinimum;
+    Procedure TestNumericMaximum;
+    Procedure TestNumericExclusiveMaximum;
+    Procedure TestNumericMultipleOf;
+    Procedure TestStringMinLength;
+    Procedure TestStringMaxLength;
+    Procedure TestStringPattern;
+    procedure TestEnum;
+    Procedure TestArrayMinItems;
+    Procedure TestArrayMaxItems;
+    Procedure TestArrayContains;
+    Procedure TestArrayMinContains;
+    Procedure TestArrayMaxContains;
+    Procedure TestArrayPrefixItems;
+    procedure TestArrayItems;
+    procedure TestArrayItemsPrefixItems;
+    procedure TestArrayUniqueItems;
+    procedure TestObjectMinProperties;
+    procedure TestObjectMaxProperties;
+    procedure TestObjectRequired;
+    procedure TestObjectDependentRequired;
+    procedure TestObjectProperties;
+    Procedure TestIfThen;
+    Procedure TestIfElse;
+    Procedure TestAnyOf;
+    Procedure TestAllOf;
+    Procedure TestOneOf;
+    Procedure TestNot;
+    Procedure TestRef;
+  end;
+
+implementation
+
+uses fpjson.schema.reader;
+
+Const
+  SJSONNull        = 'null';
+  SJSONString1     = '"foo"';
+  SJSONString2     = '"bar"';
+  SJSONInteger     = '42';
+  SJSONFloat       = '3.1415';
+  SJSONBool        = 'true';
+  SJSONBoolFalse   = 'false';
+  SJSONArray1      = '['+SJSONString1+']';
+  SJSONArray1a     = '['+SJSONString1+','+SJSONString2+']';
+  SJSONArray2      = '['+SJSONString1+','+SJSONInteger+']';
+  SJSONArray3      = '['+SJSONString1+','+SJSONInteger+','+SJSONFloat+']';
+  SJSONArrayNull   = '['+SJSONString1+','+SJSONInteger+','+SJSONNull+']';
+  SJSONArrayOnlyNull3 = '['+SJSONNull+','+SJSONNull+','+SJSONNull+']';
+  SJSONArrayOnlyNull2 = '['+SJSONNull+','+SJSONNull+']';
+  SJSONArrayOnlyNull1 = '['+SJSONNull+']';
+  SJSONArrayEmpty  = '[]';
+  SJSONArray2Nulls = '['+SJSONString1+','+SJSONInteger+','+SJSONNull+','+SJSONNull+']';
+  SJSONArray3Nulls = '['+SJSONString1+','+SJSONInteger+','+SJSONNull+','+SJSONNull+','+SJSONNull+']';
+  SJSONArray2NullsA = '['+SJSONString1+','+SJSONInteger+','+SJSONNull+','+SJSONNull+','+SJSONInteger+']';
+  SJSONObjectEmpty = '{}';
+  SJSONObject1     = '{"one":"foo"}';
+  SJSONObject2     = '{"one":"foo","two":"bar"}';
+  SJSONObject3     = '{"one":"foo","two":"bar","count":42}';
+  SEmailPattern    = '^[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\.[a-zA-Z]{2,}$';
+
+{ TTestSchemaValidator }
+
+procedure TTestSchemaValidator.SetUp;
+begin
+  inherited SetUp;
+  FValidator:=TJSONSchemaValidator.Create(Nil);
+  FSchema:=TJSONSchema.Create;
+end;
+
+procedure TTestSchemaValidator.TearDown;
+begin
+  FreeAndNil(FValidator);
+  FreeAndNil(FSchema);
+  inherited TearDown;
+end;
+
+procedure TTestSchemaValidator.AssertValid(const Msg : String;aJSON: TJSONStringType);
+var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aJSON,True);
+  try
+    AssertValid(Msg,D);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TTestSchemaValidator.AssertInValid(const Msg: String; aJSON: TJSONStringType);
+var
+  D : TJSONData;
+
+begin
+  D:=GetJSON(aJSON,True);
+  try
+    AssertInValid(Msg,D);
+  finally
+    D.Free;
+  end;
+end;
+
+procedure TTestSchemaValidator.SetSchemaJSON(const aJSON: TJSONStringType);
+
+var
+  aReader : TJsonSchemaReader;
+
+begin
+  aReader:=TJsonSchemaReader.Create(Nil);
+  try
+    aReader.ReadFromString(Schema,aJSON);
+  finally
+    aReader.Free;
+  end;
+end;
+
+procedure TTestSchemaValidator.AssertInValid(const Msg: String; aJSON: TJSONData);
+begin
+  FValidator.Reset;
+  AssertFalse(Msg,FValidator.ValidateJSON(aJSON,Schema));
+end;
+
+procedure TTestSchemaValidator.TestHookup;
+begin
+  AssertNotNull('Schema',Schema);
+  AssertNotNull('Validator',Validator);
+  AssertEquals('Validator empty',0,Validator.Messages.Count);
+end;
+
+procedure TTestSchemaValidator.TestAny;
+begin
+  Schema.MatchType:=smAny;
+  AssertValid('String',SJSONString1);
+  AssertValid('Integer',SJSONInteger);
+  AssertValid('Float',SJSONFloat);
+  AssertValid('Boolean',SJSONBool);
+  AssertValid('Boolean',SJSONBoolFalse);
+  AssertValid('Null',SJSONNull);
+  AssertValid('Array',SJSONArray1);
+  AssertValid('Array3',SJSONArray3);
+  AssertValid('Object',SJSONObject1);
+end;
+
+procedure TTestSchemaValidator.TestNone;
+begin
+  Schema.MatchType:=smNone;
+  AssertInvalid('String',SJSONString1);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeString;
+begin
+  Schema.Validations.Types:=[sstString];
+  AssertValid('String',SJSONString1);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeInteger;
+begin
+  Schema.Validations.Types:=[sstInteger];
+  Assertvalid('Integer',SJSONInteger);
+  AssertInValid('String',SJSONString1);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeBoolean;
+begin
+  Schema.Validations.Types:=[sstBoolean];
+  AssertValid('Boolean',SJSONBool);
+  AssertValid('False Boolean',SJSONBoolFalse);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInValid('String',SJSONString1);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeNumber;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  AssertValid('Integer',SJSONInteger);
+  AssertValid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInValid('String',SJSONString1);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeNull;
+begin
+  Schema.Validations.Types:=[sstNull];
+  AssertValid('Null',SJSONNull);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInValid('String',SJSONString1);
+  AssertInvalid('Array',SJSONArray2);
+  AssertInvalid('Object',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestTypeObject;
+begin
+  Schema.Validations.Types:=[sstObject];
+  AssertValid('Object',SJSONObject2);
+  AssertValid('Object 1',SJSONObject1);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInValid('String',SJSONString1);
+  AssertInvalid('Array',SJSONArray2);
+end;
+
+procedure TTestSchemaValidator.TestTypeArray;
+
+begin
+  Schema.Validations.Types:=[sstArray];
+  AssertValid('Array 1',SJSONArray1);
+  AssertValid('Array 2',SJSONArray2);
+  AssertInvalid('Object',SJSONObject1);
+  AssertInvalid('Null',SJSONNull);
+  AssertInvalid('Integer',SJSONInteger);
+  AssertInvalid('Float',SJSONFloat);
+  AssertInvalid('Boolean',SJSONBool);
+  AssertInValid('String',SJSONString1);
+end;
+
+procedure TTestSchemaValidator.TestTypes;
+begin
+  Schema.Validations.Types:=[sstArray,sstObject];
+  AssertValid('Array1',SJSONArray1);
+  Assertvalid('Object',SJSONObject1);
+end;
+
+procedure TTestSchemaValidator.TestConstString;
+begin
+  Schema.Validations.constValue:=TJSONString.Create('foo');
+  AssertValid('Same String',SJSONString1);
+  AssertInValid('Different String',SJSONString2);
+  AssertInValid('Different type','1');
+end;
+
+procedure TTestSchemaValidator.TestConstBoolean;
+begin
+  Schema.Validations.constValue:=TJSONBoolean.Create(true);
+  AssertValid('Same value',SJSONBool);
+  AssertInValid('Different value',SJSONBoolFalse);
+  AssertInValid('Different type','1');
+end;
+
+procedure TTestSchemaValidator.TestConstInteger;
+begin
+  Schema.Validations.constValue:=TJSONBoolean.Create(true);
+  AssertValid('Same value',SJSONBool);
+  AssertInValid('Different value',SJSONBoolFalse);
+  AssertInValid('Different type','1');
+  AssertInValid('String with correct value','"true"');
+end;
+
+procedure TTestSchemaValidator.TestConstArray;
+begin
+  Schema.Validations.constValue:=TJSONArray.Create([1,2,3]);
+  AssertValid('Same value','[1,2,3]');
+  AssertInValid('Different value','[1,3,2]');
+  AssertInValid('Different type','1');
+  AssertInValid('String with correct value','"[1,2,3]"');
+end;
+
+procedure TTestSchemaValidator.TestConstObject;
+begin
+  Schema.Validations.constValue:=TJSONObject.Create(['one',1,'two',2,'three',3]);
+  AssertValid('Same value',Schema.Validations.constValue.AsJson);
+  AssertInValid('Different value','{"one":1,"two":3,"three":2}');
+  AssertInValid('Different type','1');
+  AssertInValid('String with correct value','"{\"one\":1,\"two\":3,\"three\":2}"');
+end;
+
+procedure TTestSchemaValidator.TestNumericMinimum;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  Schema.Validations.Minimum:=1;
+  AssertValid('OK',SJSONFloat);
+  AssertInValid('NOK','0.5');
+  AssertValid('Limit OK','1');
+end;
+
+procedure TTestSchemaValidator.TestNumericExclusiveMinimum;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  Schema.Validations.ExclusiveMinimum:=1;
+  AssertValid('OK',SJSONFloat);
+  AssertInValid('NOK','0.5');
+  AssertInValid('Limit NOK','1');
+end;
+
+procedure TTestSchemaValidator.TestNumericMaximum;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  Schema.Validations.Maximum:=10;
+  AssertValid('OK',SJSONFloat);
+  AssertInValid('NOK','15');
+  AssertValid('Limit OK','10');
+end;
+
+procedure TTestSchemaValidator.TestNumericExclusiveMaximum;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  Schema.Validations.ExclusiveMaximum:=10;
+  AssertValid('OK',SJSONFloat);
+  AssertInValid('NOK','15');
+  AssertInValid('Limit OK','10');
+end;
+
+procedure TTestSchemaValidator.TestNumericMultipleOf;
+begin
+  Schema.Validations.Types:=[sstNumber];
+  Schema.Validations.MultipleOf:=10;
+  AssertValid('OK','100');
+  AssertInValid('NOK','15');
+  AssertValid('Limit OK','10');
+  AssertValid('0','0');
+  AssertValid('Float integer','10.000');
+end;
+
+procedure TTestSchemaValidator.TestStringMinLength;
+begin
+  Schema.Validations.Types:=[sstString];
+  Schema.Validations.MinLength:=10;
+  AssertValid('Limit OK','"0123456789"');
+  AssertInValid('NOK','"123456789"');
+  AssertValid('OK','"01234567890"');
+end;
+
+procedure TTestSchemaValidator.TestStringMaxLength;
+begin
+  Schema.Validations.Types:=[sstString];
+  Schema.Validations.MaxLength:=10;
+  AssertValid('Limit OK','"0123456789"');
+  AssertInValid('NOK','"01234567890"');
+  AssertValid('OK','"123456789"');
+end;
+
+procedure TTestSchemaValidator.TestStringPattern;
+begin
+  Schema.Validations.Types:=[sstString];
+  Schema.Validations.Pattern:=SEmailPattern;
+  AssertValid('Email','"[email protected]"');
+  AssertInValid('Email 2','"michael@freepascal"');
+end;
+
+procedure TTestSchemaValidator.TestEnum;
+begin
+  Schema.Validations.Enum:=TJSONArray.Create([True,'something']);
+  AssertValid('Boolean','true');
+  AssertValid('String','"something"');
+  AssertInValid('String with boolean','"true"');
+  AssertInValid('Numerical','123');
+end;
+
+procedure TTestSchemaValidator.TestArrayMinItems;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Validations.MinItems:=2;
+  AssertValid('2',SJSONArray1a);
+  AssertValid('2a',SJSONArray2);
+  AssertValid('3',SJSONArray2);
+  AssertInValid('1',SJSONArray1);
+end;
+
+procedure TTestSchemaValidator.TestArrayMaxItems;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Validations.MaxItems:=2;
+  AssertValid('1',SJSONArray1);
+  AssertValid('2',SJSONArray1a);
+  AssertValid('2a',SJSONArray2);
+  AssertInValid('3',SJSONArray3);
+end;
+
+procedure TTestSchemaValidator.TestArrayContains;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Contains.Validations.Types:=[sstNull];
+  AssertValid('1',SJSONArrayNull);
+end;
+
+procedure TTestSchemaValidator.TestArrayMinContains;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Validations.MinContains:=2;
+  Schema.Contains.Validations.Types:=[sstNull];
+  AssertValid('2',SJSONArray2Nulls);
+  AssertValid('3',SJSONArray3Nulls);
+  AssertInValid('1',SJSONArrayNull);
+
+end;
+
+procedure TTestSchemaValidator.TestArrayMaxContains;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Validations.MaxContains:=2;
+  Schema.Contains.Validations.Types:=[sstNull];
+  AssertValid('2',SJSONArray2Nulls);
+  AssertValid('1',SJSONArrayNull);
+  AssertInValid('3',SJSONArray3Nulls);
+end;
+
+function TTestSchemaValidator.AddPrefixItem(aType : TSchemaSimpleType) : TJSONSchema;
+
+begin
+  Result:=Schema.CreateChildSchema;
+  Result.Validations.Types:=[aType];
+  Schema.PrefixItems.Add(Result);
+end;
+
+procedure TTestSchemaValidator.TestArrayPrefixItems;
+
+begin
+  Schema.Validations.Types:=[sstArray];
+  AddPrefixItem(sstString);
+  AddPrefixItem(sstInteger);
+  AssertValid('Less elements OK',SJSONArray1);
+  AssertValid('Exact elements OK',SJSONArray2);
+  AssertValid('More elements OK',SJSONArrayNull);
+  AssertInValid('2nd element not OK',SJSONArray1a);
+end;
+
+procedure TTestSchemaValidator.TestArrayItems;
+
+var
+  SS : TJSONSchema;
+
+begin
+  Schema.Validations.Types:=[sstArray];
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstNull];
+  Schema.Items.Add(SS);
+  AssertValid('Empty OK',SJSONArrayEmpty);
+  AssertValid('One OK',SJSONArrayOnlyNull1);
+  AssertValid('Two OK',SJSONArrayOnlyNull2);
+  AssertValid('Three OK',SJSONArrayOnlyNull3);
+  AssertInValid('None NOK',SJSONArray1a);
+  AssertInValid('One with others NOK',SJSONArrayNull);
+
+end;
+
+procedure TTestSchemaValidator.TestArrayItemsPrefixItems;
+var
+  SS : TJSONSchema;
+
+begin
+  Schema.Validations.Types:=[sstArray];
+  AddPrefixItem(sstString);
+  AddPrefixItem(sstInteger);
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstNull];
+  Schema.Items.Add(SS);
+  AssertValid('Empty OK',SJSONArrayEmpty);
+  AssertValid('Less elements OK',SJSONArray1);
+  AssertValid('Exact elements OK',SJSONArray2);
+  AssertValid('More Prefix elements OK',SJSONArrayNull);
+  AssertInValid('Has some but then again not',SJSONArray2NullsA);
+  AssertInValid('Immediate NOK',SJSONArray3);
+  AssertInValid('Two OK',SJSONArrayOnlyNull2);
+  AssertInValid('Three OK',SJSONArrayOnlyNull3);
+  AssertInValid('One OK',SJSONArrayOnlyNull1);
+  AssertInValid('None NOK',SJSONArray1a);
+end;
+
+procedure TTestSchemaValidator.TestArrayUniqueItems;
+begin
+  Schema.Validations.Types:=[sstArray];
+  Schema.Validations.UniqueItems:=True;
+  AssertValid('Empty OK',SJSONArrayEmpty);
+  AssertValid('One element OK',SJSONArrayOnlyNull1);
+  AssertValid('Different elements OK',SJSONArray3);
+  AssertInValid('2 elements OK',SJSONArrayOnlyNull2);
+  AssertInValid('3 elements OK',SJSONArrayOnlyNull3);
+end;
+
+procedure TTestSchemaValidator.TestObjectMinProperties;
+begin
+  Schema.Validations.Types:=[sstObject];
+  Schema.Validations.MinProperties:=1;
+  AssertValid('1 ok',SJSONObject1);
+  AssertValid('2 ok',SJSONObject2);
+  AssertValid('3 ok',SJSONObject3);
+  AssertInvalid('0 not ok',SJSONObjectEmpty);
+  Schema.Validations.MinProperties:=3;
+  AssertInValid('Min 3, 2 not ok',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestObjectMaxProperties;
+begin
+  Schema.Validations.Types:=[sstObject];
+  Schema.Validations.MaxProperties:=1;
+  Assertvalid('0 not ok',SJSONObjectEmpty);
+  AssertValid('1 ok',SJSONObject1);
+  AssertInValid('2 not ok',SJSONObject2);
+  AssertInValid('3 not ok',SJSONObject3);
+  Schema.Validations.MaxProperties:=2;
+  AssertInValid('Max 2, 3 not ok',SJSONObject3);
+end;
+
+procedure TTestSchemaValidator.TestObjectRequired;
+begin
+  Schema.Validations.Types:=[sstObject];
+  Schema.Validations.Required.Add('one');
+  AssertValid('1 ok',SJSONObject1);
+  AssertValid('2 ok',SJSONObject2);
+  AssertInValid('0 nok',SJSONObjectEmpty);
+  Schema.Validations.Required.Add('two');
+  AssertValid('2 ok',SJSONObject2);
+  AssertValid('3 ok',SJSONObject3);
+  AssertInValid('1 ok',SJSONObject1);
+end;
+
+procedure TTestSchemaValidator.TestObjectDependentRequired;
+begin
+  Schema.Validations.Types:=[sstObject];
+  Schema.Validations.DependentRequired.AddDependent('one').Required.Add('two');
+  AssertValid('Empty ok',SJSONObjectEmpty);
+  AssertValid('Req ok',SJSONObject2);
+  AssertValid('Extra ok',SJSONObject3);
+  AssertInvalid('Missing not ok',SJSONObject1);
+  Schema.Validations.DependentRequired.AddDependent('two').Required.Add('count');
+  AssertValid('Extra ok',SJSONObject3);
+  AssertInValid('Req missin nok',SJSONObject2);
+end;
+
+procedure TTestSchemaValidator.TestObjectProperties;
+var
+  SS : TJSONSchema;
+begin
+  Schema.Validations.Types:=[sstObject];
+  SS:=Schema.CreateChildSchema('one');
+  SS.Validations.types:=[sstString];
+  Schema.Properties.Add(SS);
+  SS:=Schema.CreateChildSchema('two');
+  SS.Validations.types:=[sstString];
+  Schema.Properties.Add(SS);
+end;
+
+procedure TTestSchemaValidator.TestIfThen;
+begin
+  Schema.IfSchema.Validations.Types:=[sstString];
+  Schema.ThenSchema.Validations.constValue:=TJSONString.Create('something');
+  AssertValid('Correct then','"something"');
+  AssertValid('no else OK','true');
+  AssertInValid('Incorrect then','"solo"');
+end;
+
+procedure TTestSchemaValidator.TestIfElse;
+
+begin
+  Schema.IfSchema.Validations.Types:=[sstString];
+  Schema.ElseSchema.Validations.constValue:=TJSONIntegerNumber.Create(12);
+  AssertValid('No then OK','"something"');
+  AssertValid('Correct else','12');
+  AssertInValid('Incorrect else','24');
+end;
+
+procedure TTestSchemaValidator.TestAnyOf;
+var
+  SS : TJSONSchema;
+begin
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstString];
+  Schema.AnyOf.Add(SS);
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstNumber];
+  Schema.AnyOf.Add(SS);
+  AssertValid('String ','"something"');
+  AssertValid('Number','12');
+  AssertInValid('Boolean','false');
+end;
+
+procedure TTestSchemaValidator.TestAllOf;
+var
+  SS : TJSONSchema;
+begin
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstString];
+  Schema.AllOf.Add(SS);
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.constValue:=TJSONString.Create('something');
+  Schema.AllOf.Add(SS);
+  AssertValid('String ','"something"');
+  AssertInvalid('String ','"else"');
+  AssertInValid('Number','12');
+  AssertInValid('Boolean','false');
+end;
+
+procedure TTestSchemaValidator.TestOneOf;
+var
+  SS : TJSONSchema;
+begin
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.Types:=[sstString];
+  Schema.OneOf.Add(SS);
+  SS:=Schema.CreateChildSchema;
+  SS.Validations.constValue:=TJSONString.Create('something');
+  Schema.OneOf.Add(SS);
+  AssertValid('Different String ','"else"'); //
+  AssertInValid('String ','"something"');
+  AssertInValid('Number','12');
+  AssertInValid('Boolean','false');
+end;
+
+procedure TTestSchemaValidator.TestNot;
+begin
+  Schema.NotSchema.Validations.Types:=[sstString];
+  AssertInValid('String not OK','"something"');
+  AssertValid('Number Correct','12');
+  AssertValid('Boolean Correct','false');
+end;
+
+procedure TTestSchemaValidator.TestRef;
+begin
+  Schema.Validations.Types:=[sstObject];
+  Schema.Properties.Add('productId').Validations.Types:=[sstInteger];
+  Schema.Properties.Add('name').Ref:='#/$defs/string';
+  with Schema.Defs.Add('string') do
+    begin
+    id:='string';
+    Validations.types:=[sstString];
+    end;
+  AssertValid('Correct ref','{ "productId": 123, "name" : "Widget" }');
+end;
+
+
+
+procedure TTestSchemaValidator.AssertValid(const Msg: String; aJSON: TJSONData);
+begin
+  FValidator.Reset;
+  AssertTrue(Msg,FValidator.ValidateJSON(aJSON,Schema));
+end;
+
+initialization
+  RegisterTest(TTestSchemaValidator);
+end.
+

packages/fcl-jsonschema/tests/utSchemaWriter.pp

@@ -0,0 +1,220 @@
+{
+    This file is part of the Free Component Library
+
+    Testsuite for JSONSchema writer
+    Copyright (c) 2024 by Michael Van Canneyt [email protected]
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+unit utSchemaWriter;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson,fpjson.schema.types, fpjson.schema.schema, fpjson.schema.writer;
+
+Type
+
+   { TTestSchemaWriter }
+
+   TTestSchemaWriter = Class(TTestCase)
+   Private
+     FSchema : TJSONSchema;
+     FStream: TStringStream;
+   Public
+     Procedure Setup; override;
+     Procedure TearDown; override;
+     Procedure CheckStream(aJSON : String); virtual; abstract;
+     Property Schema : TJSONSchema Read FSchema;
+     Property Stream : TStringStream Read FStream;
+   Published
+     Procedure TestHookup;
+     Procedure TestAny;
+     Procedure TestNone;
+     Procedure TestEmpty;
+     Procedure TestMetaDataSchema;
+     Procedure TestRequired;
+     procedure TestJSONValue;
+     procedure TestDefaultValueObject;
+     procedure TestDefaultValueSimpleValue;
+     procedure TestDefaultValueArray;
+     procedure TestVocabulary;
+     procedure TestDependentRequired;
+     procedure TestTypes;
+   end;
+
+   TTestStreamWriter = Class(TTestSchemaWriter)
+   Public
+     Procedure CheckStream(aJSON : String); override;
+   end;
+
+   { TTestJSONWriter }
+
+   TTestJSONWriter = Class(TTestSchemaWriter)
+   Public
+     Procedure CheckStream(aJSON : String); override;
+   end;
+
+
+implementation
+
+{ TTestSchemaWriter }
+
+procedure TTestSchemaWriter.Setup;
+begin
+  inherited Setup;
+  FSchema:=TJSONSchema.Create;
+  FStream:=TStringStream.Create('');
+end;
+
+procedure TTestSchemaWriter.TearDown;
+begin
+  FreeAndNil(FStream);
+  FreeAndNil(FSchema);
+  inherited TearDown;
+end;
+
+procedure TTestSchemaWriter.TestHookup;
+begin
+  AssertNotNull('Have schema',Schema);
+  AssertNotNull('Have stream',Stream);
+end;
+
+procedure TTestSchemaWriter.TestAny;
+begin
+  Schema.MatchType:=smAny;
+  CheckStream('true');
+end;
+
+procedure TTestSchemaWriter.TestNone;
+begin
+  Schema.MatchType:=smNone;
+  CheckStream('false');
+end;
+
+procedure TTestSchemaWriter.TestEmpty;
+begin
+  Schema.MatchType:=smConstrained;
+  CheckStream('{}');
+end;
+
+procedure TTestSchemaWriter.TestMetaDataSchema;
+begin
+  Schema.MetaData.Title:='soso';
+  Schema.MetaData.Description:='many';
+  CheckStream('{"title":"soso","description":"many"}');
+end;
+
+procedure TTestSchemaWriter.TestRequired;
+begin
+  Schema.Validations.Required.Add('one');
+  Schema.Validations.Required.Add('two');
+  Schema.Validations.Required.Add('three');
+  CheckStream('{"required":["one","two","three"]}');
+end;
+
+procedure TTestSchemaWriter.TestDefaultValueObject;
+begin
+  Schema.MetaData.DefaultValue:=TJSONObject.Create(['one',1]);
+  CheckStream('{"default":{"one":1}}');
+end;
+
+procedure TTestSchemaWriter.TestDefaultValueSimpleValue;
+begin
+  Schema.MetaData.DefaultValue:=TJSONString.Create('self');
+  CheckStream('{"default":"self"}');
+end;
+
+procedure TTestSchemaWriter.TestDefaultValueArray;
+begin
+  Schema.MetaData.DefaultValue:=TJSONArray.Create(['self']);
+  CheckStream('{"default":["self"]}');
+end;
+
+procedure TTestSchemaWriter.TestVocabulary;
+begin
+  Schema.Vocabulary.AddVocabulary('http://www.freepascal.org/voc').Enabled:=true;
+  Schema.Vocabulary.AddVocabulary('http://www.freepascal.org/voc2').Enabled:=true;
+  CheckStream('{"$vocabulary":{"http://www.freepascal.org/voc":true,"http://www.freepascal.org/voc2":true}}');
+end;
+
+procedure TTestSchemaWriter.TestDependentRequired;
+begin
+  With Schema.Validations.DependentRequired.AddDependent('license') do
+    begin
+    Required.Add('one');
+    Required.Add('two');
+    Required.Add('three');
+    end;
+  CheckStream('{"dependentRequired":{"license":["one","two","three"]}}');
+end;
+
+procedure TTestSchemaWriter.TestTypes;
+begin
+  Schema.Validations.Types:=[sstString,sstNull,sstNumber];
+  CheckStream('{"type":["null","number","string"]}');
+end;
+
+procedure TTestSchemaWriter.TestJSONValue;
+begin
+  Schema.Validations.constValue:=TJSONString.Create('self');
+  CheckStream('{"const":"self"}');
+end;
+
+{ TTestStreamWriter }
+
+procedure TTestStreamWriter.CheckStream(aJSON: String);
+begin
+  With TJSONSchemaWriterStream.Create(Nil) do
+    try
+      WriteSchema(Schema,Stream);
+    finally
+      Free;
+    end;
+  AssertEquals('Streamed content',aJSON,Stream.DataString);
+end;
+
+{ TTestJSONWriter }
+
+procedure TTestJSONWriter.CheckStream(aJSON: String);
+
+var
+  D : TJSONData;
+
+begin
+  D:=Nil;
+  try
+    With TJSONSchemaWriterJSON.Create(Nil) do
+      try
+        D:=WriteSchema(Schema);
+      finally
+        Free;
+      end;
+    AssertEquals('Streamed content',aJSON,D.FormatJSON([foSingleLineObject,foSingleLineArray,foSkipWhiteSpace],0));
+    {
+    foSingleLineArray,   // Array without CR/LF : all on one line
+                       foSingleLineObject,  // Object without CR/LF : all on one line
+                       foDoNotQuoteMembers, // Do not quote object member names.
+                       foUseTabchar,        // Use tab characters instead of spaces.
+                       foSkipWhiteSpace,    // Do not use whitespace at all
+
+    }
+  finally
+    D.Free;
+  end;
+end;
+
+
+initialization
+  RegisterTests([TTestStreamWriter,TTestJSONWriter])
+end.
+

packages/fpmake_add.inc

@@ -158,3 +158,4 @@
   add_testinsight(ADirectory+IncludeTrailingPathDelimiter('testinsight'));
   add_wasm_job(ADirectory+IncludeTrailingPathDelimiter('wasm-job'));
   add_wasm_oi(ADirectory+IncludeTrailingPathDelimiter('wasm-oi'));
+  add_fcl_jsonschema(ADirectory+IncludeTrailingPathDelimiter('fcl-jsonschema'));

packages/fpmake_proc.inc

@@ -894,3 +894,9 @@ end;
 {$include gitlab/fpmake.pp}
 
 
+procedure add_fcl_jsonschema(const ADirectory: string);
+begin
+  with Installer do
+{$include fcl-jsonschema/fpmake.pp}
+end;
+