Browse Source

* Tests for code generation. Change type handling to create pascal type data for all data

Michaël Van Canneyt 9 months ago
parent
commit
cc0adf66d0

+ 7 - 7
packages/fcl-jsonschema/src/fpjson.schema.codegen.pp

@@ -148,7 +148,7 @@ begin
     ptJSON,
     ptString:
       Result := '''''';
-    ptStructure:
+    ptAnonStruct:
       Result := 'TJSONObject(Nil)';
     ptArray:
       Result := 'TJSONArray(Nil)';
@@ -295,7 +295,7 @@ end;
 function TSerializerCodeGenerator.FieldToJSON(aType: TPropertyType; aFieldName : String): string;
 
 begin
-  if aType in [ptStructure,ptSchemaStruct] then
+  if aType in [ptAnonStruct,ptSchemaStruct] then
   begin
     Result := Format('%s.SerializeObject', [aFieldName]);
   end
@@ -346,7 +346,7 @@ var
 begin
   if aKeyName='features' then
     Writeln('a');
-  if aType in [ptSchemaStruct,ptStructure] then
+  if aType in [ptSchemaStruct,ptAnonStruct] then
   begin
     Result := Format('%s.Deserialize(%s)', [aPropertyTypeName, ObjectField(aKeyName)]);
   end
@@ -390,7 +390,7 @@ var
 begin
   if aPropertyTypeName='' then
     Writeln('aPropertyTypeName is empty for ',aFieldName);
-  if aType in [ptStructure,ptSchemaStruct] then
+  if aType in [ptAnonStruct,ptSchemaStruct] then
     Result := Format('%s.Deserialize(%s as TJSONObject)', [aPropertyTypeName, aFieldName])
   else
     begin
@@ -418,7 +418,7 @@ begin
         else
           Result := Format('%s.As%s', [aFieldName, aPropertyTypeName]);
       end;
-      ptStructure:
+      ptAnonStruct:
       begin
         if DelphiCode then
           Result := Format('%s.ToJSON', [aFieldName])
@@ -444,7 +444,7 @@ begin
   lFieldName := aProperty.PascalName;
   lValue := FieldToJSON(aProperty);
   lType:=aProperty.PropertyType;
-  lNilCheck:=WriteClassType and (lType in [ptJSON,ptStructure,ptSchemaStruct]);
+  lNilCheck:=WriteClassType and (lType in [ptJSON,ptAnonStruct,ptSchemaStruct]);
   case lType of
     ptEnum:
       begin
@@ -527,7 +527,7 @@ begin
     ptFloat64,
     ptString,
     ptBoolean,
-    ptStructure,
+    ptAnonStruct,
     ptJSON,
     ptSchemaStruct:
       Addln('Result.%s:=%s;', [lFieldName, lValue]);

+ 355 - 30
packages/fcl-jsonschema/src/fpjson.schema.pascaltypes.pp

@@ -20,9 +20,9 @@ interface
 
 uses
   {$IFDEF FPC_DOTTEDUNITS}
-  System.Classes, System.SysUtils, System.Contnrs,
+  System.Classes, System.SysUtils, System.Contnrs, System.StrUtils,
   {$ELSE}
-  Classes, SysUtils, contnrs,
+  Classes, SysUtils, contnrs, StrUtils,
   {$ENDIF}
   fpjson.schema.types,
   fpjson.schema.schema;
@@ -53,8 +53,8 @@ Type
                    ptString,       // String
                    ptEnum,         // Enumerated
                    ptJSON,         // TJSONData (empty schema object)
-                   ptStructure,    // Class/Record  (schema object with properties)
-                   ptSchemaStruct, // Def/APcomponent
+                   ptAnonStruct,   // Anonymous Class/Record  (schema object with properties)
+                   ptSchemaStruct, // Named Class/Record
                    ptArray         // Array of...
                    );
 
@@ -127,6 +127,7 @@ Type
     FSerializeTypes: TSerializeTypes;
     FSorted : Boolean;
     FProperties : TFPObjectList;
+    FType: TPascalType;
     function GetDependency(aIndex : Integer): TPascalTypeData;
     function GetDependencyCount: Integer;
     function GetImplementationName: String;
@@ -141,7 +142,7 @@ Type
   Public
     class function ExtractFirstType(aSchema: TJSONSchema): TSchemaSimpleType;
   Public
-    Constructor Create(aIndex : integer; const aSchemaName,aPascalName : String; aSchema : TJSONSchema);
+    Constructor Create(aIndex : integer; aType : TPascalType; const aSchemaName,aPascalName : String; aSchema : TJSONSchema);
     destructor Destroy; override;
     // Index of property using schema name
     Function IndexOfProperty(const aSchemaName: string) : Integer;
@@ -161,6 +162,7 @@ Type
     Function HasArrayProperty : Boolean;
     // Component has object-typed property ? (SchemaComponentsonly = False -> also return array of string etc.)
     function HasObjectProperty(aSchemaComponentsOnly: Boolean): Boolean;
+
     // Components his component depends on
     Property Dependency[aIndex : Integer] : TPascalTypeData Read GetDependency;
     // Number of Components his component depends on
@@ -185,8 +187,10 @@ Type
     Property SerializeTypes : TSerializeTypes Read FSerializeTypes Write FSerializeTypes;
     // Schema of this component.
     Property Schema: TJSONSChema Read FSchema;
-    //
+    // Was this element sorted ?
     Property Sorted : Boolean Read FSorted Write FSorted;
+    // PascalType
+    Property Pascaltype : TPascalType Read FType;
   end;
 
   { TPascalTypeDataList }
