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'' 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','TStringDynArray',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',1,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','TStringDynArray',ptArray,Data.FindSchemaTypeData('[string]')); AssertEquals('Have 2 public types',1,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.