diff --git a/.gitattributes b/.gitattributes index 96944fd7e8..4ffcb65589 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2516,13 +2516,17 @@ packages/fcl-json/fpmake.pp svneol=native#text/plain packages/fcl-json/src/README.txt svneol=native#text/plain packages/fcl-json/src/fpjson.pp svneol=native#text/plain packages/fcl-json/src/fpjsonrtti.pp svneol=native#text/plain +packages/fcl-json/src/fpjsontopas.pp svneol=native#text/plain packages/fcl-json/src/jsonconf.pp svneol=native#text/plain packages/fcl-json/src/jsonparser.pp svneol=native#text/plain packages/fcl-json/src/jsonscanner.pp svneol=native#text/plain packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain +packages/fcl-json/tests/tcjsontocode.pp svneol=native#text/plain packages/fcl-json/tests/testcomps.pp svneol=native#text/plain packages/fcl-json/tests/testjson.lpi svneol=native#text/plain packages/fcl-json/tests/testjson.pp svneol=native#text/plain +packages/fcl-json/tests/testjson2code.lpi svneol=native#text/plain +packages/fcl-json/tests/testjson2code.lpr svneol=native#text/plain packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain packages/fcl-json/tests/testjsonconf.pp svneol=native#text/plain packages/fcl-json/tests/testjsondata.pp svneol=native#text/plain diff --git a/packages/fcl-json/fpmake.pp b/packages/fcl-json/fpmake.pp index 743d444c2e..9b2076c741 100644 --- a/packages/fcl-json/fpmake.pp +++ b/packages/fcl-json/fpmake.pp @@ -31,31 +31,42 @@ begin P.SourcePath.Add('src'); T:=P.Targets.AddUnit('fpjson.pp'); - T.ResourceStrings:=true; + T.ResourceStrings:=true; + T:=P.Targets.AddUnit('jsonconf.pp'); - T.ResourceStrings:=true; - with T.Dependencies do - begin - AddUnit('fpjson'); - AddUnit('jsonparser'); - end; + T.ResourceStrings:=true; + with T.Dependencies do + begin + AddUnit('fpjson'); + AddUnit('jsonparser'); + end; + T:=P.Targets.AddUnit('jsonparser.pp'); - T.ResourceStrings:=true; - with T.Dependencies do - begin - AddUnit('fpjson'); - AddUnit('jsonscanner'); - end; + T.ResourceStrings:=true; + with T.Dependencies do + begin + AddUnit('fpjson'); + AddUnit('jsonscanner'); + end; + T:=P.Targets.AddUnit('jsonscanner.pp'); - T.ResourceStrings:=true; + T.ResourceStrings:=true; + T:=P.Targets.AddUnit('fpjsonrtti.pp'); - T.ResourceStrings:=true; - with T.Dependencies do - begin - AddUnit('fpjson'); - AddUnit('jsonparser'); - end; - T.ResourceStrings:=true; + T.ResourceStrings:=true; + with T.Dependencies do + begin + AddUnit('fpjson'); + AddUnit('jsonparser'); + end; + + T:=P.Targets.AddUnit('fpjsontopas.pp'); + T.ResourceStrings:=true; + with T.Dependencies do + begin + AddUnit('fpjson'); + AddUnit('jsonparser'); + end; P.ExamplePath.Add('examples'); T:=P.Targets.AddExampleProgram('confdemo.pp'); diff --git a/packages/fcl-json/src/fpjsontopas.pp b/packages/fcl-json/src/fpjsontopas.pp new file mode 100644 index 0000000000..6396c1dbf9 --- /dev/null +++ b/packages/fcl-json/src/fpjsontopas.pp @@ -0,0 +1,1279 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 2016 by Michael Van Canneyt + + Converter unit to convert JSON object to object pascal classes. + + 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 fpjsontopas; + +// TODO : Array of Array LoadFromJSON/SaveToJSON + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpjson, jsonparser; + +Type + EJSONToPascal = Class(EJSON); + + { TPropertyMapItem } + TPropertyMapItem = Class(TCollectionItem) + private + FGenerated: Boolean; + FJSONType: TJSONType; + FParentTypeName: String; + FPath: String; + FPropertyName: String; + FSkipType: Boolean; + FTypeName: String; + Public + Procedure Assign(Source: TPersistent); override; + Property Generated : Boolean Read FGenerated; + Published + Property Path : String Read FPath Write FPath; + Property TypeName : String Read FTypeName Write FTypeName; + Property ParentTypeName : String Read FParentTypeName Write FParentTypeName; + Property PropertyName : String Read FPropertyName Write FPropertyName; + Property JSONType : TJSONType Read FJSONType write FJSONType; + // Set this to true if no class/array should be generated + Property SkipType : Boolean Read FSkipType Write FSkipType; + end; + + TPropertyMap = Class(TCollection) + private + function GetM(Aindex : Integer): TPropertyMapItem; + procedure SetM(Aindex : Integer; AValue: TPropertyMapItem); + Public + Function AddPath(Const APath,ATypeName : String) : TPropertyMapItem; + Function IndexOfPath(Const APath : String) : Integer; + Function FindPath(Const APath : String) : TPropertyMapItem; + Property Map[Aindex : Integer] : TPropertyMapItem Read GetM Write SetM; Default; + end; + + { TJSONToPascal } + TJSONToPascalOption = (jpoUseSetter,jpoGenerateLoad,jpoUnknownLoadPropsError,jpoDelphiJSON, jpoLoadCaseInsensitive,jpoGenerateSave); + TJSONToPascalOptions = set of TJSONToPascalOption; + + TJSONToPascal = Class(TComponent) + private + FExtraUnitNames: String; + FFieldPrefix: String; + FIndent : String; + FActive : Boolean; + FCode : TStrings; + FDefaultParentName : String; + FDestUnitName : String; + FIndentSize : Integer; + FJSON : TJSONStringType; + FJSONData: TJSONData; + FJSONStream: TStream; + FObjectConstructorArguments: String; + FOptions: TJSONToPascalOptions; + FPropertyMap: TPropertyMap; + FPropertyTypeSuffix: String; + FinType : Boolean; // State + procedure GenerateSaveFunctionForm(M: TPropertyMapItem); + function GetObjectConstructorArguments: String; + function JSONDataName: String; + procedure MaybeEmitType; + procedure SetActive(AValue: Boolean); + procedure SetCode(AValue: TStrings); + procedure SetJSON(AValue: TJSONStringType); + procedure SetPropertyMap(AValue: TPropertyMap); + Protected + Procedure AddSemiColonToLastLine; + Procedure Indent; + Procedure Undent; + Procedure AddLn(Const Line : String); + Procedure AddLn(Const Fmt : String; Const Args : Array of const); + Procedure AddIndented(Const Line : String); + Procedure AddIndented(Const Fmt : String; Const Args : Array of const); + Function CreatePropertyMap : TPropertyMap; virtual; + Function GetJSONData(Out FreeResult : Boolean) : TJSONData; virtual; + function IsDateTimeValue(const AValue: String): Boolean; virtual; + Function GetDefaultParentName : String; + function GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String; virtual; + function PathToTypeName(const APath: String): String; virtual; + function AddToPath(const APath, AName: String): String; + class function CleanPropertyName(const AName: String): string; + function GetPropertyName(const APath, AName: String): String; + + // Called for each type + function GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String ): String; + function GenerateAssignDelphi(IM: TPropertyMapItem; AVarName, AJSONName: String; AddSemiColon : Boolean ): String; + procedure GenerateCreateArray(M: TPropertyMapItem); + procedure GenerateSaveArray(M: TPropertyMapItem); + procedure GenerateCreateObjectfpJSON(M: TPropertyMapItem); + procedure GenerateLoadJSONDelphi(M: TPropertyMapItem; J: TJSONObject); + procedure GenerateLoadJSONfpJSON(M: TPropertyMapItem; J: TJSONObject); + procedure GenerateSaveJSONDelphi(M: TPropertyMapItem; J: TJSONObject); + procedure GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject); + Function GenerateArrayDeclaration(M: TPropertyMapItem; J: TJSONArray) : Boolean; virtual; + procedure GenerateObjectDeclaration(M: TPropertyMapItem; J: TJSONObject); virtual; + procedure GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray); virtual; + procedure GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject); virtual; + // Top level routines + Function GetExtraUnitNames : String; virtual; + Procedure ClearGeneratedTypes;virtual; + Procedure GenerateInterfaceHeader;virtual; + procedure GenerateDeclaration(const APath : String; J: TJSONData); virtual; + Procedure GenerateImplementationHeader;virtual; + Procedure GenerateImplementation(const APath: String; J: TJSONData); virtual; + Procedure GenerateImplementationEnd;virtual; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Procedure Execute; + // JSON Data to generate code from. + Property JSONData : TJSONData Read FJSONData Write FJSONData; + // JSON Data (in stream form) to generate code from. JSONData takes prioroty over this property. + Property JSONStream : TStream Read FJSONStream Write FJSONStream; + Published + // Setting this to true will call execute. Can be used to generate code in the IDE. + Property Active : Boolean Read FActive Write SetActive; + // Options to use. + Property Options : TJSONToPascalOptions Read FOptions Write FOptions; + // The JSON to use. JSONData/JSONStream take priority over this property. + Property JSON : TJSONStringType Read FJSON Write SetJSON; + // This string + Property Code : TStrings Read FCode Write SetCode; + // Type information for generated types. After Execute, this will contain generated/detected types for all properties. + Property PropertyMap : TPropertyMap Read FPropertyMap Write SetPropertyMap; + // Generated unit name. + Property DestUnitName : String Read FDestUnitName Write FDestUnitName; + // Default Parent class name when declaring objects. Can be overridden per property. + Property DefaultParentName: String Read FDefaultParentName Write FDefaultParentName; + // Indent size + Property IndentSize : Integer Read FIndentSize Write FIndentSize default 2; + // These units (comma separated list) will be added to the interface uses clause. + Property ExtraUnitNames : String Read FExtraUnitNames Write FExtraUnitNames; + // This will be suffixed to an object/array type name when the propert map is constructed. + Property PropertyTypeSuffix : String Read FPropertyTypeSuffix Write FPropertyTypeSuffix; + // First letter for field name. + Property FieldPrefix : String Read FFieldPrefix Write FFieldPrefix; + // What are the arguments to a constructor ? This property is inserted literally in the code between (). + Property ObjectConstructorArguments : String Read FObjectConstructorArguments Write FObjectConstructorArguments; + end; + + + +implementation + +{$IFDEF VER2_6_4} +Const + StructuredJSONTypes = [jtArray,jtObject]; +{$ENDIF} + +{ TPropertyMap } + +function TPropertyMap.GetM(Aindex : Integer): TPropertyMapItem; +begin + Result:=Items[AIndex] as TPropertyMapItem; +end; + +procedure TPropertyMap.SetM(Aindex : Integer; AValue: TPropertyMapItem); +begin + Items[AIndex]:=AValue; +end; + +function TPropertyMap.AddPath(const APath, ATypeName: String): TPropertyMapItem; +begin + Result:=Add as TPropertyMapItem; + Result.Path:=APath; + Result.TypeName:=ATypeName; +end; + +function TPropertyMap.IndexOfPath(const APath: String): Integer; +begin + Result:=Count-1; + While (Result>=0) and (GetM(Result).Path<>APath) do + Dec(Result); +end; + +function TPropertyMap.FindPath(const APath: String): TPropertyMapItem; + +Var + I : Integer; + +begin + I:=IndexOfPath(APath); + If I=-1 then + Result:=Nil + else + Result:=GetM(I); +end; + +{ TJSONToPascal } + +class function TJSONToPascal.CleanPropertyName(const AName: String): string; + +Const + KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+ + 'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+ + 'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+ + 'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+ + 'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+ + 'as;class;dispinterface;except;exports;finalization;finally;initialization;'+ + 'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+ + 'private;published;length;setlength;'; +Var + I : Integer; + +begin + Result:=Aname; + For I:=Length(Result) downto 1 do + If Not ((Upcase(Result[i]) in ['_','A'..'Z']) + or ((I>1) and (Result[i] in (['0'..'9'])))) then + Delete(Result,i,1); + if Pos(';'+lowercase(Result)+';',KW)<>0 then + Result:='_'+Result +end; + +procedure TJSONToPascal.SetActive(AValue: Boolean); +begin + if (FActive=AValue) then Exit; + if AValue then + Execute; +end; + +procedure TJSONToPascal.SetCode(AValue: TStrings); +begin + if FCode=AValue then Exit; + FCode.Assign(AValue); +end; + +procedure TJSONToPascal.SetJSON(AValue: TJSONStringType); +begin + if FJSON=AValue then Exit; + FJSON:=AValue; +end; + +procedure TJSONToPascal.SetPropertyMap(AValue: TPropertyMap); +begin + if FPropertyMap=AValue then Exit; + FPropertyMap.Assign(AValue); +end; + +procedure TJSONToPascal.AddSemiColonToLastLine; + +Var + I : Integer; + +begin + I:=FCode.Count-1; + FCode[I]:=FCode[I]+';' +end; + +procedure TJSONToPascal.Indent; +begin + FIndent:=Findent+StringOfChar(' ',FIndentSize); +end; + +procedure TJSONToPascal.Undent; + +Var + L : Integer; + +begin + L:=Length(FIndent); + Dec(L,FIndentSize); + if L<0 then L:=0; + FIndent:=Copy(FIndent,1,L); +end; + +procedure TJSONToPascal.AddLn(const Line: String); +begin + FCode.Add(FIndent+Line); +end; + +procedure TJSONToPascal.AddLn(const Fmt: String; const Args: array of const); +begin + AddLn(Format(Fmt,Args)); +end; + +procedure TJSONToPascal.AddIndented(const Line: String); +begin + Indent; + AddLn(Line); + Undent; +end; + +procedure TJSONToPascal.AddIndented(const Fmt: String; + const Args: array of const); +begin + Indent; + AddLn(Fmt,Args); + Undent; +end; + +constructor TJSONToPascal.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FCode:=TStringList.Create; + FPropertyMap:=CreatePropertyMap; + FIndentSize:=2; + FFieldPrefix:='F'; +end; + +destructor TJSONToPascal.Destroy; +begin + FreeAndNil(FCode); + FreeAndNil(FPropertyMap); + inherited Destroy; +end; + +function TJSONToPascal.CreatePropertyMap: TPropertyMap; + +begin + Result:=TPropertyMap.Create(TPropertyMapItem); +end; + +function TJSONToPascal.GetJSONData(out FreeResult: Boolean): TJSONData; + +Var + D : TJSONData; + +begin + FreeResult:=not Assigned(FJSONData); + if Not FreeResult then + Exit(FJSONData); + Result:=Nil; + If Assigned(JSONStream) then + D:=GetJSON(JSONStream) + else if (JSON<>'') then + D:=GetJSON(JSON) + else + Raise EJSONToPascal.Create('Need one of JSONObject, JSONStream or JSON to be set'); + If Not (D.JSONType in [jtObject,jtArray]) then + begin + FreeAndNil(D); + Raise EJSONToPascal.Create('Provided JSONStream or JSON is not a JSON Object or array'); + end; + Result:=D; +end; + +function TJSONToPascal.GetExtraUnitNames: String; +begin + Result:=FExtraUnitNames; +end; + +procedure TJSONToPascal.ClearGeneratedTypes; + +Var + I : integer; + +begin + For i:=FPropertyMap.Count-1 downto 0 do + if FPropertyMap[i].Generated then + FPropertyMap.Delete(I); +end; + +procedure TJSONToPascal.GenerateInterfaceHeader; + +Var + S: string; +begin + AddLn('unit %s;',[DestUnitName]); + Addln(''); + Addln('interface'); + Addln(''); + S:=Trim(GetExtraUnitNames); + if (S<>'') and (S[1]<>',') then + S:=', '+S; + if jpoDelphiJSON in Options then + S:='JSON'+S + else + S:='fpJSON'+S; + S:='SysUtils, Classes, '+S; + Addln('uses %s;',[s]); + Addln(''); +end; + + +function TJSONToPascal.PathToTypeName(const APath: String): String; + +begin + Result:=StringReplace(Apath,'.','',[rfReplaceAll]); + Result:=StringReplace(Result,'[0]','Item',[rfReplaceAll]); + Result:=StringReplace(Result,'[]','Item',[rfReplaceAll]); + if Result='' then + Result:='TMyObject' + else + Result:='T'+Result+PropertyTypeSuffix; +end; + +function TJSONToPascal.IsDateTimeValue(const AValue: String): Boolean; + +Var + D : TDateTime; + +begin + Result:=TryStrToDate(AValue,D); + if Not Result then + Result:=TryStrToTime(AValue,D); + if Not Result then + Result:=TryStrToDateTime(AValue,D); +end; + +function TJSONToPascal.GetDefaultParentName: String; +begin + Result:=FDefaultParentName; + if Result='' then + Result:='TObject'; +end; + +Resourcestring + SErrCannotDetermineType = 'Cannot determine type for %s : Not in type map'; + SErrCannotDeterminePropertyType = 'Cannot determine property type for %s'; + SErrCannotGenerateArrayDeclaration = 'Cannot generate array declaration from empty array at "%s"'; + +function TJSONToPascal.GetPropertyTypeName(const APath, AName: String; AValue: TJSONData): String; + +Var + M : TPropertyMapItem; + IP : String; + +begin + Case AValue.JSONType of + jtBoolean : Result:='Boolean'; + jtNull : Result:='Boolean'; + jtNumber : + Case TJSONNumber(AValue).NumberType of + ntFloat : Result:='Double'; + ntInt64 : Result:='Int64'; + ntInteger : Result:='Integer'; + end; + jtString : + if not IsDateTimeValue(AValue.AsString) then + Result:='String' + else + Result:='TDateTime'; + jtArray: + begin + IP:=AddToPath(APath,AName); + M:=FPropertyMap.FindPath(IP); + If (M=Nil) then + raise EJSONToPascal.CreateFmt(SErrCannotDetermineType, [IP]); + if M.TypeName='' then + M.TypeName:='Array of '+GetPropertyTypeName(AddToPath(APath,AName)+'[0]','Item',TJSONArray(AValue)[0]); + Result:=M.TypeName; + end; + jtObject : + begin + M:=FPropertyMap.FindPath(AddToPath(APath,AName)); + If (M=Nil) then // Can happen in case of [ [ {} ] ] + M:=FPropertyMap.AddPath(AddToPath(APath,AName),''); +// Raise EJSONToPascal.CreateFmt('Cannot determine type for %s.%s : Not in type map',[APath,AName]); + if M.TypeName='' then + M.TypeName:=PathToTypeName(AddToPath(APath,AName)); + if M.ParentTypeName='' then + M.ParentTypeName:=GetDefaultParentName; + Result:=M.TypeName; + end; + end; +end; + +function TJSONToPascal.GetPropertyName(const APath, AName: String): String; + +begin + Result:=CleanPropertyName(AName); +end; + +function TJSONToPascal.JSONDataName: String; + +begin + if jpoDelphiJSON in options then + Result:='TJSONValue' + else + Result:='TJSONData'; +end; + +function TJSONToPascal.GenerateArrayDeclaration(M: TPropertyMapItem; + J: TJSONArray): Boolean; + +Var + IP : String; + IM : TPropertyMapItem; + B : Boolean; + +begin + Result:=False; + IP:=AddToPath(M.Path,'[0]'); + IM:=FPropertyMap.FindPath(IP); + AddLn('%s = Array of %s;',[M.TypeName,IM.TypeName]); + B:=([jpoGenerateLoad,jpoGenerateSave] * options)<>[]; + if B then + begin + Undent; + AddLn(''); + end; + if jpoGenerateLoad in options then + AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]); + if jpoGenerateSave in options then + begin + AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray); overload;',[M.TypeName,M.TypeName]); + AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray; overload;',[M.TypeName,M.TypeName]); + end; + AddLn(''); + if B then + begin + Indent; + FinType:=False; + Result:=True; + end; +end; + +procedure TJSONToPascal.GenerateObjectDeclaration(M : TPropertyMapItem; J: TJSONObject); + +Var + E : TJSONEnum; + IM : TPropertyMapItem; + IP, FRN,FWN : String; + HaveObj : Boolean; + +begin + HaveObj:=False; + Addln(''); + AddLn('{ -----------------------------------------------------------------------'); + Addln(' '+M.TypeName); + AddLn(' -----------------------------------------------------------------------}'); + Addln(''); + AddLn('%s = class(%s)',[M.TypeName,M.ParentTypeName]); + Addln('Private'); + Indent; + For E in J do + begin + IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key)); + If IM=Nil then + begin + IM:=FPropertyMap.Add as TPropertyMapItem; + IM.Path:=AddToPath(M.Path,E.Key); + IM.FGenerated:=True; + end; + if IM.TypeName='' then + IM.TypeName:=GetPropertyTypeName(M.Path,E.Key,E.Value); + if IM.PropertyName='' then + IM.PropertyName:=GetPropertyName(M.Path,E.Key); + IM.JSONType:=E.Value.JSONtype; + AddLn('F%s : %s;',[IM.PropertyName,IM.TypeName]); + HaveObj:=HaveObj or (IM.JSONType=jtObject); + end; + Undent; + if jpoUseSetter in Options then + begin + Addln('Protected'); + Indent; + For E in J do + begin + IM:=FPropertyMap.FindPath(AddToPath(M.Path,E.Key)); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [AddToPath(M.Path, E.Key)]); + FRN:=FieldPrefix+IM.PropertyName; + AddLn('Procedure Set%s(AValue : %s); virtual;',[IM.PropertyName,IM.TypeName]); + end; + Undent; + end; + Addln('Public'); + Indent; + if HaveObj then + AddLn('Destructor Destroy; override;'); + if jpoGenerateLoad in options then + begin + AddLn('Constructor CreateFromJSON(AJSON : %s); virtual;',[JSONDataName]); + AddLn('Procedure LoadFromJSON(AJSON : %s); virtual;',[JSONDataName]); + end; + if jpoGenerateSave in options then + begin + AddLn('Function SaveToJSON : TJSONObject; overload;'); + AddLn('Procedure SaveToJSON(AJSON : TJSONObject); overload; virtual;'); + end; + + For E in J do + begin + IP:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(IP); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [IP]); + FRN:=FieldPrefix+IM.PropertyName; + if jpoUseSetter in Options then + FWN:='Set'+IM.PropertyName + else + FWN:=FRN; + AddLn('Property %s : %s Read %s Write %s;',[IM.PropertyName,IM.TypeName,FRN, FWN]); + end; + Undent; + AddLn('end;'); +end; + +function TJSONToPascal.AddToPath(const APath, AName: String): String; + +begin + Result:=APath; + if (AName<>'') then + begin + if (Result<>'') and (AName[1]<>'[') then + Result:=Result+'.'; + Result:=Result+AName; + end; +end; + +procedure TJSONToPascal.MaybeEmitType; + +begin + if FinType then exit; + Undent; + AddLn('Type'); + Indent; + FinType:=True; +end; + +procedure TJSONToPascal.GenerateDeclaration(const APath: String;J: TJSONData); + +Var + M : TPropertyMapItem; + O : TJSONEnum; + IP : String; + +begin + AddLn(''); + MaybeEmitType; + M:=FPropertyMap.FindPath(APath); + If M=Nil then + begin + M:=FPropertyMap.Add as TPropertyMapItem; + M.Path:=APath; + M.FGenerated:=True; + end + else if M.SkipType then + exit; + if (M.TypeName='') then + if J.JSONType in StructuredJSONtypes then + M.TypeName:=PathToTypeName(APath) + else + M.TypeName:=GetPropertyTypeName(APath,'',J); + M.JSONType:=J.JSONType; + if J is TJSONArray then + begin + M.ParentTypeName:=''; + if J.Count=0 then + raise EJSONToPascal.CreateFmt(SErrCannotGenerateArrayDeclaration, [APath]); + IP:=AddToPath(M.Path,'[0]'); + GenerateDeclaration(IP,J.Items[0]); + MaybeEmitType; + GenerateArrayDeclaration(M,TJSONarray(J)); + end + else if J is TJSONObject then + begin + For O in TJSONOBject(J) do + begin + IP:=AddToPath(APath,O.Key); + GenerateDeclaration(IP,O.Value); + end; + M.ParentTypeName:=GetDefaultParentName; + MaybeEmitType; + GenerateObjectDeclaration(M,TJSONObject(J)); + end; +end; + +procedure TJSONToPascal.GenerateImplementationHeader; +begin + Addln(''); + Addln('implementation'); + Addln(''); +end; + +procedure TJSONToPascal.GenerateArrayImplementation(M : TPropertyMapItem; J: TJSONArray); + +Var + IM : TPropertyMapItem; + P : String; + +begin + P:=AddToPath(M.Path,'[0]'); + IM:=FPropertyMap.FindPath(P); + if J.Items[0] is TJSONObject then + GenerateObjectImplementation(IM,J.Items[0] as TJSONObject) + else if J.Items[0] is TJSONArray then + GenerateArrayImplementation(IM,J.Items[0] as TJSONArray); + if jpoGenerateLoad in Options then + GenerateCreateArray(M); + if jpoGenerateSave in Options then + GenerateSaveArray(M) + // Do nothing yet +end; + +procedure TJSONToPascal.GenerateCreateArray(M : TPropertyMapItem); + +Var + IP : String; + IM : TPropertyMapItem; + +begin + IP:=AddToPath(M.Path,'[0]'); + IM:=FPropertyMap.FindPath(IP); + AddLn(''); + AddLn('Function Create%s(AJSON : %s) : %s;',[M.TypeName,JSONDataName,M.TypeName]); + AddLn(''); + AddLn('var'); + AddIndented('I : integer;'); + if (jpoDelphiJSON in Options) then + AddIndented('A : TJSONArray;'); + AddLn(''); + AddLn('begin'); + Indent; + if not (jpoDelphiJSON in Options) then + begin + AddLn('SetLength(Result,AJSON.Count);'); + AddLn('For I:=0 to AJSON.Count-1 do'); + AddIndented(GenerateAssign(IM,'Result[i]','AJSON.Items[i]')); + end + else + begin + AddLn('A:=AJSON as TJSONArray;'); + AddLn('SetLength(Result,A.Count);'); + AddLn('For I:=0 to A.Count-1 do'); + AddIndented(GenerateAssignDelphi(IM,'Result[i]','A.Items[i]',True)); + end; + Undent; + Addln('End;'); + AddLn(''); +end; + +procedure TJSONToPascal.GenerateSaveArray(M : TPropertyMapItem); + +Var + IP : String; + IM : TPropertyMapItem; + +begin + IP:=AddToPath(M.Path,'[0]'); + IM:=FPropertyMap.FindPath(IP); + AddLn(''); + AddLn('Function Save%sToJSON(AnArray : %s) : TJSONArray;',[M.TypeName,M.TypeName]); + AddLn('begin'); + Indent; + Addln('Result:=TJSONArray.Create;'); + Addln('Try'); + AddIndented('Save%sToJSON(AnArray,Result);',[M.TypeName]); + Addln('Except'); + Indent; + Addln('FreeAndNil(Result);'); + Addln('Raise;'); + Undent; + Addln('end;'); + Undent; + Addln('end;'); + AddLn(''); + AddLn(''); + AddLn('Procedure Save%sToJSON(AnArray : %s; AJSONArray : TJSONArray);',[M.TypeName,M.TypeName]); + AddLn(''); + AddLn('var'); + AddIndented('I : integer;'); + AddLn(''); + AddLn('begin'); + Indent; + AddLn('For I:=0 to Length(AnArray)-1 do'); + Case IM.JSONType of + jtObject : AddIndented('AJSONArray.Add(AnArray[i].SaveToJSON);'); + jtArray : AddIndented('AJSONArray.Add(Save%sToJSON(AnArray[i]));',[IM.TypeName]); + else + AddIndented('AJSONArray.Add(AnArray[i]);'); + end; + Undent; + Addln('end;'); + AddLn(''); +end; + +function TJSONToPascal.GetObjectConstructorArguments: String; + +begin + Result:=ObjectConstructorArguments +end; + +procedure TJSONToPascal.GenerateCreateObjectfpJSON(M : TPropertyMapItem); + +Var + IP : String; + IM : TPropertyMapItem; + +begin + IP:=AddToPath(M.Path,'[0]'); + IM:=FPropertyMap.FindPath(IP); + AddLn(''); + Indent; + AddLn('Function CreateObject%s(AnObject : TJSONData) : %s;',[M.TypeName,M.TypeName]); + AddLn(''); + AddLn('begin'); + Indent; + AddLn('Result:='+M.TypeName+'.Create('+GetObjectConstructorArguments+');'); + AddLn('Result.LoadFromJSON(AnObject);'); + Undent; + Addln('End;'); + Undent; + AddLn(''); +end; + +procedure TJSONToPascal.GenerateLoadJSONDelphi(M: TPropertyMapItem; + J: TJSONObject); +Var + IM : TPropertyMapItem; + E : TJSONEnum; + P,K : String; + SElse : String; + +begin + AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONValue);',[M.TypeName]); + Addln(''); + Addln('var'); + AddIndented('P : TJSONPair;'); + AddIndented('O : TJSONObject;'); + AddIndented('PN : String;'); + Addln(''); + Addln('begin'); + Indent; + if (jpoUnknownLoadPropsError in options) then + begin + Addln('if not (AJSON is TJSONObject) then'); + AddIndented('Raise EJSONException.CreateFmt(''"%s" : Cannot load from : "%s"'',[ClassName,AJSON.ClassName]);'); + end + else + Addln('if not (AJSON is TJSONObject) then exit;'); + Addln('O:=AJSON as TJSONObject;'); + Addln('for P in O do'); + Indent; + Addln('begin'); + if jpoLoadCaseInsensitive in Options then + Addln('PN:=LowerCase(P.JSONString.Value);') + else + Addln('PN:=P.JSONString.Value;'); + SElse:=''; + For E in J do + begin + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]); + K:=E.Key; + If jpoLoadCaseInsensitive in Options then + K:=LowerCase(K); + Addln(SElse+'If (PN=''%s'') then',[K]); + IM.JSONType:=E.Value.JSONType; + AddIndented(GenerateAssignDelphi(IM,IM.PropertyName,'P.JSONValue',False)); + if SElse='' then + SElse:='else ' + end; + if (jpoUnknownLoadPropsError in options) then + begin + Addln('else'); + AddIndented('Raise EJSONException.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,PN]);'); + end + else + AddSemiColonToLastLine; + Addln('end;'); // For loop + Undent; + Undent; + Addln('end;'); +end; + +function TJSONToPascal.GenerateAssign(IM: TPropertyMapItem; AVarName, AJSONName: String): String; + +Var + T : String; + C : Boolean; + +begin + T:=''; + Case LowerCase(IM.TypeName) of + 'boolean' : T:='AsBoolean'; + 'string' : T:='AsString'; + 'double' : T:='AsFloat'; + 'integer' : T:='AsInteger'; + 'int64' : T:='AsInt64'; + 'qword' : T:='AsQWord'; + else + if IM.JSONType=jtArray then + Result:=Format('%s:=Create%s(%s);',[AVarName,IM.TypeName,AJSONName]) + else if IM.JSONType=jtObject then + Result:=Format('%s:=%s.CreateFromJSON(%s);',[AVarName,IM.TypeName,AJSONName]) + else + Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]); + end; + if T<>'' then + Result:=Format('%s:=%s.%s;',[AVarName,AJSONName,T]); +end; + +function TJSONToPascal.GenerateAssignDelphi(IM: TPropertyMapItem; AVarName, + AJSONName: String; AddSemiColon: Boolean): String; + +Var + T : String; + +begin + T:=''; + Case LowerCase(IM.TypeName) of + 'boolean' : T:='Boolean'; + 'string' : T:='String'; + 'double' : T:='Double'; + 'integer' : T:='Integer'; + 'int64' : T:='Int64'; + 'qword' : T:='Int64'; + else + if IM.JSONType=jtArray then + Result:=Format('%s:=Create%s(%s)',[AVarName,IM.TypeName,AJSONName]) + else if IM.JSONType=jtObject then + Result:=Format('%s:=%s.CreateFromJSON(%s)',[AVarName,IM.TypeName,AJSONName]) + else + Result:=Format('Raise EJSON.CreateFmt(''"%%s": Cannot handle property of type "%%s"''),[ClassName,''%s'']);',[IM.TypeName]); + end; + if T<>'' then + Result:=Format('%s:=%s.GetValue<%s>',[AVarName,AJSONName,T]); + If AddSemicolon then + Result:=Result+';' +end; + +procedure TJSONToPascal.GenerateLoadJSONfpJSON(M : TPropertyMapItem; J: TJSONObject); + +Var + IM : TPropertyMapItem; + E : TJSONEnum; + P : String; + +begin + AddLn('Procedure %s.LoadFromJSON(AJSON : TJSONData);',[M.TypeName]); + Addln(''); + Addln('var'); + AddIndented('E : TJSONEnum;'); + Addln(''); + Addln('begin'); + Indent; + Addln('for E in AJSON do'); + Indent; + Addln('begin'); + if jpoLoadCaseInsensitive in Options then + Addln('case lowercase(E.Key) of') + else + Addln('case E.Key of'); + For E in J do + begin + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]); + if jpoLoadCaseInsensitive in Options then + Addln('''%s'':',[LowerCase(E.Key)]) + else + Addln('''%s'':',[E.Key]); + IM.JSONType:=E.Value.JSONType; + AddIndented(GenerateAssign(IM,IM.PropertyName,'E.Value')); + end; + if (jpoUnknownLoadPropsError in options) then + begin + Addln('else'); + AddIndented('Raise EJSON.CreateFmt(''"%s" : Unknown property : "%s"'',[ClassName,E.Key]);'); + end; + Addln('end;'); // Case + Addln('end;'); // For loop + Undent; + Undent; + Addln('end;'); +end; + +procedure TJSONToPascal.GenerateSaveFunctionForm(M: TPropertyMapItem); + +begin + AddLn('Function %s.SaveToJSON : TJSONObject;',[M.TypeName]); + AddLn('begin'); + Indent; + AddLn('Result:=TJSONObject.Create;'); + AddLn('Try'); + AddIndented('SaveToJSON(Result);'); + AddLn('except'); + Indent; + Addln('FreeAndNil(Result);'); + AddLn('Raise;'); + Undent; + AddLn('end;'); + Undent; + AddLn('end;'); + AddLn(''); +end; + +procedure TJSONToPascal.GenerateSaveJSONDelphi(M: TPropertyMapItem; J: TJSONObject); + +Var + IM : TPropertyMapItem; + E : TJSONEnum; + T,P : String; + B,C : Boolean; // B : Indent called. C : Need to create value + +begin + GenerateSaveFunctionForm(M); + AddLn(''); + AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]); + Addln(''); + Addln('begin'); + Indent; + For E in J do + begin + B:=False; + C:=True; + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]); + Case LowerCase(IM.TypeName) of + 'boolean' : T:='Boolean'; + 'string' : T:='String'; + 'double' : T:='Number'; + 'integer' : T:='Number'; + 'int64' : T:='Number'; + 'qword' : T:='Number'; + else + C:=False; + if IM.JSONType=jtArray then + T:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName]) + else if IM.JSONType=jtObject then + begin + Addln('If Assigned(%s) then',[IM.PropertyName]); + T:=Format('%s.SaveToJSON',[IM.PropertyName]); + B:=True; // Indent called + Indent; + end; + end; + if C then + T:='TJSON'+T+'.Create('+IM.PropertyName+')'; + if (T<>'') then + AddLn('AJSON.AddPair(''%s'',%s);',[E.Key,T]); + if B then + Undent; + end; + Undent; + Addln('end;'); +end; + +procedure TJSONToPascal.GenerateSaveJSONfpJSON(M: TPropertyMapItem; J: TJSONObject); + +Var + IM : TPropertyMapItem; + E : TJSONEnum; + T,P : String; + B : Boolean; + +begin + GenerateSaveFunctionForm(M); + AddLn(''); + AddLn('Procedure %s.SaveToJSON(AJSON : TJSONObject);',[M.TypeName]); + Addln(''); + Addln('begin'); + Indent; + For E in J do + begin + B:=False; + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]); + Case LowerCase(IM.TypeName) of + 'boolean' : T:=IM.PropertyName; + 'string' : T:=IM.PropertyName; + 'double' : T:=IM.PropertyName; + 'integer' : T:=IM.PropertyName; + 'int64' : T:=IM.PropertyName; + 'qword' : T:=IM.PropertyName; + else + if IM.JSONType=jtArray then + t:=Format('Save%sToJSON(%s)',[IM.TypeName,IM.PropertyName]) + else if IM.JSONType=jtObject then + begin + Addln('If Assigned(%s) then',[IM.PropertyName]); + T:=Format('%s.SaveToJSON',[IM.PropertyName]); + B:=True; // Indent called + Indent; + end; + end; + if (T<>'') then + AddLn('AJSON.Add(''%s'',%s);',[E.Key,T]); + if B then + Undent; + end; + Undent; + Addln('end;'); +end; + +procedure TJSONToPascal.GenerateObjectImplementation(M : TPropertyMapItem; J: TJSONObject); + +Var + IM : TPropertyMapItem; + E : TJSONEnum; + P,FRN : String; + HaveObj : Boolean; + +begin + HaveObj:=False; + For E in J do + begin + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM<>Nil then + HaveObj:=HaveObj or (IM.JSONType=jtObject); + end; + Addln(''); + AddLn('{ -----------------------------------------------------------------------'); + Addln(' '+M.TypeName); + AddLn(' -----------------------------------------------------------------------}'); + Addln(''); + if HaveObj then + begin + AddLn('Destructor %s.Destroy;',[M.TypeName]); + Addln(''); + Addln('begin'); + Indent; + For E in J do + begin + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If (IM<>Nil) and (IM.JSONType=jtObject) then + AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');'); + end; + Addln('inherited;'); + Undent; + Addln('end;'); + Addln(''); + end; + Addln(''); + if jpoUseSetter in Options then + For E in J do + begin + P:=AddToPath(M.Path,E.Key); + IM:=FPropertyMap.FindPath(P); + If IM=Nil then + raise EJSONToPascal.CreateFmt(SErrCannotDeterminePropertyType, [P]); + FRN:=FieldPrefix+IM.PropertyName; + AddLn('Procedure %s.Set%s(AValue : %s);',[M.TypeName,IM.PropertyName,IM.TypeName]); + Addln(''); + Addln('begin'); + Indent; + AddLn('if ('+FieldPrefix+IM.PropertyName+'=AValue) then exit;'); + If IM.JSONType=jtObject then + AddLn('FreeAndNil('+FieldPrefix+IM.PropertyName+');'); + AddLn(FieldPrefix+IM.PropertyName+':=AValue;'); + Undent; + Addln('end;'); + Addln(''); + end; + if jpoGenerateLoad in Options then + begin + AddLn('Constructor %s.CreateFromJSON(AJSON : %s);',[M.TypeName,JSONDataName]); + Addln(''); + Addln('begin'); + Indent; + AddLn('Create(%s);',[GetObjectConstructorArguments]); + AddLn('LoadFromJSON(AJSON);'); + Undent; + Addln('end;'); + Addln(''); + if jpoDelphiJSON in options then + GenerateLoadJSONDelphi(M,J) + else + GenerateLoadJSONfpJSON(M,J); + end; + if jpoGenerateSave in Options then + if jpoDelphiJSON in options then + GenerateSaveJSONDelphi(M,J) + else + GenerateSaveJSONfpJSON(M,J); +end; + +procedure TJSONToPascal.GenerateImplementation(const APath: String; J: TJSONData); + +Var + M ,IM : TPropertyMapItem; + O : TJSONEnum; + P : String; + +begin + Addln(''); + M:=FPropertyMap.FindPath(APath); + if M.SkipType then + exit; + if J is TJSONArray then + GenerateArrayImplementation(M,TJSONarray(J)) + else if J is TJSONObject then + begin + For O in TJSONOBject(J) do + begin + P:=AddToPath(APath,O.Key); + IM:=FPropertyMap.FindPath(P); + If (O.Value.JSONType in StructuredJSONTypes) then + GenerateImplementation(P,O.Value); + end; + GenerateObjectImplementation(M,TJSONObject(J)); + end; + Addln(''); +end; + +procedure TJSONToPascal.GenerateImplementationEnd; +begin + Addln('end.'); +end; + +procedure TJSONToPascal.Execute; + +Var + J : TJSONData; + DoFree : Boolean; + +begin + J:=Nil; + DoFree:=False; + Factive:=True; + try + ClearGeneratedTypes; + J:=GetJSONData(DoFree); + GenerateInterfaceHeader; + FInType:=False; + GenerateDeclaration('',J); + Undent; + GenerateImplementationHeader; + GenerateImplementation('',J); + GenerateImplementationEnd; + finally + if DoFree then + FreeAndNil(J); + Factive:=False; + end; +end; + +{ TPropertyMapItem } + +procedure TPropertyMapItem.Assign(Source: TPersistent); + +Var + M : TPropertyMapItem; + +begin + if Source is TPropertyMapItem then + begin + M:=Source as TPropertyMapItem; + FPath:=M.Path; + FTypeName:=M.TypeName; + FParentTypeName:=M.ParentTypeName; + FGenerated:=M.Generated; + end + else + inherited Assign(Source); +end; + +end. + diff --git a/packages/fcl-json/tests/tcjsontocode.pp b/packages/fcl-json/tests/tcjsontocode.pp new file mode 100644 index 0000000000..4fce71088b --- /dev/null +++ b/packages/fcl-json/tests/tcjsontocode.pp @@ -0,0 +1,2422 @@ +unit tcjsontocode; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpcunit, testutils, testregistry, fpjsontopas; + +type + + { TTestGenCode } + + TTestGenCode= class(TTestCase) + private + FPos : Integer; + FGen: TJSONToPascal; + procedure AssertDelphiLoadArray(AElementType, AJSONtype: String); + procedure AssertDelphiPropertyAssignmentLoop; + procedure AssertDestructorImplementation(AClassName: String; ObjectFields: array of string); + procedure AssertLine(Msg: String; AExpected: String); + procedure GenCode(AJSON: String); + class function GetDataName(IsDelphi: Boolean): string; + function NextLine: String; + function Pos(const What, Where: String): Integer; + protected + procedure SetUp; override; + procedure TearDown; override; + procedure AssertArrayCreator(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False); + procedure AssertArraySaver(const ArrayTypeName, AElementType: String; IsDelphi: Boolean=False); + procedure AssertArrayCreatorImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False); + procedure AssertArraySaverImplementation(const ArrayTypeName, AElementType: String; AObjectName: String=''; IsDelphi: Boolean=False); + procedure AssertLoadArray(AElementType, AJSONtype: String; IsDelphi : Boolean = False); + procedure AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False); + procedure AssertPropertyAssignmentLoop; + procedure AssertType; + procedure AssertClassComment(const Msg, AName: String); + procedure AssertLoadConstructorDeclaration(AType: String); + procedure AssertLoaderDeclaration(AType: String); + procedure AssertSaverDeclaration; + procedure AssertLoaderImplementationEnd(IsDelphi : Boolean = False); + procedure AssertLoadConstructorImplementationStart(Const ATypeName, ADataName: String); + procedure AssertLoaderImplementationStart(Const ATypeName, ADataName: String; IsDelphi : Boolean = False); + procedure AssertSaverImplementationStart(Const ATypeName: String; IsDelphi : Boolean = False); + procedure AssertArrayLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False); + procedure AssertObjectLoaderImplementationStart(Const ATypeName, ADataName, ArrayName, ArrayTypeName, ArrayElementType : String; IsDelphi : Boolean = False); + Procedure AssertUnitHeader; + Procedure AssertBegin; + Procedure AssertEnd(Const Msg : String = ''); + Procedure AssertUnitEnd; + Procedure AssertImplementation; + procedure AssertProperty(const AName, AType: String; Setter : Boolean = False); + procedure AssertSetter(const AName, AType: String); + Procedure AssertClassHeader(Const AName : String; AParentName : String); + Procedure AssertSetterImplementation(Const AClassType,AName,AType : String; IsObject : Boolean = False); + Procedure AssertVisibility(Const AVisibility : String); + Procedure AssertDestructor; + Procedure AssertField(Const AName,AType : String; Prefix : String = ''); + Procedure AssertArrayType(Const AName,AItemType : String); + Procedure AssertPropertyMap(Const APath,ATypeName,APropertyName,AParentTypeName : String); + Property Gen : TJSONToPascal Read FGen; + published + procedure TestEmpty; + Procedure TestSimple; + Procedure TestClassName; + Procedure TestParentClassName; + Procedure TestIntegerProperty; + Procedure Test2IntegersProperty; + Procedure TestBooleanProperty; + Procedure TestStringProperty; + Procedure TestFloatProperty; + Procedure TestInt64Property; + Procedure TestPropertySetter; + Procedure TestObjectProperty; + Procedure TestObjectPropertySetter; + Procedure TestObjectPropertySuffix; + Procedure TestObjectPropertySkip; + Procedure TestObjectPropertyRecurse; + Procedure TestObjectPropertyRecurseSuffix; + Procedure TestObjectPropertyRecurseSkip; + Procedure TestObjectPropertyRecurseSkipB; + Procedure TestStringArrayProperty; + Procedure TestIntegerArrayProperty; + Procedure TestBooleanArrayProperty; + Procedure TestFloatArrayProperty; + Procedure TestInt64ArrayProperty; + Procedure TestStringArrayPropertySuffix; + Procedure TestObjectArrayProperty; + procedure TestObjectArrayPropertySuffix; + procedure TestArrayArrayProperty; + procedure TestObjectArrayArrayProperty; + Procedure TestLoadIntegerProperty; + Procedure TestLoad2IntegersProperty; + Procedure TestLoadIntegerWithErrorProperty; + Procedure TestLoadIntegerCaseInsensitiveProperty; + Procedure TestLoadStringProperty; + Procedure TestLoadBooleanProperty; + Procedure TestLoadInt64Property; + Procedure TestLoadFloatProperty; + Procedure TestLoadObjectProperty; + Procedure TestLoadStringArrayProperty; + Procedure TestLoadBooleanArrayProperty; + Procedure TestLoadIntegerArrayProperty; + Procedure TestLoadInt64ArrayProperty; + Procedure TestLoadFloatArrayProperty; + Procedure TestLoadObjectArrayProperty; + Procedure TestLoadDelphiIntegerProperty; + Procedure TestLoadDelphi2IntegersProperty; + Procedure TestLoadDelphiIntegerWithErrorProperty; + Procedure TestLoadDelphiIntegerCaseInsensitiveProperty; + Procedure TestLoadDelphiStringProperty; + Procedure TestLoadDelphiBooleanProperty; + Procedure TestLoadDelphiInt64Property; + Procedure TestLoadDelphiFloatProperty; + procedure TestLoadDelphiObjectProperty; + Procedure TestLoadDelphiStringArrayProperty; + Procedure TestLoadDelphiBooleanArrayProperty; + Procedure TestLoadDelphiIntegerArrayProperty; + Procedure TestLoadDelphiInt64ArrayProperty; + Procedure TestLoadDelphiFloatArrayProperty; + procedure TestLoadDelphiObjectArrayProperty; + Procedure TestSaveIntegerProperty; + Procedure TestSave2IntegersProperty; + Procedure TestSaveStringProperty; + Procedure TestSaveBooleanProperty; + Procedure TestSaveInt64Property; + Procedure TestSaveFloatProperty; + Procedure TestSaveObjectProperty; + Procedure TestSaveStringArrayProperty; + Procedure TestSaveBooleanArrayProperty; + Procedure TestSaveIntegerArrayProperty; + Procedure TestSaveInt64ArrayProperty; + Procedure TestSaveFloatArrayProperty; + Procedure TestSaveObjectArrayProperty; + Procedure TestSaveDelphiIntegerProperty; + Procedure TestSaveDelphi2IntegersProperty; + Procedure TestSaveDelphiStringProperty; + Procedure TestSaveDelphiBooleanProperty; + Procedure TestSaveDelphiInt64Property; + Procedure TestSaveDelphiFloatProperty; + Procedure TestSaveDelphiObjectProperty; + Procedure TestSaveDelphiStringArrayProperty; + Procedure TestSaveDelphiBooleanArrayProperty; + Procedure TestSaveDelphiIntegerArrayProperty; + Procedure TestSaveDelphiInt64ArrayProperty; + Procedure TestSaveDelphiFloatArrayProperty; + Procedure TestSaveDelphiObjectArrayProperty; + end; + +Var + TestUnitDir : String; + +implementation + +procedure TTestGenCode.SetUp; +begin + FGen:=TJSONToPascal.Create(Nil); +end; + +procedure TTestGenCode.TearDown; +begin + FreeAndNil(FGen) +end; + +function TTestGenCode.NextLine: String; + +begin + Result:=''; + While (Result='') do + begin + Inc(FPos); + AssertTrue('In scope',FPos0); +end; + +procedure TTestGenCode.AssertEnd(const Msg: String); +begin + AssertTrue('Have end:'+Msg,pos('end;',nextline)>0); +end; + +procedure TTestGenCode.AssertUnitEnd; +begin + AssertTrue('Have end.',pos('end.',nextline)>0); +end; + +procedure TTestGenCode.AssertImplementation; +begin + AssertTrue('Have implementation',CompareText(NextLine,'implementation')=0); +end; + +function TTestGenCode.Pos(const What, Where: String): Integer; + +begin + Result:=system.Pos(lowercase(what),lowercase(where)); +end; + +procedure TTestGenCode.AssertClassComment(const Msg,AName: String); + +Var + S : String; + +begin + S:=NextLine; + AssertTrue(Msg+' ('+AName+'): Class header comment start',Pos('{ --',S)>0); + S:=NextLine; + AssertTrue(Msg+' ('+AName+'): Class header comment class nam',Pos(AName,S)>0); + S:=NextLine; + AssertTrue(Msg+' ('+AName+'): Class header comment end',Pos('}',S)>0); +end; + +procedure TTestGenCode.AssertClassHeader(const AName: String; AParentName: String); + +Var + P : Integer; + S : String; + +begin + AssertClassComment('Class declarationheader for '+AName,AName); + S:=NextLine; + P:=Pos(AName+' = class(',S); + AssertTrue('class type ',P>0); + P:=Pos(AParentName+')',S); + AssertTrue('Class parent type ',P>0); + AssertVisibility('private'); +end; + +procedure TTestGenCode.AssertSetterImplementation(const AClassType, AName, + AType: String; IsObject: Boolean); + +Var + S,PS : String; + P : Integer; + +begin + S:=NextLine; + PS:='Procedure '+AClassType+'.Set'+Aname+'(AValue'; + AssertTrue('Have declaration start',Pos(PS,S)>0); + Delete(S,1,Length(PS)); + P:=Pos(':',S); + AssertTrue('Have colon' ,p>0); + Delete(S,1,P); + AssertTrue('Have type',Pos(AType,S)>0); + AssertTrue('Have );',Pos(');',S)>0); + AssertTrue('Terminated on semicolon',S[Length(S)]=';'); + AssertBegin; + AssertTrue('Have change check',Pos('if ('+Gen.FieldPrefix+AName+'=AValue) then exit;',NextLine)>0); + if IsObject then + AssertTrue('Have free of previous value',Pos('FreeAndNil('+Gen.FieldPrefix+AName+');',NextLine)>0); + AssertTrue('Have Assignment',Pos(Gen.FieldPrefix+AName+':=AValue;',NextLine)>0); + AssertEnd; +end; + +procedure TTestGenCode.AssertVisibility(const AVisibility: String); + +begin + AssertTrue('Have visibility section '+AVisibility,Pos(AVisibility,NextLine)>0); +end; + +procedure TTestGenCode.AssertDestructor; +begin + AssertTrue('Have destructor declaration',Pos('Destructor Destroy; override;',NextLine)>0); +end; + + +procedure TTestGenCode.AssertDestructorImplementation(AClassName: String; + ObjectFields: array of string); + +Var + F : String; + +begin + AssertTrue('Have destructor implementation',Pos(Format('Destructor %s.Destroy;',[AClassName]),NextLine)>0); + AssertBegin; + For F in ObjectFields do + AssertTrue('Have destructor for F'+F,Pos('FreeAndNil(F'+F+');',NextLine)>0); + AssertTrue('Have inherited call'+F,Pos('Inherited;',NextLine)>0); + AssertEnd; +end; + +procedure TTestGenCode.AssertField(const AName, AType: String; Prefix : String = ''); + +Var + F,S : String; + P : Integer; + +begin + F:=Prefix; + if F='' then + F:='F'; + S:=NextLine; + AssertTrue('Field Name',Pos(F+AName,S)=1); + P:=Pos(':',S); + AssertTrue('Colon after field name',P>Length(F+AName)); + AssertTrue('Field type after colon',Pos(AType,S)>P); + AssertTrue('Terminated on semicolon',S[Length(S)]=';'); +end; + +procedure TTestGenCode.AssertSetter(const AName, AType: String); + +Var + N,S,PD : String; + P,p2 : Integer; + +begin + S:=NextLine; + N:='Setter declaration for '+AName+' : '; + PD:='Procedure Set'+AName; + AssertTrue(N+'Setter name',Pos(PD,S)=1); + P:=Pos('(',S); + AssertTrue(N+'( after parameter name',P>Length(PD)); + P:=Pos(':',S); + AssertTrue(N+'Colon after parameter name',P>Length(PD)); + Delete(S,1,P); + P2:=Pos(AType,S); + AssertTrue(N+'Field type after colon '+AType+' : '+S,P2>0); + P:=Pos(');',S); + AssertTrue(N+'); type after parameter type',P>P2); + P2:=Pos('virtual',S); + AssertTrue(N+'virtual after ); ',P2>P); + AssertTrue(N+'Terminated on semicolon',S[Length(S)]=';'); +end; + +procedure TTestGenCode.AssertArrayType(const AName, AItemType: String); + +Var + P,p2 : Integer; + S : String; + +begin + S:=NextLine; + AssertTrue('Type Name',Pos(AName,S)=1); + P:=Pos('=',S); + AssertTrue('Equal token after type Name',P>Pos(AName,S)); + P2:=Pos('Array of',S); + AssertTrue('Array of after Equal token after type Name',P2>P); + P:=Pos(AItemType,S); + AssertTrue('Item type name after array of',P>P2); + AssertTrue('Terminated on semicolon',S[Length(S)]=';'); +end; + +procedure TTestGenCode.AssertPropertyMap(const APath, ATypeName, APropertyName, + AParentTypeName: String); + +Var + M : TPropertyMapItem; + +begin + M:=Gen.PropertyMap.FindPath(APath); + AssertNotNull('Have property map "'+APath+'"',M); + AssertEquals('Have type name ',ATypeName,M.TypeName); + AssertEquals('Have property name ',APropertyName,M.PropertyName); + AssertEquals('Have parent type name ',AParentTypeName,M.ParentTypeName); +end; + +procedure TTestGenCode.AssertProperty(const AName, AType: String; Setter : Boolean = False); + +Var + S : String; + P,P2 : Integer; + +begin + S:=NextLine; + AssertTrue('Property Name',Pos('Property '+AName,S)=1); + P:=Pos(':',S); + AssertTrue('Colon after property name',P>Length('Property '+AName)); + P2:=Pos(AType,S); + AssertTrue('Field type after colon',P2>P); + P:=pos(' read ',S); + AssertTrue('Read specifier after type ',P>P2); + P2:=Pos('F'+AName,S); + AssertTrue('Field name for read specifier',P2>P); + P:=pos(' write ',S); + AssertTrue('Write specifier after type ',P>P2); + if Setter Then + P2:=Pos('write Set'+AName,S) + else + P2:=Pos('write F'+AName,S); + AssertTrue('Field name for write specifier',P2>P); + + AssertTrue('Terminated on semicolon',S[Length(S)]=';'); +end; + + +procedure TTestGenCode.GenCode(AJSON : String); + +Var + F : Text; + +begin + Gen.JSON:=AJSON; + Gen.DestUnitName:='u'+TestName; + Gen.Execute; + if (TestUnitDir<>'') then + begin + Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.pp'); + Rewrite(F); + Writeln(F,'// ',Self.TestName); + Writeln(F,Gen.Code.Text); + Close(F); + Assign(F,IncludeTrailingPathDelimiter(TestUnitDir)+Gen.DestUnitName+'.json'); + Rewrite(F); + Writeln(F,AJSON); + Close(F); + end + else + begin + Writeln('// ',Self.TestName); + Writeln('(* JSON: '+AJSON+' *)'); + Writeln(Gen.Code.Text); + end; + + FPos:=-1; +end; + +procedure TTestGenCode.TestEmpty; +begin + AssertNotNull('Have generator',Gen); + AssertNotNull('Generator property map exists',Gen.PropertyMap); + AssertNotNull('Generator property code exists',Gen.Code); + AssertNull('Generator JSON empty',Gen.JSONData); + AssertNull('Generator JSON stream empty',Gen.JSONStream); + AssertEquals('Generator JSON empty','',Gen.JSON); + AssertEquals('Generator property map empty',0,Gen.PropertyMap.Count); +end; + +procedure TTestGenCode.TestSimple; +begin + GenCode('{}'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); +end; + +procedure TTestGenCode.TestClassName; +begin + Gen.PropertyMap.AddPath('','TSomeObject'); + GenCode('{}'); + AssertUnitHeader; + AssertClassHeader('TSomeObject','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertPropertyMap('','TSomeObject','','TObject'); +end; + +procedure TTestGenCode.TestParentClassName; +begin + Gen.PropertyMap.AddPath('','TSomeObject'); + Gen.DefaultParentName:='TMyObject'; + GenCode('{}'); + AssertUnitHeader; + AssertClassHeader('TSomeObject','TMyObject'); + AssertVisibility('public'); + AssertEnd; + AssertPropertyMap('','TSomeObject','','TMyObject'); +end; + +procedure TTestGenCode.TestIntegerProperty; +begin + GenCode('{ "a" : 1 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertVisibility('public'); + AssertProperty('a','integer'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); +end; + +procedure TTestGenCode.Test2IntegersProperty; +begin + GenCode('{ "a" : 1, "b" : 2 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertProperty('a','integer'); + AssertProperty('b','integer'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestBooleanProperty; +begin + GenCode('{ "a" : true }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','boolean'); + AssertVisibility('public'); + AssertProperty('a','boolean'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Boolean','a',''); +end; + +procedure TTestGenCode.TestStringProperty; +begin + GenCode('{ "a" : "abce" }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','string'); + AssertVisibility('public'); + AssertProperty('a','string'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','String','a',''); +end; + +procedure TTestGenCode.TestFloatProperty; +begin + GenCode('{ "a" : 1.1 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','double'); + AssertVisibility('public'); + AssertProperty('a','double'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Double','a',''); +end; + +procedure TTestGenCode.TestInt64Property; +begin + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','int64'); + AssertVisibility('public'); + AssertProperty('a','int64'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestPropertySetter; +begin + Gen.Options:=[jpoUseSetter]; + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','int64'); + AssertVisibility('protected'); + AssertSetter('A','int64'); + AssertVisibility('public'); + AssertProperty('a','int64',True); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSetterImplementation('TMyObject','a','int64'); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestObjectProperty; +begin + GenCode('{ "a" : {} }'); + AssertUnitHeader; + AssertClassHeader('TA','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','Ta'); + AssertEnd; + AssertImplementation; + AssertClassComment('Comment for class TA','Ta'); + AssertClassComment('Comment for class TMyObject','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.TestObjectPropertySetter; +begin + Gen.Options:=[jpoUseSetter]; + GenCode('{ "a" : {} }'); + AssertUnitHeader; + AssertClassHeader('TA','TObject'); + AssertVisibility('protected'); + AssertVisibility('public'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('protected'); + AssertSetter('a','Ta'); + AssertVisibility('Public'); + AssertDestructor; + AssertProperty('a','Ta',True); + AssertEnd; + AssertImplementation; + AssertClassComment('Comment for class TA','Ta'); + AssertClassComment('Comment for class TMyObject','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertSetterImplementation('TMyObject','a','Ta',True); + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.TestObjectPropertySuffix; +begin + Gen.PropertyTypeSuffix:='Type'; + GenCode('{ "a" : {} }'); + AssertUnitHeader; + AssertClassHeader('TAType','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','TaType'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','TaType'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','TaType','a','TObject'); +end; + +procedure TTestGenCode.TestObjectPropertySkip; +begin + Gen.PropertyTypeSuffix:='Type'; + Gen.PropertyMap.AddPath('a','me').SkipType:=true; + GenCode('{ "a" : {} }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','me'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','me'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','me','a',''); +end; + +procedure TTestGenCode.TestObjectPropertyRecurse; +begin + GenCode('{ "a" : { "b" : {} } }'); + AssertUnitHeader; + AssertClassHeader('TAB','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertClassHeader('TA','TObject'); + AssertField('b','TaB'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('b','TaB'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); + AssertPropertyMap('a.b','Tab','b','TObject'); +end; + +procedure TTestGenCode.TestObjectPropertyRecurseSuffix; +begin + Gen.PropertyTypeSuffix:='Type'; + GenCode('{ "a" : { "b" : {} } }'); + AssertUnitHeader; + AssertClassHeader('TABType','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertClassHeader('TAType','TObject'); + AssertField('b','TaBType'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('b','TaBType'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','TaType'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','TaType'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','TaType','a','TObject'); + AssertPropertyMap('a.b','TabType','b','TObject'); +end; + +procedure TTestGenCode.TestObjectPropertyRecurseSkip; +begin + Gen.PropertyMap.AddPath('a','me').SkipType:=true; + GenCode('{ "a" : { "b" : {} } }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','me'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','me'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','me','a',''); +end; + +procedure TTestGenCode.TestObjectPropertyRecurseSkipB; +begin + Gen.PropertyMap.AddPath('a.b','me').SkipType:=true; + GenCode('{ "a" : { "b" : {} } }'); + AssertUnitHeader; + AssertClassHeader('TA','TObject'); + AssertField('b','me'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('b','me'); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); + AssertPropertyMap('a.b','me','b',''); +end; + +procedure TTestGenCode.TestStringArrayProperty; +begin + GenCode('{ "a" : [ "" ] }'); + AssertUnitHeader; + AssertArrayType('Ta','string'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','String','',''); +end; + +procedure TTestGenCode.TestIntegerArrayProperty; +begin + GenCode('{ "a" : [ 1 ] }'); + AssertUnitHeader; + AssertArrayType('Ta','integer'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','Integer','',''); +end; + +procedure TTestGenCode.TestBooleanArrayProperty; +begin + GenCode('{ "a" : [ true ] }'); + AssertUnitHeader; + AssertArrayType('Ta','Boolean'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','Boolean','',''); +end; + +procedure TTestGenCode.TestFloatArrayProperty; +begin + GenCode('{ "a" : [ 1.2 ] }'); + AssertUnitHeader; + AssertArrayType('Ta','Double'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','Double','',''); +end; + +procedure TTestGenCode.TestInt64ArrayProperty; +begin + GenCode('{ "a" : [ 1234567890123 ] }'); + AssertUnitHeader; + AssertArrayType('Ta','Int64'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','Int64','',''); +end; + +procedure TTestGenCode.TestStringArrayPropertySuffix; +begin + Gen.PropertyTypeSuffix:='Type'; + GenCode('{ "a" : [ "" ] }'); + AssertUnitHeader; + AssertArrayType('TaType','string'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','TaType'); + AssertVisibility('public'); + AssertProperty('a','TaType'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','TaType','a',''); + AssertPropertyMap('a[0]','String','',''); +end; + +procedure TTestGenCode.TestObjectArrayProperty; +begin + GenCode('{ "a" : [ {} ] }'); + AssertUnitHeader; + AssertClassHeader('TaItem','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertArrayType('Ta','TaItem'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','TaItem','','TObject'); +end; + +procedure TTestGenCode.TestObjectArrayPropertySuffix; + +begin + Gen.PropertyTypeSuffix:='Type'; + GenCode('{ "a" : [ {} ] }'); + AssertUnitHeader; + AssertClassHeader('TaItemType','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertArrayType('TaType','TaItemType'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','TaType'); + AssertVisibility('public'); + AssertProperty('a','TaType'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','TaType','a',''); + AssertPropertyMap('a[0]','TaItemType','','TObject'); +end; + +procedure TTestGenCode.TestArrayArrayProperty; +begin + GenCode('{ "a" : [ [ "" ] ] }'); + AssertUnitHeader; + AssertArrayType('TaItem','String'); + AssertArrayType('Ta','TaItem'); + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertProperty('a','Ta'); + AssertEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','TaItem','',''); + AssertPropertyMap('a[0][0]','String','',''); +end; + +procedure TTestGenCode.TestObjectArrayArrayProperty; +begin + GenCode('{ "a" : [ [ {} ] ] }'); + AssertUnitHeader; + AssertClassHeader('TaItemItem','TObject'); + AssertVisibility('public'); + AssertEnd; + AssertArrayType('TaItem','TaItemItem'); + AssertArrayType('Ta','TaItem'); + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); + AssertPropertyMap('a[0]','TaItem','',''); + AssertPropertyMap('a[0][0]','TaItemItem','','TObject'); +end; + +procedure TTestGenCode.AssertLoadConstructorDeclaration(AType: String); + +Var + S : String; + +begin + S:=NextLine; + AssertTrue('Load Constructor declaration in '+S,Pos('Constructor CreateFromJSON(AJSON : '+AType+'); virtual;',S)>0); +end; + +procedure TTestGenCode.AssertLoaderDeclaration(AType : String); + +Var + S : String; + +begin + S:=NextLine; + AssertTrue('LoadFromJSON declaration in '+S,Pos('Procedure LoadFromJSON(AJSON : '+AType+'); virtual;',S)>0); +end; + +procedure TTestGenCode.AssertSaverDeclaration; + +Var + S : String; + +begin + S:=NextLine; + AssertTrue('SaveToJSON function declaration in '+S,Pos('Function SaveToJSON : TJSONObject;',S)>0); + S:=NextLine; + AssertTrue('SaveToJSON procedure declaration in '+S,Pos('Procedure SaveToJSON(AJSON : TJSONObject)',S)>0); +end; + +procedure TTestGenCode.AssertLoaderImplementationEnd(IsDelphi : Boolean = False); + +begin + if Not IsDelphi then + AssertEnd('Case');// Case + AssertEnd('for');// For + AssertEnd('procedure');// Routine +end; + +procedure TTestGenCode.AssertArrayLoaderImplementationStart(const ATypeName, + ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False); + +Var + S : String; +begin + S:=NextLine; + AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0); + if isDelphi then + AssertDelphiPropertyAssignmentLoop + else + AssertPropertyAssignmentLoop; +end; + +procedure TTestGenCode.AssertPropertyAssignmentLoop; + +begin + AssertTrue('Have var',Pos('var',NextLine)>0); + AssertTrue('Have P enum',Pos('E : TJSONEnum;',NextLine)>0); + AssertBegin; + AssertTrue('Have E for enum',Pos('For E in AJSON do',NextLine)>0); + AssertBegin; + if (jpoLoadCaseInsensitive in Gen.Options) then + AssertTrue('Have E for enum',Pos('case LowerCase(E.key) of',NextLine)>0) + else + AssertTrue('Have E for enum',Pos('case E.key of',NextLine)>0); +end; + +procedure TTestGenCode.AssertDelphiPropertyAssignmentLoop; + +Var + S : String; + +begin + AssertTrue('Have var',Pos('var',NextLine)>0); + AssertTrue('Have pair',Pos('P : TJSONPair;',NextLine)>0); + AssertTrue('Have obj',Pos('O : TJSONObject;',NextLine)>0); + AssertTrue('Have Propertyname var',Pos('PN : String;',NextLine)>0); + AssertBegin; + S:=NextLine; + AssertTrue('Have JSONObject check in '+S,Pos('not (AJSON is TJSONObject)',S)>0); + if jpoUnknownLoadPropsError in gen.Options then + AssertTrue('Have raise statement',Pos('Raise EJSONException',NextLine)>0); + AssertTrue('Have typecast',Pos('O:=AJSON as TJSONObject',NextLine)>0); + AssertTrue('Have P for enum',Pos('For P in O do',NextLine)>0); + AssertBegin; + if jpoLoadCaseInsensitive in Gen.Options then + AssertTrue('Have case insensitive propertyname assign',Pos('PN:=LowerCase(P.JSONString.Value)',NextLine)>0) + else + AssertTrue('Have propertyname assign',Pos('PN:=P.JSONString.Value',NextLine)>0); +end; + +procedure TTestGenCode.AssertObjectLoaderImplementationStart(const ATypeName, + ADataName, ArrayName, ArrayTypeName, ArrayElementType: String; IsDelphi : Boolean = False); +Var + S : String; +begin + S:=NextLine; + AssertTrue('Have loader start: '+ATypeName+','+ADataName,Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',S)>0); + if isDelphi then + AssertDelphiPropertyAssignmentLoop + else + AssertPropertyAssignmentLoop; +end; + +procedure TTestGenCode.AssertSaverImplementationStart(const ATypeName: String; + IsDelphi: Boolean); + +Var + S,N : String; + +begin + N:='SaveToJSONFunction '+ATypeName+' : '; + S:=NextLine; + AssertTrue(N+'header',Pos('Function '+ATypeName+'.SaveToJSON : TJSONObject;',S)>0); + AssertBegin; + AssertTrue(N+'Create',Pos('Result:=TJSONObject.Create',NextLine)>0); + AssertTrue(N+'Try',Pos('Try',NextLine)>0); + AssertTrue(N+'Save',Pos('SaveToJSON(Result);',NextLine)>0); + AssertTrue(N+'except',Pos('except',NextLine)>0); + AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0); + AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0); + AssertTrue(N+'end;',Pos('End;',NextLine)>0); + AssertTrue(N+'end;',Pos('End;',NextLine)>0); + AssertTrue(N+'proc header',Pos('Procedure '+ATypeName+'.SaveToJSON(AJSON : TJSONObject);',NextLine)>0); + AssertBegin; +end; + + +procedure TTestGenCode.AssertLoaderImplementationStart(const ATypeName, + ADataName: String; IsDelphi : Boolean = False); + +begin + AssertTrue(Pos('Procedure '+ATypeName+'.LoadFromJSON(AJSON : '+ADataName+');',NextLine)>0); + if isDelphi then + AssertDelphiPropertyAssignmentLoop + else + AssertPropertyAssignmentLoop; +end; + +procedure TTestGenCode.AssertLoadConstructorImplementationStart(const ATypeName, + ADataName: String); + +begin + AssertTrue('Have constructor call',Pos('Constructor '+ATypeName+'.CreateFromJSON(AJSON : '+ADataName+');',NextLine)>0); + AssertBegin; + AssertTrue('Call create constructor',Pos('create();',NextLine)>0); + AssertTrue('Call LoadFromJSON',Pos('LoadFromJSON(AJSON);',NextLine)>0); + AssertEnd; +end; + +procedure TTestGenCode.TestLoadIntegerProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); +end; + +procedure TTestGenCode.TestLoad2IntegersProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0); + AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0); + AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestLoadIntegerWithErrorProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoUnknownLoadPropsError]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('a:=E.Value.AsInteger;',NextLine)>0); + AssertTrue('Have "b" integer property case',Pos('''b'':',NextLine)>0); + AssertTrue('Have "b" integer property set', Pos('b:=E.Value.AsInteger;',NextLine)>0); + AssertTrue('Have case else',Pos('else',NextLine)>0); + AssertTrue('Have raise statement', Pos('Raise EJSON.CreateFmt',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestLoadIntegerCaseInsensitiveProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoLoadCaseInsensitive]; + GenCode('{ "A" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('A','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('A','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData',False); + AssertTrue('Have "a" integer property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('A:=E.Value.AsInteger;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('A','Integer','A',''); +end; + +procedure TTestGenCode.TestLoadStringProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : "1234" }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','string'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','string',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" string property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" string property set', Pos('a:=E.Value.AsString;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','String','a',''); +end; + +procedure TTestGenCode.TestLoadBooleanProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : true }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','boolean'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','boolean',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" boolean property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" boolean property set', Pos('a:=E.Value.AsBoolean;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Boolean','a',''); +end; + +procedure TTestGenCode.TestLoadInt64Property; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Int64'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','Int64',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" Int64 property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" Int64 property set', Pos('a:=E.Value.AsInt64;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestLoadFloatProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : 1.1 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Double'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','Double',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertLoaderImplementationStart('TMyObject','TJSONData'); + AssertTrue('Have "a" Double property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" Double property set', Pos('a:=E.Value.AsFloat;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Double','a',''); +end; + +procedure TTestGenCode.TestLoadObjectProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : { "b" : "abc" } }'); + AssertUnitHeader; + AssertClassHeader('Ta','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('b','String',False); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','Ta'); + AssertLoadConstructorImplementationStart('Ta','TJSONData'); + AssertLoaderImplementationStart('Ta','TJSONData'); + AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0); + AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertClassComment('Object Implementation','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta',''); + AssertTrue('Have "a" object property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(E.Value);',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.AssertArrayCreator(const ArrayTypeName, + AElementType: String; IsDelphi: Boolean); + +Var + S : String; + +begin + S:=NextLine; + AssertTrue('Have array creator in '+S,Pos('Function Create'+ArrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName,S)>0); +end; + +procedure TTestGenCode.AssertArraySaver(const ArrayTypeName, + AElementType: String; IsDelphi: Boolean); + +Var + E,S : String; + +begin + S:=NextLine; + E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);'; + AssertTrue('Have proc array saver in '+S,Pos(E,S)>0); + S:=NextLine; + E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;'; + AssertTrue('Have func array saver in '+S,Pos(E,S)>0); +end; + +procedure TTestGenCode.AssertArrayCreatorImplementation(const ArrayTypeName, + AElementType: String; AObjectName: String; IsDelphi: Boolean); + +Var + S,E,AN : String; + +begin + S:=NextLine; + E:='Function Create'+ARrayTypeName+'(AJSON : '+GetDataName(IsDelphi)+') : '+ArrayTypeName; + AssertTrue('Have array creator header '+S+'Expected : '+E ,Pos(E,S)>0); + AssertTrue('Have var',Pos('var',NextLine)>0); + AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0); + if IsDelphi then + begin + AssertTrue('Have Array var',Pos('A : TJSONArray;',NextLine)>0); + AN:='A' + end + else + AN:='AJSON'; + AssertBegin; + if IsDelphi then + AssertTrue('Have Array assignnment',Pos('A:=AJSON as TJSONArray;',NextLine)>0); + AssertTrue('Have array setlength ',Pos('SetLength(Result,'+AN+'.Count);',NextLine)>0); + AssertTrue('Have loop ',Pos('for i:=0 to '+AN+'.Count-1 do',NextLine)>0); + if AObjectName='' then + begin + if IsDelphi then + AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].GetValue<'+AElementType+'>;',NextLine)>0) + else + AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AN+'.Items[i].'+AElementType+';',NextLine)>0) + end + else + AssertTrue('Have element assignment : '+AElementType,Pos('Result[i]:='+AObjectName+'.CreateFromJSON('+AN+'.Items[i]);',NextLine)>0); + AssertEnd; +end; + +procedure TTestGenCode.AssertLine(Msg : String; AExpected : String); + +Var + N,DMsg : String; + +begin + N:=NextLine; + DMsg:=Msg+', Expected: "'+AExpected+'", Actual: "'+N+'"'; + AssertTrue(Dmsg,Pos(AExpected,N)>0); +end; + +procedure TTestGenCode.AssertArraySaverImplementation(const ArrayTypeName, + AElementType: String; AObjectName: String; IsDelphi: Boolean); +Var + N,S,E,AN : String; + +begin + N:=ArrayTypeName+'Saver : '; + S:=NextLine; + E:='Function Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+') : TJSONArray;'; + AssertTrue(N+'header',Pos(E,S)>0); + AssertBegin; + AssertTrue(N+'Create',Pos('Result:=TJSONArray.Create',NextLine)>0); + AssertTrue(N+'Try',Pos('Try',NextLine)>0); + S:=NextLine; + E:='Save'+ArrayTypeName+'ToJSON(AnArray,Result);'; + AssertTrue(N+'Save',Pos(E,S)>0); + AssertTrue(N+'except',Pos('except',NextLine)>0); + AssertTrue(N+'FreeAndNil',Pos('FreeAndNil(Result);',NextLine)>0); + AssertTrue(N+'Reraise',Pos('Raise;',NextLine)>0); + AssertTrue(N+'end;',Pos('End;',NextLine)>0); + AssertTrue(N+'end;',Pos('End;',NextLine)>0); + S:=NextLine; + E:='Procedure Save'+ArrayTypeName+'ToJSON(AnArray : '+ArrayTypeName+'; AJSONArray : TJSONArray);'; + AssertTrue('Have array saver header '+S+'Expected : '+E ,Pos(E,S)>0); + AssertTrue('Have var',Pos('var',NextLine)>0); + AssertTrue('Have loop var',Pos('I : Integer;',NextLine)>0); + AssertBegin; + AssertTrue('Have loop ',Pos('for i:=0 to Length(AnArray)-1 do',NextLine)>0); + if AObjectName='' then + AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add(AnArray[i]);') +{ else if AObjectName='' then + AssertLine('Have element assignment : '+AElementType,'AJSONArray.Add('+AN+'[i]);')} + else + AssertTrue('Have element assignment : '+AElementType,Pos('AJSONArray.Add(AnArray[i].SaveToJSON);',NextLine)>0); + AssertEnd; +end; + +procedure TTestGenCode.AssertType; + +begin + AssertTrue('Have Type keyword',Pos('Type',NextLine)>0); +end; + +procedure TTestGenCode.AssertDelphiLoadArray(AElementType, AJSONtype : String); + +begin + AssertUnitHeader; + AssertArrayType('Ta',AElementType); + AssertArrayCreator('Ta',AElementType,true); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertArrayCreatorImplementation('Ta',AJSONType,'',True); + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertArrayLoaderImplementationStart('TMyObject','TJSONValue','a','Ta',AJSONType); + AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.Value);',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +class function TTestGenCode.GetDataName(IsDelphi: Boolean): string; + +begin + if IsDelphi then + Result:='TJSONValue' + else + Result:='TJSONData'; +end; + +procedure TTestGenCode.AssertLoadArray(AElementType, AJSONtype: String; + IsDelphi: Boolean = False); + +Var + DN : String; + +begin + AssertUnitHeader; + DN:=GetDataName(IsDelphi); + AssertArrayType('Ta',AElementType); + AssertArrayCreator('Ta',AElementType,IsDelphi); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration(DN); + AssertLoaderDeclaration(DN); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertArrayCreatorImplementation('Ta',AJSONType,'',IsDelphi); + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject',DN); + AssertArrayLoaderImplementationStart('TMyObject',DN,'a','Ta',AJSONType,isDelphi); + if IsDelphi then + begin + AssertTrue('Have "a" property if',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0); + end + else + begin + AssertTrue('Have "a" array property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0); + end; + AssertLoaderImplementationEnd(IsDelphi); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +procedure TTestGenCode.AssertSaveArray(AElementType, AJSONtype: String; IsDelphi: Boolean = False); + +Var + DN : String; + +begin + AssertUnitHeader; + DN:=GetDataName(IsDelphi); + AssertArrayType('Ta',AElementType); + AssertArraySaver('Ta',AElementType,IsDelphi); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertArraySaverImplementation('Ta',AJSONType,'',IsDelphi); + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + if IsDelphi then + AssertTrue('Array save statement', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0) + else + AssertTrue('Array save statement', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0); + AssertEnd('Saver'); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +procedure TTestGenCode.TestLoadStringArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ "abc" ] }'); + AssertLoadArray('string','AsString'); +end; + +procedure TTestGenCode.TestLoadBooleanArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ true ] }'); + AssertLoadArray('boolean','AsBoolean'); +end; + +procedure TTestGenCode.TestLoadIntegerArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ 123 ] }'); + AssertLoadArray('Integer','AsInteger'); +end; + +procedure TTestGenCode.TestLoadInt64ArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ 1234567890123 ] }'); + AssertLoadArray('Int64','AsInt64'); +end; + +procedure TTestGenCode.TestLoadFloatArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ 12.34 ] }'); + AssertLoadArray('Double','AsFloat'); +end; + +procedure TTestGenCode.TestLoadObjectArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad]; + GenCode('{ "a" : [ { "b" : "abc" } ] }'); + AssertUnitHeader; + AssertClassHeader('TaItem','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('b','String',False); + AssertEnd; + AssertArrayType('Ta','TaItem'); + AssertArrayCreator('Ta','TaItem'); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONData'); + AssertLoaderDeclaration('TJSONData'); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TaItem'); + AssertLoadConstructorImplementationStart('TAItem','TJSONData'); + AssertLoaderImplementationStart('TaItem','TJSONData'); + AssertTrue('Have "b" string property case',Pos('''b'':',NextLine)>0); + AssertTrue('Have "b" string property set', Pos('b:=E.Value.AsString;',NextLine)>0); + AssertLoaderImplementationEnd; + AssertArrayCreatorImplementation('Ta','','TaItem'); + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONData'); + AssertObjectLoaderImplementationStart('TMyObject','TJSONData','a','Ta',''); + AssertTrue('Have "a" stringarray property case',Pos('''a'':',NextLine)>0); + AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(E.Value);',NextLine)>0); + AssertLoaderImplementationEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + + +procedure TTestGenCode.TestLoadDelphiIntegerProperty; + +Var + S : String; + +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); +end; + +procedure TTestGenCode.TestLoadDelphi2IntegersProperty; + +Var + S : String; + +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0); + S:=NextLine; + AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue',S)>0); + AssertTrue('Have no semicolon', Pos(';',S)=0); + AssertTrue('Have else "b" integer property case ',Pos('Else If (PN=''b'') then',NextLine)>0); + AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestLoadDelphiIntegerWithErrorProperty; + +Var + S : String; + +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoUnknownLoadPropsError]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case ',Pos('If (PN=''a'') then',NextLine)>0); + S:=NextLine; + AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue',S)>0); + AssertTrue('Have no semicolon for a', Pos(';',S)=0); + AssertTrue('Have "b" integer property case ',Pos('If (PN=''b'') then',NextLine)>0); + S:=NextLine; + AssertTrue('Have "b" integer property set', Pos('b:=P.JSONValue.GetValue',S)>0); + AssertTrue('Have no semicolon for b', Pos(';',S)=0); + AssertTrue('Have case else',Pos('else',NextLine)>0); + AssertTrue('Have raise statement', Pos('Raise EJSONException.CreateFmt',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestLoadDelphiIntegerCaseInsensitiveProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON,jpoLoadCaseInsensitive]; + GenCode('{ "A" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('A','integer'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('A','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "A" integer property set', Pos('A:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('A','Integer','A',''); +end; + +procedure TTestGenCode.TestLoadDelphiStringProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : "1234" }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','String'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','string',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" integer property set', Pos('a:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','String','a',''); +end; + +procedure TTestGenCode.TestLoadDelphiBooleanProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : true }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','boolean'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','boolean',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Boolean','a',''); +end; + +procedure TTestGenCode.TestLoadDelphiInt64Property; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Int64'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','Int64',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestLoadDelphiFloatProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : 1.1 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Double'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','Double',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertLoaderImplementationStart('TMyObject','TJSONValue',True); + AssertTrue('Have "a" integer property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" integer property set',Pos('a:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Double','a',''); +end; + +procedure TTestGenCode.TestLoadDelphiObjectProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : { "b" : "abc" } }'); + AssertUnitHeader; + AssertClassHeader('Ta','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('b','String',False); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','Ta'); + AssertLoadConstructorImplementationStart('Ta','TJSONValue'); + AssertLoaderImplementationStart('Ta','TJSONValue',True); + AssertTrue('Have "b" string property case',Pos('If (PN=''b'') then',NextLine)>0); + AssertTrue('Have "b" string property set', Pos('b:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertClassComment('Object Implementation','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True); + AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" object create createfromjson', Pos('a:=ta.CreateFromJSON(P.JSONValue);',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.TestLoadDelphiObjectArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad,jpoDelphiJSON]; + GenCode('{ "a" : [ { "b" : "abc" } ] }'); + AssertUnitHeader; + AssertClassHeader('TaItem','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('b','String',False); + AssertEnd; + AssertArrayType('Ta','TaItem'); + AssertArrayCreator('Ta','TaItem',True); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertLoadConstructorDeclaration('TJSONValue'); + AssertLoaderDeclaration('TJSONValue'); + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TaItem'); + AssertLoadConstructorImplementationStart('TAItem','TJSONValue'); + AssertLoaderImplementationStart('TaItem','TJSONValue',True); + AssertTrue('Have "b" object property case',Pos('If (PN=''b'') then',NextLine)>0); + AssertTrue('Have "b" object property set', Pos('b:=P.JSONValue.GetValue;',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertArrayCreatorImplementation('Ta','','TaItem',True); + AssertClassComment('Object Implementation','TMyObject'); + AssertLoadConstructorImplementationStart('TMyObject','TJSONValue'); + AssertObjectLoaderImplementationStart('TMyObject','TJSONValue','a','Ta','',True); + AssertTrue('Have "a" object property case',Pos('If (PN=''a'') then',NextLine)>0); + AssertTrue('Have "a" property set with createarray', Pos('a:=CreateTa(P.JSONValue);',NextLine)>0); + AssertLoaderImplementationEnd(True); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +procedure TTestGenCode.TestSaveIntegerProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); +end; + +procedure TTestGenCode.TestSave2IntegersProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('Have "b" integer property save', Pos('AJSON.Add(''b'',b);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestSaveStringProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : "1234" }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','string'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','string',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','String','a',''); +end; + +procedure TTestGenCode.TestSaveBooleanProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : true }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Boolean'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','Boolean',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" boolean property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Boolean','a',''); +end; + +procedure TTestGenCode.TestSaveInt64Property; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Int64'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','Int64',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" int64 property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestSaveFloatProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : 1.2 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','double'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','double',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.Add(''a'',a);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Double','a',''); + +end; + +procedure TTestGenCode.TestSaveObjectProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : { "b" : "abc" } }'); + AssertUnitHeader; + AssertClassHeader('Ta','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('b','String',False); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertSaverDeclaration; + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','Ta'); + AssertSaverImplementationStart('Ta'); + AssertTrue('Have "b" property save', Pos('AJSON.Add(''b'',b);',NextLine)>0); + AssertEnd; + AssertClassComment('Object Implementation','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0); + AssertTrue('Have "a" object property save', Pos('AJSON.Add(''a'',a.SaveToJSON);',NextLine)>0); + AssertEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.TestSaveStringArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ "abc" ] }'); + AssertSaveArray('string',''); +end; + +procedure TTestGenCode.TestSaveBooleanArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ true ] }'); + AssertSaveArray('boolean',''); +end; + +procedure TTestGenCode.TestSaveIntegerArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ 123 ] }'); + AssertSaveArray('Integer',''); +end; + +procedure TTestGenCode.TestSaveInt64ArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ 1234567890123 ] }'); + AssertSaveArray('Int64',''); +end; + +procedure TTestGenCode.TestSaveFloatArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ 1.23] }'); + AssertSaveArray('Double',''); +end; + +procedure TTestGenCode.TestSaveObjectArrayProperty; +begin + Gen.Options:=[jpoGenerateSave]; + GenCode('{ "a" : [ { "b" : "abc" } ] }'); + AssertUnitHeader; + AssertClassHeader('TaItem','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('b','String',False); + AssertEnd; + AssertArrayType('Ta','TaItem'); + AssertArraySaver('Ta','TaItem'); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TaItem'); + AssertSaverImplementationStart('TaItem'); + AssertTrue('Have "b" string property save', Pos('AJSON.Add(''b'',b);',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertArraySaverImplementation('Ta','','TaItem'); + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" array property save', Pos('AJSON.Add(''a'',SaveTaToJSON(a));',NextLine)>0); + AssertEnd('Loader TMyObject'); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +procedure TTestGenCode.TestSaveDelphiIntegerProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : 1234 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); +end; + +procedure TTestGenCode.TestSaveDelphi2IntegersProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : 1234, "b" : 5678 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','integer'); + AssertField('b','integer'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','integer',False); + AssertProperty('b','integer',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" integer property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0); + AssertTrue('Have "b" integer property save', Pos('AJSON.AddPair(''b'',TJSONNumber.Create(b));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Integer','a',''); + AssertPropertyMap('b','Integer','b',''); +end; + +procedure TTestGenCode.TestSaveDelphiStringProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : "1234" }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','string'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','string',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" string property save', Pos('AJSON.AddPair(''a'',TJSONString.Create(a));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','String','a',''); +end; + +procedure TTestGenCode.TestSaveDelphiBooleanProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : true }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Boolean'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','Boolean',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" Boolean property save', Pos('AJSON.AddPair(''a'',TJSONBoolean.Create(a));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Boolean','a',''); +end; + +procedure TTestGenCode.TestSaveDelphiInt64Property; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : 1234567890123 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Int64'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','Int64',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" int64 property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Int64','a',''); +end; + +procedure TTestGenCode.TestSaveDelphiFloatProperty; +Var + S : String; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : 1.2 }'); + AssertUnitHeader; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','double'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','double',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + S:=NextLine; + AssertTrue('Have "a" float property save', Pos('AJSON.AddPair(''a'',TJSONNumber.Create(a));',S)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Double','a',''); +end; + +procedure TTestGenCode.TestSaveDelphiObjectProperty; +Var + S : String; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : { "b" : "abc" } }'); + AssertUnitHeader; + AssertClassHeader('Ta','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('b','String',False); + AssertEnd; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertDestructor; + AssertSaverDeclaration; + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','Ta'); + AssertSaverImplementationStart('Ta'); + AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0); + AssertEnd; + AssertClassComment('Object Implementation','TMyObject'); + AssertDestructorImplementation('TMyObject',['a']); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have check for assigned object property save', Pos('if Assigned(a) then',NextLine)>0); + S:=NextLine; + AssertTrue('Have "a" object property save', Pos('AJSON.AddPair(''a'',a.SaveToJSON);',S)>0); + AssertEnd; + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a','TObject'); +end; + +procedure TTestGenCode.TestSaveDelphiStringArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ "abc" ] }'); + AssertSaveArray('string','',True); +end; + +procedure TTestGenCode.TestSaveDelphiBooleanArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ true ] }'); + AssertSaveArray('boolean','',True); +end; + +procedure TTestGenCode.TestSaveDelphiIntegerArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ 123 ] }'); + AssertSaveArray('Integer','',True); +end; + +procedure TTestGenCode.TestSaveDelphiInt64ArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ 1234567890123 ] }'); + AssertSaveArray('Int64','',True); +end; + +procedure TTestGenCode.TestSaveDelphiFloatArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ 1.23] }'); + AssertSaveArray('Double','',True); +end; + +procedure TTestGenCode.TestSaveDelphiObjectArrayProperty; +begin + Gen.Options:=[jpoGenerateSave,jpoDelphiJSON]; + GenCode('{ "a" : [ { "b" : "abc" } ] }'); + AssertUnitHeader; + AssertClassHeader('TaItem','TObject'); + AssertField('b','String'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('b','String',False); + AssertEnd; + AssertArrayType('Ta','TaItem'); + AssertArraySaver('Ta','TaItem',True); + AssertType; + AssertClassHeader('TMyObject','TObject'); + AssertField('a','Ta'); + AssertVisibility('public'); + AssertSaverDeclaration; + AssertProperty('a','ta',False); + AssertEnd; + AssertImplementation; + AssertClassComment('Object Implementation','TaItem'); + AssertSaverImplementationStart('TaItem',True); + AssertTrue('Have "b" string property save', Pos('AJSON.AddPair(''b'',TJSONString.Create(b));',NextLine)>0); + AssertTrue('end',Pos('end;',NextLine)>0); + AssertArraySaverImplementation('Ta','','TaItem',True); + AssertClassComment('Object Implementation','TMyObject'); + AssertSaverImplementationStart('TMyObject'); + AssertTrue('Have "a" array property save', Pos('AJSON.AddPair(''a'',SaveTaToJSON(a));',NextLine)>0); + AssertEnd('Loader TMyObject'); + AssertUnitEnd; + AssertPropertyMap('','TMyObject','','TObject'); + AssertPropertyMap('a','Ta','a',''); +end; + +procedure TTestGenCode.TestLoadDelphiStringArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON]; + GenCode('{ "a" : [ "abc" ] }'); + AssertLoadArray('string','String',True); +end; + +procedure TTestGenCode.TestLoadDelphiBooleanArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON]; + GenCode('{ "a" : [ true ] }'); + AssertLoadArray('boolean','Boolean',True); +end; + +procedure TTestGenCode.TestLoadDelphiIntegerArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON]; + GenCode('{ "a" : [ 12 ] }'); + AssertLoadArray('integer','Integer',True); +end; + +procedure TTestGenCode.TestLoadDelphiInt64ArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON]; + GenCode('{ "a" : [ 1234567890123 ] }'); + AssertLoadArray('int64','Int64',True); +end; + +procedure TTestGenCode.TestLoadDelphiFloatArrayProperty; +begin + Gen.Options:=[jpoGenerateLoad, jpoDelphiJSON]; + GenCode('{ "a" : [ 1.1 ] }'); + AssertLoadArray('double','Double',True); +end; + + +initialization + + RegisterTest(TTestGenCode); +end. + diff --git a/packages/fcl-json/tests/testjson2code.lpi b/packages/fcl-json/tests/testjson2code.lpi new file mode 100644 index 0000000000..7fc43f1e68 --- /dev/null +++ b/packages/fcl-json/tests/testjson2code.lpi @@ -0,0 +1,70 @@ + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <i18n> + <EnableI18N LFM="False"/> + </i18n> + <VersionInfo> + <StringTable ProductVersion=""/> + </VersionInfo> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <CommandLineParams Value="--suite=TestLoadObjectProperty"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="FCL"/> + </Item1> + </RequiredPackages> + <Units Count="3"> + <Unit0> + <Filename Value="testjson2code.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="tcjsontocode.pp"/> + <IsPartOfProject Value="True"/> + </Unit1> + <Unit2> + <Filename Value="../src/fpjsontopas.pp"/> + <IsPartOfProject Value="True"/> + </Unit2> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="../src"/> + </SearchPaths> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/packages/fcl-json/tests/testjson2code.lpr b/packages/fcl-json/tests/testjson2code.lpr new file mode 100644 index 0000000000..6dbf20d104 --- /dev/null +++ b/packages/fcl-json/tests/testjson2code.lpr @@ -0,0 +1,52 @@ +program testjson2code; + +{$mode objfpc}{$H+} + +uses + Classes, consoletestrunner, tcjsontocode, fpjsontopas; + +type + + { TLazTestRunner } + + { TMyTestRunner } + + TMyTestRunner = class(TTestRunner) + protected + function GetShortOpts: string; override; + procedure AppendLongOpts; override; + procedure DoRun; override; + end; + +var + Application: TMyTestRunner; + +{ TMyTestRunner } + +function TMyTestRunner.GetShortOpts: string; +begin + Result:=inherited GetShortOpts; + Result:=Result+'t:'; +end; + +procedure TMyTestRunner.AppendLongOpts; +begin + inherited AppendLongOpts; + LongOpts.Add('testunitdir:'); +end; + +procedure TMyTestRunner.DoRun; +begin + TestUnitDir:=GetOptionValue('t','testunitdir'); + inherited DoRun; +end; + +begin + DefaultFormat:=fPlain; + DefaultRunAllTests:=True; + Application := TMyTestRunner.Create(nil); + Application.Initialize; + Application.Title := 'FPCUnit Console test runner'; + Application.Run; + Application.Free; +end. \ No newline at end of file