@@ -207,6 +211,7 @@ Type
   private
     FKeywordEscapeMode: TKeywordEscapeMode;
     FTypeList : TPascalTypeDataList;
+    FAliasList : TPascalTypeDataList;
     FTypeMap : TFPObjectHashTable;
     FArrayTypePrefix: string;
     FArrayTypeSuffix: string;
@@ -222,13 +227,25 @@ Type
     // Logging
     procedure DoLog(Const aType : TEventType; const aMessage : String);
     procedure DoLog(Const aType : TEventType; const aFmt : String; aArgs : Array of const);
+    // Override this to determine the type name of a pascal property
+    function GetSchemaTypeAndName(aType: TPascalTypeData; aSchema: TJSONSchema; out aPropType: TPascalType; aNameType: TNameType=ntPascal): String; virtual;
     // Add a new type to the type map.
     procedure AddToTypeMap(const aSchemaName: String; aData : TPascalTypeData); virtual; overload;
-
+    // Get pascal type name based on schema name
+    function SchemaNameToNameType(const aName: string; aNameType: TNameType): string; virtual;
+    // Take JSONPointer reference and find pascal type data for it.
+    function GetPascalTypeDataFromRef(const aRef: String): TPascalTypeData; virtual;
+    // Find schema pascal type data. If AllowCreate is true, type data for Enum,Array and object properties will be created.
+    function GetSchemaTypeData(aType: TPascalTypeData; lSchema: TJSONSchema; AllowCreate: Boolean=False): TPascalTypeData;
+    // Add a type to the alias list
+    Procedure AddAliasType(aType : TPascalTypeData); virtual;
+    // Sort types in dependency order
     procedure SortTypes;
   Public
     Constructor Create; virtual;
     Destructor Destroy; override;
+    // Create aliases for known simple types
+    procedure DefineStandardPascalTypes;
     // Is the word a pascal keyword ?
     class function IsKeyWord(const aWord : String) : Boolean;
     // Escape the word if it is a pascal keyword ?
@@ -237,20 +254,30 @@ Type
     function GetTypeMap(const aName : string): String;
     // Return index of named schema type (name as in OpenApi). Return -1 if not found.
     function IndexOfSchemaType(const aSchemaName: String): integer;
+    // Find Pascal type data based on schema type name.
+    function FindSchemaTypeData(const aSchemaName: String; aFormat : String = ''): TPascalTypeData;
     // Extract simple type from schema
     Function GetSchemaType(aSchema : TJSONSchema) : TSchemaSimpleType;
     // Extract element type from schema
     Function GetArrayElementType(aSchema : TJSONSchema) : TSchemaSimpleType;
+    // Used when creating a new type. Override to create a descendant;
+    function CreatePascalType(aIndex: integer; aType : TPascalType; const aSchemaName, aPascalName: String; aSchema: TJSONSchema): TPascalTypeData; virtual;
     // Add a type to the list
     Procedure AddType(const aSchemaName: String; aType : TPascalTypeData); virtual;
     // Add a type definition to the type map.
-    procedure AddAliasToTypeMap(const aSchemaTypeName,aPascalTypeName : String; aSchema : TJSONSchema = Nil); overload;
-
+    procedure AddAliasToTypeMap(aType: TPascalType; const aAlias, aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema); overload;
+    // Add a property to a type
+    function AddTypeProperty(aType: TPascalTypeData; lProp: TJSONSchema; aName : string = ''; Recurse : Boolean = True): TPascalPropertyData;
+    // Add properties to structured pascal type from aSchema. if aSchema = nil then use aType.Schema
+    Procedure AddPropertiesToType(aType : TPascalTypeData; aSchema: TJSONSchema = Nil; Recurse : Boolean = True);
+    // For all types, fill the depency list: contains all structured types on which the type depends (recursively).
+    procedure CheckDependencies;
+    // Number of types
     Property TypeCount : Integer Read GetSchemaTypeCount;
+    // Indexed access to all types.
     Property Types[aIndex : Integer] : TPascalTypeData Read GetSchemaType; default;
     // Map schema type to pascal type.
     Property TypeMap[aSchemaName : string] : String Read GetTypeMap;
-
     // prefix for object definitions. Default T
     Property ObjectTypePrefix : string Read FObjectTypePrefix Write FObjectTypePrefix;
     // prefix for object definitions. Default empty
@@ -273,6 +300,7 @@ Type
 
 implementation
 
+
 function CompareTypeDataOnName(Item1, Item2: Pointer): Integer;
 
 var
@@ -374,7 +402,7 @@ begin
     ptString       : Result:='string';
     ptEnum         : Raise ESchemaData.CreateFmt('Unknown name for enumerated property "%s"',[PascalName]);
     ptJSON         : Result := 'string';
-    ptStructure    : Raise ESchemaData.CreateFmt('Unknown name for structured property "%s"',[PascalName]);
+    ptAnonStruct   : Raise ESchemaData.CreateFmt('Unknown name for structured property "%s"',[PascalName]);
     ptSchemaStruct : Raise ESchemaData.CreateFmt('Unknown name for schema-typed property "%s"',[PascalName]);
   end;
 end;
@@ -472,7 +500,8 @@ begin
 end;
 
 
-constructor TPascalTypeData.Create(aIndex: integer; const aSchemaName, aPascalName: String; aSchema: TJSONSchema);
+constructor TPascalTypeData.Create(aIndex: integer; aType: TPascalType; const aSchemaName, aPascalName: String; aSchema: TJSONSchema
+  );
 
 begin
   FIndex:=aIndex;
@@ -481,6 +510,7 @@ begin
   FPascalName:=aPascalName;
   FSerializeTypes:=[stSerialize,stDeserialize];
   FProperties:=TFPObjectList.Create(True);
+  FType:=aType;
 end;
 
 
@@ -576,19 +606,42 @@ begin
   FDependencies.Add(aData);
 end;
 
+procedure TSchemaData.CheckDependencies;
 
-class function TPascalTypeData.ExtractFirstType(aSchema : TJSONSchema): TSchemaSimpleType;
+  procedure CheckProps(lTop,aData : TPascalTypeData);
+
+  var
+    lPropData : TPascalTypeData;
+    I : Integer;
+  begin
+    For I:=0 to aData.PropertyCount-1 do
+      begin
+      lPropData:=aData.Properties[I].TypeData;
+      if Assigned(lPropData) and (lPropData.Pascaltype in [ptAnonStruct,ptSchemaStruct]) then
+        begin
+        lTop.AddDependency(lPropData);
+        CheckProps(lTop,lPropData);
+        end;
+      end;
+  end;
 
 var
-  types : TSchemaSimpleTypes;
-  t : TSchemaSimpleType;
+  I : Integer;
+  lData : TPascalTypeData;
+
+begin
+  For I:=0 to TypeCount-1 do
+    begin
+    lData:=Types[I];
+    CheckProps(lData,lData);
+    end;
+end;
+
+
+class function TPascalTypeData.ExtractFirstType(aSchema : TJSONSchema): TSchemaSimpleType;
 
 begin
-  result:=sstNone;
-  types:=aSchema.Validations.Types;
-  for T in TSchemaSimpleType do
-    if T in Types then
-      Exit(T);
+  Result:=aSchema.Validations.GetFirstType;
 end;
 
 
@@ -671,11 +724,260 @@ begin
     FOnLog(aType,Format(aFmt,aArgs));
 end;
 
+// Find requested name type in API types, based on openAPI name.
+function TSchemaData.SchemaNameToNameType(const aName: string; aNameType: TNameType): string;
 
-procedure TSchemaData.AddAliasToTypeMap(const aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema);
+var
+  lType : TPascalTypeData;
 
 begin
-  AddToTypeMap(aSchemaTypeName,TPascalTypeData.Create(-1,aSchemaTypeName,aPascalTypeName,aSchema));
+  lType:=FindSchemaTypeData(aName);
+  if Assigned(lType) then
+    Result:=lType.GetTypeName(aNameType)
+  else
+    Result:=aName;
+end;
+
+function TSchemaData.GetPascalTypeDataFromRef(const aRef : String): TPascalTypeData;
+
+var
+  P : Integer;
+  lName : String;
+begin
+  P:=RPos('/',aRef);
+  if P=0 then
+    P:=RPos('#',aRef);
+  if p=0 then
+    lName:=aRef
+  else
+    lName:=Copy(aRef,P+1,Length(aRef)-P);
+  Result:=FindSchemaTypeData(lName);
+end;
+
+procedure TSchemaData.AddAliasType(aType: TPascalTypeData);
+begin
+  FAliasList.Add(aType);
+end;
+
+
+// Determine the PascalType and pascal type name of the given schema
+
+function TSchemaData.GetSchemaTypeAndName(aType: TPascalTypeData; aSchema: TJSONSchema; out aPropType: TPascalType; aNameType : TNameType = ntPascal): String;
+
+var
+  lTypeData : TPascalTypeData;
+  lName : string;
+
+begin
+  lTypeData:=GetSchemaTypeData(aType,aSchema);
+  if lTypeData=Nil then
+    begin
+    aPropType:=ptUnknown;
+    Result:='';
+    {
+    if assigned(aType) then
+      lName:=aType.SchemaName
+    else
+      lName:='<unknown>';
+    Raise ESchemaData.CreateFmt('Could not find type data for %s, property %s',[lName,aSchema.Name]);
+    }
+    end
+  else
+    begin
+    aPropType:=lTypeData.Pascaltype;
+    Result:=lTypeData.GetTypeName(aNameType);
+    end;
+end;
+
+function TSchemaData.GetSchemaTypeData(aType: TPascalTypeData; lSchema: TJSONSchema; AllowCreate : Boolean = False) : TPascalTypeData;
+
+var
+  lType : TSchemaSimpleType;
+  lName,lBaseName,lPascalName : string;
+  lFormat : String;
+  lElTypeData : TPascalTypeData;
+
+begin
+  LType:=lSchema.Validations.GetFirstType;
+  Result:=Nil;
+  if lSchema.Ref<>'' then
+    Result:=GetPascalTypeDataFromRef(lSchema.Ref)
+  else
+    begin
+    lName:='';
+    lFormat:='';
+    Case lType of
+      sstNone: ;
+      sstNull: ;
+      sstBoolean :
+        lName:='boolean';
+      sstInteger :
+        begin
+        lName:='integer';
+        lFormat:=lSchema.Validations.Format;
+        end;
+      sstNumber:
+        begin
+        lName:='number';
+        end;
+      sstString:
+        begin
+        if IndexText(lSchema.Validations.Format,['date','time','date-time'])>=0 then
+          begin
+          lName:='string';
+          lFormat:=lSchema.Validations.Format;
+          end
+        else if UseEnums and lSchema.Validations.HasKeywordData(jskEnum) and (lSchema.Validations.Enum.Count>0) then
+          begin
+          if assigned(aType) then
+            lBaseName:=aType.GetTypeName(ntSchema)+'_'+lSchema.Name
+          else
+            lBaseName:='T'+lSchema.Name;
+          lName:='('+lBaseName+')';
+          Result:=FindSchemaTypeData(lName);
+          if (Result=Nil) and allowCreate then
+            begin
+            Result:=CreatePascalType(-1,ptEnum,lName,'T'+lBaseName,lSchema);
+            AddType(lName,Result);
+            end;
+          end
+        else
+          begin
+          lName:='string';
+          end;
+        end;
+      sstArray:
+        begin
+        lElTypeData:=GetSchemaTypeData(Nil,lSchema.Items[0]);
+//         Data.FindSchemaTypeData('Array of string')
+        if DelphiTypes then
+          lPascalName:='TArray<'+lElTypeData.PascalName+'>'
+        else
+          lPascalName:='Array of '+lElTypeData.PascalName;
+        lName:='['+lElTypeData.SchemaName+']';
+        Result:=FindSchemaTypeData(lName);
+        if (Result=Nil) and AllowCreate then
+          begin
+          Result:=CreatePascalType(-1,ptArray,lName,lPascalName,lSchema);
+          AddType(lName,Result);
+          end;
+        end;
+      sstObject:
+        begin
+        if lSchema.Properties.Count=0 then
+          lName:='JSON'
+        else
+          begin
+          if assigned(aType) then
+            lBaseName:=aType.GetTypeName(ntSchema)+'_'+lSchema.Name
+          else
+            lBaseName:='Nested_'+lSchema.Name;
+          lName:='{'+lBaseName+'}';
+          Writeln('Alias ',lName);
+          lPascalName:='T'+lBaseName;
+          Result:=FindSchemaTypeData(lName);
+          if (Result=Nil) and AllowCreate then
+            begin
+            Result:=CreatePascalType(-1,ptAnonStruct,lName,lPascalName,lSchema);
+            AddType(lName,Result);
+            AddPropertiesToType(Result,lSchema,True);
+            end;
+          end;
+        end;
+      sstAny:
+        lname:='any';
+    end;
+    if lName<>'' then
+      Result:=FindSchemaTypeData(lName,lFormat);
+    end;
+end;
+
+// Add a property to the type using the schema
+function TSchemaData.AddTypeProperty(aType: TPascalTypeData; lProp: TJSONSchema; aName: string; Recurse: Boolean
+  ): TPascalPropertyData;
+
+var
+  Tmp, lTypeName, lName : string;
+  lType,lEltype : TPropertyType;
+  I : Integer;
+  lPropTypeData : TPascaltypeData;
+
+
+begin
+  lName:=aName;
+  if lName='' then
+    lName:=EscapeKeyWord(lProp.Name);
+  if lProp.Validations.TypesCount>1 then
+    Raise ESchemaData.CreateFmt('Creating property for schema with multiple types ("%s") is not supported',[lName]);
+  if (lProp.Validations.GetFirstType=sstArray) then
+    if (lProp.Items.Count<>1) then
+      Raise ESchemaData.CreateFmt('Creating array property for schema with multiple item types ("%s") is not supported',[lName])
+    else if (lProp.Items.Count<1) then
+      Raise ESchemaData.CreateFmt('Creating array property for schema without item types ("%s") is not supported',[lName]);
+  lPropTypeData:=GetSchemaTypeData(aType,lProp,Recurse);
+  if lPropTypeData=Nil then
+    Raise ESchemaData.CreateFmt('Unknown property type for property %s',[lName]);
+  lType:=lPropTypeData.Pascaltype;
+  lTypeName:=lPropTypeData.GetTypeName(ntPascal);
+  Result:=aType.AddProperty(lProp.Name,lName);
+  Result.Schema:=lProp;
+  Result.PropertyType:=lType;
+  Result.TypeData:=lPropTypeData;
+  Result.PascalTypeName:=lPropTypeData.GetTypeName(ntPascal);
+  if (lType=ptEnum) then
+    begin
+    for I:=0 to lProp.Validations.Enum.Count-1 do
+      Result.EnumValues.Add(EscapeKeyWord(lProp.Validations.Enum.Items[I].AsString));
+    end;
+  if (lType=ptArray) then
+    begin
+    Result.PascalTypeName:=lTypeName;
+    if (lProp.Items[0].Ref<>'') then
+      begin
+      Result.ElementType:=ptSchemaStruct;
+      Result.TypeData:=GetPascalTypeDataFromRef(lProp.Items[0].Ref);
+      if Result.TypeData=Nil then
+        Raise ESchemaData.CreateFmt('No typedata for property %s element type (Ref: %s)',[Result.PascalName,lProp.Items[0].Ref]);
+      Result.ElementTypeName:=Result.TypeData.PascalName;
+      end
+    else
+      begin
+      Result.ElementTypeName:=GetSchemaTypeAndName(Nil,lProp.Items[0],lEltype);
+      Result.ElementType:=lElType;
+      end;
+    Result.TypeNames[ntInterface]:=GetSchemaTypeAndName(Nil,lProp,lelType,ntInterface);
+    Result.TypeNames[ntImplementation]:=GetSchemaTypeAndName(Nil,lProp,lElType,ntImplementation);
+    end;
+end;
+
+procedure TSchemaData.AddPropertiesToType(aType: TPascalTypeData; aSchema: TJSONSchema; Recurse: Boolean);
+
+var
+  I : Integer;
+  lSchema : TJSONSchema;
+begin
+  lSchema:=aSchema;
+  if lSchema=Nil then
+    lSchema:=aType.Schema;
+  for I:=0 to lSchema.Properties.Count-1 do
+    AddTypeProperty(aType,lSchema.Properties[i],'',Recurse);
+end;
+
+function TSchemaData.CreatePascalType(aIndex: integer; aType : TPascalType; const aSchemaName, aPascalName: String; aSchema: TJSONSchema): TPascalTypeData;
+begin
+  Result:=TPascalTypeData.Create(aIndex,aType,aSchemaName,aPascalName,aSchema);
+end;
+
+
+procedure TSchemaData.AddAliasToTypeMap(aType : TPascalType; const aAlias,aSchemaTypeName, aPascalTypeName: String; aSchema: TJSONSchema);
+
+var
+  lType : TPascalTypeData;
+
+begin
+  lType:=CreatePascalType(-1,aType,aSchemaTypeName,aPascalTypeName,aSchema);
+  AddToTypeMap(aAlias,lType);
+  AddAliasType(lType);
 end;
 
 
@@ -684,6 +986,7 @@ constructor TSchemaData.Create;
 begin
   FTypeMap:=TFPObjectHashTable.Create(False);
   FTypeList:=TPascalTypeDataList.Create(True);
+  FAliasList:=TPascalTypeDataList.Create(True);
   FObjectTypePrefix:='T';
   FObjectTypeSuffix:='';
   FInterfaceTypePrefix:='I';
@@ -695,10 +998,27 @@ destructor TSchemaData.Destroy;
 
 begin
   FreeAndNil(FTypeList);
+  FreeAndNil(FAliasList);
   FreeAndNil(FTypeMap);
   inherited Destroy;
 end;
 
+procedure TSchemaData.DefineStandardPascalTypes;
+begin
+  // typename--format
+  AddAliasToTypeMap(ptInteger,'integer','integer','integer',Nil);
+  AddAliasToTypeMap(ptInteger,'integer--int32','integer','integer',Nil);
+  AddAliasToTypeMap(ptInt64,'integer--int64','integer','int64',Nil);
+  AddAliasToTypeMap(ptString,'string','string','string',Nil);
+  AddAliasToTypeMap(ptDateTime,'string--date','string','TDateTime',Nil);
+  AddAliasToTypeMap(ptDateTime,'string--time','string','TDateTime',Nil);
+  AddAliasToTypeMap(ptDateTime,'string--date-time','string','TDateTime',Nil);
+  AddAliasToTypeMap(ptBoolean,'boolean','boolean','boolean',Nil);
+  AddAliasToTypeMap(ptFloat64,'number','number','double',Nil);
+  AddAliasToTypeMap(ptJSON,'JSON','object','string',Nil);
+  AddAliasToTypeMap(ptJSON,'any','object','string',Nil);
+end;
+
 
 class function TSchemaData.IsKeyWord(const aWord: String): Boolean;
 
@@ -732,18 +1052,24 @@ end;
 
 function TSchemaData.GetTypeMap(const aName: string): String;
 
+begin
+  Result:=SchemaNameToNameType(aName,ntPascal);
+end;
+
+
+// Find Pascal type data based on schema name
+function TSchemaData.FindSchemaTypeData(const aSchemaName: String; aFormat: String): TPascalTypeData;
+
 var
-  Obj : TPascalTypeData;
+  lName : string;
 
 begin
-  Obj:=TPascalTypeData(FTypeMap.Items[aName]);
-  if Assigned(Obj) then
-    Result:=Obj.PascalName
-  else
-    Result:=aName;
+  lName:=aSchemaName;
+  if aFormat<>'' then
+    lName:=lName+'--'+aFormat;
+  Result:=TPascalTypeData(FTypeMap.Items[lName]);
 end;
 
-
 function TSchemaData.IndexOfSchemaType(const aSchemaName: String): integer;
 
 begin
@@ -822,6 +1148,5 @@ begin
   end;
 end;
 
-
 end.
 

+ 27 - 0
packages/fcl-jsonschema/src/fpjson.schema.schema.pp

@@ -181,6 +181,10 @@ Type
     function KeywordsWithData : TJSONSchemaKeywords; virtual;
     // Is the keyword set
     function HasKeywordData(aKeyword : TJSONSchemaKeyword) : Boolean; virtual;
+    // Count types
+    Function TypesCount : Integer;
+    // First type (in order of TSchemaSimpleType
+    Function GetFirstType : TSchemaSimpleType;
     // Owner schema
     property Schema : TJSONSchema Read FSchema;
     // type keyword
@@ -882,6 +886,29 @@ begin
   end;
 end;
 
+function TJSONSchemaValidations.TypesCount: Integer;
+
+var
+  T : TSchemaSimpleType;
+
+begin
+  Result:=0;
+  For T in TSchemaSimpleType do
+    if T in Types then
+      Inc(Result);
+end;
+
+function TJSONSchemaValidations.GetFirstType: TSchemaSimpleType;
+var
+  T : TSchemaSimpleType;
+
+begin
+  Result:=sstNone;
+  For T in TSchemaSimpleType do
+    if T in Types then
+      Exit(T);
+end;
+
 { TJSONSChemaVocabulary }
 
 procedure TJSONSchemaVocabulary.Assign(Source: TPersistent);

+ 8 - 1
packages/fcl-jsonschema/tests/testschema.lpi

@@ -37,7 +37,6 @@
       <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"/>
@@ -93,6 +92,14 @@
         <Filename Value="utSchemaValidator.pp"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="../src/fpjson.schema.pascaltypes.pp"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
+      <Unit>
+        <Filename Value="utSchemaPascalTypes.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 2 - 1
packages/fcl-jsonschema/tests/testschema.lpr

@@ -22,7 +22,8 @@ uses
   {$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;
+  fpjson.schema.writer, utSchemaWriter, fpjson.schema.validator, utSchemaValidator, fpjson.schema.pascaltypes,
+  fpjson.schema.codegen, utSchemaPascalTypes;
 
 type
 

+ 513 - 0
packages/fcl-jsonschema/tests/utSchemaPascalTypes.pas

@@ -0,0 +1,513 @@
+unit utSchemaPascalTypes;
+
+{$mode ObjFPC}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testregistry, fpjson, fpjson.schema.types, fpjson.schema.pascaltypes, fpjson.schema.schema;
+
+Type
+
+  { TTestSchemaPascalType }
+
+  TTestSchemaPascalType = class(TTestCase)
+  private
+    FSchema: TJSONSchema;
+    FSchemaData: TSchemaData;
+    FType : TPascalTypeData;
+    function DefineProperty(aName: string; aType: TSchemaSimpleType; aFormat: String='') : TJSONSchema;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+    procedure DoAddProperties;
+    procedure AssertEquals(const Msg: string; aExpected, aActual: TPascalType); overload;
+    function AssertPascalTypeData(const Msg: string; aType: TPascalTypeData; aPascaltype: TPascalType; const aSchemaName, aPascalName: String) : TPascalTypeData;
+    procedure AssertProperty(Msg: String; aType: TPascalTypeData; aIndex: Integer; const aSchemaName, aPascalName, aPascalTypeName: String; aPascalType: TPascalType; aTypeData: TPascalTypeData);
+    Property Schema : TJSONSchema Read FSchema;
+    Property Data : TSchemaData Read FSchemaData;
+  Published
+    Procedure TestHookup;
+    Procedure TestTypeMap;
+    procedure TestCreatePascalType;
+    Procedure TestAddType;
+    Procedure TestAddTypeAlias;
+    Procedure TestStandardTypes;
+    Procedure TestAddPropertiesInteger;
+    procedure TestAddPropertiesInt64;
+    procedure TestAddPropertiesString;
+    procedure TestAddPropertiesStringDate;
+    procedure TestAddPropertiesStringDateTime;
+    procedure TestAddPropertiesStringTime;
+    procedure TestAddPropertiesStringNoEnum;
+    procedure TestAddPropertiesStringEnum;
+    procedure TestAddPropertiesNumber;
+    procedure TestAddPropertiesBoolean;
+    procedure TestAddPropertiesAny;
+    procedure TestAddPropertiesEmptyObject;
+    procedure TestAddPropertiesNone;
+    procedure TestAddPropertiesNull;
+    procedure TestAddPropertiesMulti;
+    procedure TestAddPropertiesArray;
+    procedure TestAddPropertiesArrayDelphi;
+    procedure TestAddPropertiesArrayMultiValue;
+    procedure TestAddPropertiesObject;
+    procedure TestAddPropertiesObjectExisting;
+  end;
+
+implementation
+
+uses TypInfo;
+
+{ TTestSchemaPascalType }
+
+procedure TTestSchemaPascalType.SetUp;
+begin
+  inherited SetUp;
+  FSchemaData:=TSchemaData.Create;
+  Fschema:=TJSONSchema.Create;
+end;
+
+procedure TTestSchemaPascalType.TearDown;
+begin
+  FreeAndNil(FSchema);
+  FreeAndNil(FSchemaData);
+  inherited TearDown;
+end;
+
+procedure TTestSchemaPascalType.AssertEquals(const Msg : string; aExpected, aActual : TPascalType);
+
+begin
+  AssertEquals(Msg,GetEnumName(Typeinfo(TPascalType),Ord(aExpected)),
+                   GetEnumName(Typeinfo(TPascalType),Ord(aActual)));
+end;
+
+function TTestSchemaPascalType.AssertPascalTypeData(const Msg: string; aType: TPascalTypeData; aPascaltype: TPascalType;
+  const aSchemaName, aPascalName: String): TPascalTypeData;
+begin
+  AssertNotNull(Msg+': have type',aType);
+  AssertEquals(Msg+' Schema name',aSchemaName,aType.SchemaName);
+  AssertEquals(Msg+' Pascal name',aPascalName,aType.PascalName);
+  AssertEquals(Msg+' Pascal type',aPascalType,aType.PascalType);
+  Result:=aType;
+end;
+
+procedure TTestSchemaPascalType.TestHookup;
+begin
+  AssertNotNull('Have schema',Data);
+  AssertEquals('No types',0,Data.TypeCount);
+end;
+
+procedure TTestSchemaPascalType.TestTypeMap;
+begin
+  Data.AddAliasToTypeMap(ptInteger,'a','a','b',Nil);
+  AssertEquals('Correct existing map','b',Data.TypeMap['a']);
+  AssertEquals('Correct nonexisting map','c',Data.TypeMap['c']);
+end;
+
+procedure TTestSchemaPascalType.TestCreatePascalType;
+var
+  aType : TPascalTypeData;
+  S : TJSONSchema;
+begin
+  S:=TJSONSchema.Create;
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',S);
+  try
+    AssertPascalTypeData('basic',aType,ptSchemaStruct,'a','Ta');
+    AssertSame('Schema',S,aType.Schema);
+    AssertEquals('Not added to types',0,Data.TypeCount);
+  finally
+    aType.Free;
+    S.Free;
+  end;
+end;
+
+procedure TTestSchemaPascalType.TestAddType;
+var
+  aType : TPascalTypeData;
+begin
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Nil);
+  Data.AddType('a',aType);
+  AssertEquals('Not added to types',1,Data.TypeCount);
+  AssertSame('Can find',aType,Data.FindSchemaTypeData('a'));
+  AssertEquals('Can index',0,Data.IndexOfSchemaType('a'));
+end;
+
+procedure TTestSchemaPascalType.TestAddTypeAlias;
+begin
+  Data.AddAliasToTypeMap(ptInteger,'int','int','integer',Nil);
+  AssertNotNull('Can find',Data.FindSchemaTypeData('int'));
+  AssertEquals('Cannot index',-1,Data.IndexOfSchemaType('int'));
+  AssertEquals('Not added to types',0,Data.Typecount);
+end;
+
+procedure TTestSchemaPascalType.TestStandardTypes;
+begin
+  Data.DefineStandardPascalTypes;
+  AssertPascalTypeData('integer',Data.FindSchemaTypeData('integer'),ptInteger,'integer','integer');
+  AssertPascalTypeData('int64',Data.FindSchemaTypeData('integer','int64'),ptInt64,'integer','int64');
+  AssertPascalTypeData('string',Data.FindSchemaTypeData('string'),ptString,'string','string');
+  AssertPascalTypeData('date-time',Data.FindSchemaTypeData('string--date-time'),ptDateTime,'string','TDateTime');
+  AssertPascalTypeData('date',Data.FindSchemaTypeData('string--date'),ptDateTime,'string','TDateTime');
+  AssertPascalTypeData('time',Data.FindSchemaTypeData('string--time'),ptDateTime,'string','TDateTime');
+  AssertPascalTypeData('boolean',Data.FindSchemaTypeData('boolean'),ptBoolean,'boolean','boolean');
+  AssertPascalTypeData('number',Data.FindSchemaTypeData('number'),ptFloat64,'number','double');
+end;
+
+procedure TTestSchemaPascalType.AssertProperty(Msg : String; aType : TPascalTypeData; aIndex : Integer; const aSchemaName,aPascalName,aPascalTypeName : String; aPascalType : TPascalType; aTypeData : TPascalTypeData);
+
+var
+  lProp : TPascalPropertyData;
+
+begin
+  AssertNotNull(Msg+': have type',aType);
+  AssertTrue(Msg+': have properties',aType.PropertyCount>0);
+  AssertTrue(Msg+': have valid index',aIndex<aType.PropertyCount);
+  lProp:=aType.Properties[aIndex];
+  AssertNotNull(Msg+': have property',lProp);
+  AssertEquals(Msg+': schema name',aSchemaName,lProp.SchemaName);
+  AssertEquals(Msg+': pascal name',aPascalName,lProp.PascalName);
+  AssertEquals(Msg+': Pascal type name',aPascalTypeName,lProp.PascalTypeName);
+  AssertEquals(Msg+': Pascal type',aPascalType,lProp.PropertyType);
+  AssertSame(Msg+': Type data',aTypeData,lProp.TypeData);
+end;
+
+function TTestSchemaPascalType.DefineProperty(aName: string; aType: TSchemaSimpleType; aFormat: String): TJSONSchema;
+
+begin
+  Data.DefineStandardPascalTypes;
+  Result:=TJSONSchema.Create;
+  Result.Name:=aName;
+  Result.Validations.Types:=[aType];
+  if aFormat<>'' then
+    Result.Validations.Format:=aFormat;
+  Schema.Properties.Add(Result);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesInteger;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstInteger,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Integer',aType,0,'b','b','integer',ptInteger,Data.FindSchemaTypeData('integer'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesInt64;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstInteger,'int64');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Int64',aType,0,'b','b','int64',ptInt64,Data.FindSchemaTypeData('integer','int64'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesString;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstString,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('String',aType,0,'b','b','string',ptString,Data.FindSchemaTypeData('string'));
+end;
+
+
+procedure TTestSchemaPascalType.TestAddPropertiesStringDate;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstString,'date');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Date',aType,0,'b','b','TDateTime',ptDateTime,Data.FindSchemaTypeData('string','date'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesStringDateTime;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstString,'date-time');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Date',aType,0,'b','b','TDateTime',ptDateTime,Data.FindSchemaTypeData('string','date-time'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesStringTime;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstString,'time');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Date',aType,0,'b','b','TDateTime',ptDateTime,Data.FindSchemaTypeData('string','time'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesStringNoEnum;
+var
+  lProp : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  lprop:=DefineProperty('b',sstString,'');
+  lProp.Validations.Enum:=TJSONArray.Create(['de','fg','hi']);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Enum',aType,0,'b','b','string',ptString,Data.FindSchemaTypeData('string'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesStringEnum;
+var
+  lProp : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  Data.UseEnums:=True;
+  lprop:=DefineProperty('b',sstString,'');
+  lProp.Validations.Enum:=TJSONArray.Create(['de','fg','hi']);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Enum',aType,0,'b','b','Ta_b',ptEnum,Data.FindSchemaTypeData('(a_b)'));
+  AssertSame('Schema in property def',lProp,aType.Properties[0].Schema);
+  AssertSame('Schema in property type def',lProp,Data.FindSchemaTypeData('(a_b)').Schema);
+  AssertEquals('Have 2 public types',2,Data.TypeCount);
+end;
+
+
+procedure TTestSchemaPascalType.TestAddPropertiesNumber;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstNumber,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Number',aType,0,'b','b','double',ptFloat64,Data.FindSchemaTypeData('number'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesBoolean;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstBoolean,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertPascalTypeData('Ta',Data.FindSchemaTypeData('a'),ptSchemaStruct,'a','Ta');
+  AssertProperty('Boolean',aType,0,'b','b','boolean',ptBoolean,Data.FindSchemaTypeData('boolean'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesAny;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstAny,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertProperty('any',aType,0,'b','b','string',ptJSON,Data.FindSchemaTypeData('any'));
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesEmptyObject;
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstObject,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertProperty('any',aType,0,'b','b','string',ptJSON,Data.FindSchemaTypeData('JSON'));
+end;
+
+
+procedure TTestSchemaPascalType.DoAddProperties;
+
+begin
+  Data.AddPropertiesToType(FType);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesNone;
+
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstNone,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  FType:=aType;
+  AssertException('type none not allowed', ESchemaData, @DoAddProperties);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesNull;
+var
+  aType : TPascalTypeData;
+
+begin
+  DefineProperty('b',sstNull,'');
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  FType:=aType;
+  AssertException('type null not allowed', ESchemaData, @DoAddProperties);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesMulti;
+var
+  lProp : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  lProp:=DefineProperty('b',sstString,'');
+  lProp.Validations.Types:=[sstString,sstNumber];
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  FType:=aType;
+  AssertException('multiple types not allowed', ESchemaData, @DoAddProperties);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesArray;
+
+var
+  lProp,lElement : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  lProp:=DefineProperty('b',sstArray,'');
+  lElement:=TJSONSchema.Create;
+  lElement.Validations.Types:=[sstString];
+  lProp.Items.Add(lElement);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertProperty('array',aType,0,'b','b','Array of string',ptArray,Data.FindSchemaTypeData('[string]'));
+  AssertSame('Schema in property def',lProp,aType.Properties[0].Schema);
+  AssertSame('Schema in property type def',lProp,Data.FindSchemaTypeData('[string]').Schema);
+  AssertEquals('Have 2 public types',2,Data.TypeCount);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesArrayDelphi;
+var
+  lProp,lElement : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  Data.DelphiTypes:=True;
+  lProp:=DefineProperty('b',sstArray,'');
+  lElement:=TJSONSchema.Create;
+  lElement.Validations.Types:=[sstString];
+  lProp.Items.Add(lElement);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertProperty('array',aType,0,'b','b','TArray<string>',ptArray,Data.FindSchemaTypeData('[string]'));
+  AssertEquals('Have 2 public types',2,Data.TypeCount);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesArrayMultiValue;
+var
+  lProp,lElement : TJSONSchema;
+  aType : TPascalTypeData;
+
+begin
+  lProp:=DefineProperty('b',sstArray,'');
+  lElement:=TJSONSchema.Create;
+  lElement.Validations.Types:=[sstString];
+  lProp.Items.Add(lElement);
+  lElement:=TJSONSchema.Create;
+  lElement.Validations.Types:=[sstInteger];
+  lProp.Items.Add(lElement);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  FType:=aType;
+  AssertException('multiple value types in array not allowed', ESchemaData, @DoAddProperties);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesObject;
+
+var
+  lProp,lElement : TJSONSchema;
+  aType,aType2 : TPascalTypeData;
+
+begin
+  lProp:=DefineProperty('b',sstObject,'');
+  lElement:=TJSONSchema.Create;
+  lElement.Name:='c';
+  lElement.Validations.Types:=[sstString];
+  lProp.Properties.Add(lElement);
+  lElement:=TJSONSchema.Create;
+  lElement.Name:='d';
+  lElement.Validations.Types:=[sstInteger];
+  lProp.Properties.Add(lElement);
+  aType:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType);
+  Data.AddPropertiesToType(aType);
+  AssertProperty('array',aType,0,'b','b','Ta_b',ptAnonStruct,Data.FindSchemaTypeData('{a_b}'));
+  AssertSame('Schema in property def',lProp,aType.Properties[0].Schema);
+  AssertSame('Schema in property type def',lProp,Data.FindSchemaTypeData('{a_b}').Schema);
+  aType2:=Data.FindSchemaTypeData('{a_b}');
+  AssertProperty('sub prop 1',aType2,0,'c','c','string',ptString,Data.FindSchemaTypeData('string'));
+  AssertProperty('sub prop 2',aType2,1,'d','d','integer',ptInteger,Data.FindSchemaTypeData('integer'));
+  AssertEquals('Have 2 public types',2,Data.TypeCount);
+  Data.CheckDependencies;
+  AssertEquals('type depends on created subtype',1,aType.DependencyCount);
+  AssertSame('type depends on created subtype',aType2,aType.Dependency[0]);
+end;
+
+procedure TTestSchemaPascalType.TestAddPropertiesObjectExisting;
+
+var
+  lProp : TJSONSchema;
+  aType1,aType2 : TPascalTypeData;
+begin
+  aType1:=Data.CreatePascalType(0,ptSchemaStruct,'a','Ta',Schema);
+  Data.AddType('a',aType1);
+  aType2:=Data.CreatePascalType(1,ptSchemaStruct,'b','Tb',Nil);
+  Data.AddType('b',aType2);
+  lProp:=DefineProperty('c',sstObject,'');
+  lProp.Ref:='b';
+  Data.AddPropertiesToType(aType1);
+  AssertProperty('prop 1',aType1,0,'c','c','Tb',ptSchemaStruct,aType2);
+end;
+
+initialization
+   RegisterTest(TTestSchemaPascalType);
+end.
+