Browse Source

* Extended jsonrtti so it supports streaming of datetime and destreaming datetime (bug ID 28721)

git-svn-id: trunk@32876 -
michael 9 years ago
parent
commit
6ac5aa615a

+ 1 - 0
.gitattributes

@@ -2502,6 +2502,7 @@ packages/fcl-json/src/jsonconf.pp svneol=native#text/plain
 packages/fcl-json/src/jsonparser.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/src/jsonscanner.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.pp svneol=native#text/plain
 packages/fcl-json/tests/jsonconftest.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.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjson.pp svneol=native#text/plain
 packages/fcl-json/tests/testjson.pp svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain
 packages/fcl-json/tests/testjsonconf.lpi svneol=native#text/plain

+ 88 - 14
packages/fcl-json/src/fpjsonrtti.pp

@@ -7,6 +7,11 @@ interface
 uses
 uses
   Classes, SysUtils, contnrs, typinfo, fpjson, rttiutils, jsonparser;
   Classes, SysUtils, contnrs, typinfo, fpjson, rttiutils, jsonparser;
 
 
+Const
+  RFC3339DateTimeFormat = 'yyyy"-"mm"-"dd"T"hh":"nn":"ss';
+  RFC3339DateTimeFormatMsec = RFC3339DateTimeFormat+'.zzz';
+  
+
 Type
 Type
 
 
   TJSONStreamEvent = Procedure (Sender : TObject; AObject : TObject; JSON : TJSONObject) of object;
   TJSONStreamEvent = Procedure (Sender : TObject; AObject : TObject; JSON : TJSONObject) of object;
@@ -22,7 +27,8 @@ Type
                        jsoTStringsAsObject,       // Stream TStrings as an object : string = { object }
                        jsoTStringsAsObject,       // Stream TStrings as an object : string = { object }
                        jsoDateTimeAsString,       // Format a TDateTime value as a string
                        jsoDateTimeAsString,       // Format a TDateTime value as a string
                        jsoUseFormatString,        // Use FormatString when creating JSON strings.
                        jsoUseFormatString,        // Use FormatString when creating JSON strings.
-                       jsoCheckEmptyDateTime);    // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
+                       jsoCheckEmptyDateTime,     // If TDateTime value is empty and jsoDateTimeAsString is used, 0 date returns empty string
+                       jsoLegacyDateTime);         // Set this to enable old date/time formatting. Current behaviour is to save date/time as a ISO 9601 value.
   TJSONStreamOptions = Set of TJSONStreamOption;
   TJSONStreamOptions = Set of TJSONStreamOption;
 
 
   TJSONFiler = Class(TComponent)
   TJSONFiler = Class(TComponent)
@@ -102,16 +108,25 @@ Type
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONRestorePropertyEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Var Handled : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONPropertyErrorEvent = Procedure (Sender : TObject; AObject : TObject; Info : PPropInfo; AValue : TJSONData; Error : Exception; Var Continue : Boolean) of object;
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
   TJSONGetObjectEvent = Procedure (Sender : TOBject; AObject : TObject; Info : PPropInfo; AData : TJSONObject; DataName : TJSONStringType; Var AValue : TObject);
+  TJSONDestreamOption = (jdoCaseInsensitive,jdoIgnorePropertyErrors);
+  TJSONDestreamOptions = set of TJSONDestreamOption;
+
   TJSONDeStreamer = Class(TJSONFiler)
   TJSONDeStreamer = Class(TJSONFiler)
   private
   private
     FAfterReadObject: TJSONStreamEvent;
     FAfterReadObject: TJSONStreamEvent;
     FBeforeReadObject: TJSONStreamEvent;
     FBeforeReadObject: TJSONStreamEvent;
+    FDateTimeFormat: String;
     FOnGetObject: TJSONGetObjectEvent;
     FOnGetObject: TJSONGetObjectEvent;
     FOnPropError: TJSONpropertyErrorEvent;
     FOnPropError: TJSONpropertyErrorEvent;
     FOnRestoreProp: TJSONRestorePropertyEvent;
     FOnRestoreProp: TJSONRestorePropertyEvent;
     FCaseInsensitive : Boolean;
     FCaseInsensitive : Boolean;
+    FOptions: TJSONDestreamOptions;
     procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
     procedure DeStreamClassProperty(AObject: TObject; PropInfo: PPropInfo; PropData: TJSONData);
+    function GetCaseInsensitive: Boolean;
+    procedure SetCaseInsensitive(AValue: Boolean);
   protected
   protected
+    // Try to parse a date.
+    Function ExtractDateTime(S : String): TDateTime;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
     function GetObject(AInstance : TObject; const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo): TObject;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     procedure DoRestoreProperty(AObject: TObject; PropInfo: PPropInfo;  PropData: TJSONData); virtual;
     Function ObjectFromString(Const JSON : TJSONStringType) : TJSONData; virtual;
     Function ObjectFromString(Const JSON : TJSONStringType) : TJSONData; virtual;
@@ -143,7 +158,12 @@ Type
     // Published Properties of the instance will be further restored with available data.
     // Published Properties of the instance will be further restored with available data.
     Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
     Property OngetObject : TJSONGetObjectEvent Read FOnGetObject Write FOnGetObject;
     // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
     // JSON is by definition case sensitive. Should properties be looked up case-insentive ?
-    Property CaseInsensitive : Boolean Read FCaseInsensitive Write FCaseInsensitive;
+    Property CaseInsensitive : Boolean Read GetCaseInsensitive Write SetCaseInsensitive ; deprecated;
+    // DateTime format. If not set, RFC3339DateTimeFormat is assumed.
+    // If set, it will be used as an argument to ScanDateTime. If that fails, StrToDateTime is used.
+    Property DateTimeFormat : String Read FDateTimeFormat Write FDateTimeFormat;
+    // Options overning the behaviour
+    Property Options : TJSONDestreamOptions Read FOptions Write FOptions;
   end;
   end;
 
 
   EJSONRTTI = Class(Exception);
   EJSONRTTI = Class(Exception);
@@ -151,7 +171,7 @@ Type
 
 
 implementation
 implementation
 
 
-uses variants;
+uses dateutils, variants, rtlconsts;
 
 
 ResourceString
 ResourceString
   SErrUnknownPropertyKind     = 'Unknown property kind for property : "%s"';
   SErrUnknownPropertyKind     = 'Unknown property kind for property : "%s"';
@@ -207,7 +227,8 @@ begin
   inherited Destroy;
   inherited Destroy;
 end;
 end;
 
 
-procedure TJSONDeStreamer.JSONToObject(Const JSON: TJSONStringType; AObject: TObject);
+procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONStringType;
+  AObject: TObject);
 
 
 Var
 Var
   D : TJSONData;
   D : TJSONData;
@@ -235,7 +256,7 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TJSONDeStreamer.JSONToVariant(Data : TJSONData) : Variant;
+function TJSONDeStreamer.JSONToVariant(Data: TJSONData): Variant;
 
 
 Var
 Var
   I : integer;
   I : integer;
@@ -308,6 +329,48 @@ begin
     end;
     end;
 end;
 end;
 
 
+function TJSONDeStreamer.GetCaseInsensitive: Boolean;
+begin
+  Result:=jdoCaseInsensitive in Options;
+end;
+
+procedure TJSONDeStreamer.SetCaseInsensitive(AValue: Boolean);
+begin
+  if AValue then
+    Include(Foptions,jdoCaseInsensitive)
+  else
+    Exclude(Foptions,jdoCaseInsensitive);
+end;
+
+function TJSONDeStreamer.ExtractDateTime(S: String): TDateTime;
+
+Var
+  Fmt : String;
+  E,fmtSpecified : Boolean;
+
+begin
+  E:=False;
+  FMT:=DateTimeFormat;
+  fmtSpecified:=Fmt<>'';
+  if Not fmtSpecified then
+    FMT:=RFC3339DateTimeFormat;
+  Try
+    // No TryScanDateTime
+    Result:=ScanDatetime(FMT,S);
+  except
+    if fmtSpecified then
+      Raise
+    else
+      E:=True;
+  end;
+  if E then
+    if not TryStrToDateTime(S,Result) then
+      if not TryStrToDate(S,Result) then
+        if not TryStrToTime(S,Result) then
+          Raise EConvertError.CreateFmt(SInvalidDateTime,[S]);
+//  ExtractDateTime(PropData.AsString)
+end;
+
 procedure TJSONDeStreamer.RestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 procedure TJSONDeStreamer.RestoreProperty(AObject : TObject;PropInfo : PPropInfo; PropData : TJSONData);
 
 
 Var
 Var
@@ -331,7 +394,9 @@ begin
         FOnPropError(Self,AObject,PropInfo,PropData,E,B);
         FOnPropError(Self,AObject,PropInfo,PropData,E,B);
         If Not B then
         If Not B then
           Raise;
           Raise;
-        end;
+        end
+      else if Not (jdoIgnorePropertyErrors in Options) then
+        Raise;
   end;
   end;
 end;
 end;
 
 
@@ -367,7 +432,7 @@ begin
     tkFloat :
     tkFloat :
       begin
       begin
       if (TI=TypeInfo(TDateTime)) and (PropData.JSONType=jtString) then
       if (TI=TypeInfo(TDateTime)) and (PropData.JSONType=jtString) then
-        SetFloatProp(AObject,PI,StrToDateTime(PropData.AsString))
+        SetFloatProp(AObject,PI,ExtractDateTime(PropData.AsString))
       else
       else
         SetFloatProp(AObject,PI,PropData.AsFloat)
         SetFloatProp(AObject,PI,PropData.AsFloat)
       end;
       end;
@@ -435,7 +500,8 @@ begin
   end;
   end;
 end;
 end;
 
 
-procedure TJSONDeStreamer.JSONToObject(Const JSON: TJSONObject; AObject: TObject);
+procedure TJSONDeStreamer.JSONToObject(const JSON: TJSONObject; AObject: TObject
+  );
 Var
 Var
   I,J : Integer;
   I,J : Integer;
   PIL : TPropInfoList;
   PIL : TPropInfoList;
@@ -516,7 +582,9 @@ begin
   end;
   end;
 end;
 end;
 
 
-Function TJSONDeStreamer.GetObject(AInstance : TObject; Const APropName : TJSONStringType; D : TJSONObject; PropInfo : PPropInfo) : TObject;
+function TJSONDeStreamer.GetObject(AInstance: TObject;
+  const APropName: TJSONStringType; D: TJSONObject; PropInfo: PPropInfo
+  ): TObject;
 
 
 Var
 Var
   C : TClass;
   C : TClass;
@@ -1032,12 +1100,18 @@ begin
     S:=''
     S:=''
   else if (DateTimeFormat<>'') then
   else if (DateTimeFormat<>'') then
     S:=FormatDateTime(DateTimeFormat,DateTime)
     S:=FormatDateTime(DateTimeFormat,DateTime)
-  else if Frac(DateTime)=0 then
-    S:=DateToStr(DateTime)
-  else if Trunc(DateTime)=0 then
-    S:=TimeToStr(DateTime)
+  else if (jsoLegacyDateTime in options) then  
+    begin
+    if Frac(DateTime)=0 then
+      S:=DateToStr(DateTime)
+    else if Trunc(DateTime)=0 then
+      S:=TimeToStr(DateTime)
+    else
+      S:=DateTimeToStr(DateTime);
+    end
   else
   else
-    S:=DateTimeToStr(DateTime);
+    S:=FormatDateTime(RFC3339DateTimeFormat,DateTime);
+     
   Result:=TJSONString.Create(S);
   Result:=TJSONString.Create(S);
 end;
 end;
 
 

+ 1007 - 0
packages/fcl-json/tests/testcomps.pp

@@ -0,0 +1,1007 @@
+unit testcomps;
+
+interface
+
+uses classes, sysutils;
+
+Type
+  TEmptyComponent = Class(TComponent)
+  end;
+
+  // Simple integer, fits in 1 byte
+  TIntegerComponent = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 2 bytes
+  TIntegerComponent2 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, fits in 3 bytes
+  TIntegerComponent3 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp;
+  end;
+
+  // Simple integer, Default value. (set)
+  TIntegerComponent4 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple integer, Default value. (not set)
+  TIntegerComponent5 = Class(TComponent)
+  private
+    FIntProp: Integer;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property IntProp : Integer Read FIntProp Write FIntProp default 6;
+  end;
+
+  // Simple Int64 property fits in a single byte.
+  TInt64Component = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 2 bytes.
+  TInt64Component2 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 3 bytes.
+  TInt64Component3 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Simple Int64 property fits 4 bytes.
+  TInt64Component4 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp;
+  end;
+
+  // Int64 property with default, set.
+  TInt64Component5 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // Int64 property with default, not set.
+  TInt64Component6 = Class(TComponent)
+  private
+    FIntProp: Int64;
+  Public
+     Constructor Create(AOwner : TComponent); override;
+  Published
+    Property Int64Prop : Int64 Read FIntProp Write FIntProp default 7;
+  end;
+
+  // String property.
+  TStringComponent = Class(TComponent)
+  private
+    F: String;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // String property, empty
+  TStringComponent2 = Class(TComponent)
+  private
+    F: String;
+  Published
+    Property StringProp : String Read F Write F;
+  end;
+
+  // WideString property
+  TWideStringComponent = Class(TComponent)
+  private
+    F: WideString;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // WideString property, empty
+  TWideStringComponent2 = Class(TComponent)
+  private
+    F: WideString;
+  Published
+    Property WideStringProp : WideString Read F Write F;
+  end;
+
+  // Single property
+  TSingleComponent = Class(TComponent)
+  private
+    F: Single;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property SingleProp : Single Read F Write F;
+  end;
+
+  // Double property
+  TDoubleComponent = Class(TComponent)
+  private
+    F: Double;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DoubleProp : Double Read F Write F;
+  end;
+
+  // Extended property
+  TExtendedComponent = Class(TComponent)
+  private
+    F: Extended;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property ExtendedProp : Extended Read F Write F;
+  end;
+
+  // Comp property
+  TCompComponent = Class(TComponent)
+  private
+    F: Comp;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property ExtendedProp : Comp Read F Write F;
+  end;
+
+  // Currency property
+  TCurrencyComponent = Class(TComponent)
+  private
+    F: Currency;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CurrencyProp : Currency Read F Write F;
+  end;
+
+  // DateTime property, date only
+  TDateTimeComponent = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, time only
+  TDateTimeComponent2 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  // DateTime property, Date and time
+  TDateTimeComponent3 = Class(TComponent)
+  private
+    F: TDateTime;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property DateTimeProp : TDateTime Read F Write F;
+  end;
+
+  TDice = (one,two,three,four,five,six);
+
+  // Enum property. No default (i.e. 0)
+  TEnumComponent = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum  property, not set
+  TEnumComponent2 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F;
+  end;
+
+  // Enum property with default, not set
+  TEnumComponent3 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, set
+  TEnumComponent4 = Class(TComponent)
+  private
+    F: TDice;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Dice : TDice Read F Write F default two;
+  end;
+
+  // Enum property with default, no need to set
+  TEnumComponent5 = Class(TComponent)
+  private
+    F: TDice;
+  Published
+    Property Dice : TDice Read F Write F default one;
+  end;
+
+  Throws = Set of TDice;
+
+  // Set property, no default.
+  TSetComponent = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, no default, not set
+  TSetComponent2 = Class(TComponent)
+  private
+    F: Throws;
+  Published
+    Property Throw : Throws Read F Write F;
+  end;
+
+  // Set property, default, not set
+  TSetComponent3 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Set property, default, set
+  TSetComponent4 = Class(TComponent)
+  private
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property Throw : Throws Read F Write F default [three,six];
+  end;
+
+  // Multiple components.
+  TMultipleComponent = Class(TComponent)
+  private
+    FCurrency: Currency;
+    FInt: Integer;
+    FString: String;
+    FDice: TDice;
+    F: Throws;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property IntProp : Integer Read FInt Write FInt;
+    Property StringProp : String Read FString Write FString;
+    Property CurrencyProp : Currency Read FCurrency Write FCurrency;
+    Property Dice : TDice Read FDice Write FDice;
+    Property Throw : Throws Read F Write F;
+  end;
+
+  TTestPersistent1 = Class(TPersistent)
+  private
+    FInt: Integer;
+    FAstring: String;
+  Public
+    Procedure Assign(ASource : TPersistent); override;
+  Published
+    Property AInteger : Integer Read FInt Write FInt;
+    Property AString : String Read FAstring Write FAsTring;
+  end;
+
+  // Persistent as a published property.
+  TPersistentComponent = Class(TComponent)
+  private
+    FPers: TTestPersistent1;
+    procedure SetPers(const Value: TTestPersistent1);
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+    Destructor Destroy; override;
+  Published
+    Property Persist : TTestPersistent1 Read FPers Write SetPers;
+  end;
+
+  // For use in collection streaming
+  TTestItem = Class(TCollectionItem)
+  Private
+    F : String;
+  Published
+    Property StrProp : String Read F Write F;
+  end;
+
+  // For use in collection streaming: items with two properties
+
+  { TTest2Item }
+
+  TTest2Item = Class(TCollectionItem)
+  Private
+    F1, F2 : String;
+  public
+  Published
+    Property StrProp1 : String Read F1 Write F1;
+    Property StrProp2 : String Read F2 Write F2;
+  end;
+
+
+  TTestCollection = Class(TCollection)
+  Public
+    Constructor Create;
+  end;
+
+  // Empty collection
+  TCollectionComponent = Class(TComponent)
+  Private
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetCOll;
+  end;
+
+  // collection with elements.
+  TCollectionComponent2 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with elements, one has no props
+  TCollectionComponent3 = Class(TCollectionComponent)
+  Public
+    Constructor Create(AOwner : TComponent); override;
+  end;
+
+  // collection with changed propname, one element
+  TCollectionComponent4 = Class(TComponent)
+    FColl : TTestCollection;
+    Procedure SetColl(AColl : TTestCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TTestCollection Read FColl Write SetColl;
+  end;
+
+  // collection two elements, items with two properties
+  TCollectionComponent5 = Class(TComponent)
+    FColl : TCollection;
+    Procedure SetColl(AColl : TCollection);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property Coll : TCollection Read FColl Write SetColl;
+  end;
+
+  // Component as published property
+  TOwnedComponent = Class(TComponent)
+    F : TComponent;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Property CompProp : TComponent Read F Write F;
+  end;
+
+  // Use this if owned components should also be streamed.
+  TChildrenComponent = Class(TComponent)
+    // Owned components are children
+    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+  end;
+
+  // Stream sub component.
+  TStreamedOwnedComponent = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Sub : TIntegerComponent;
+  end;
+  
+  // Stream 2 sub components
+  TStreamedOwnedComponents = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    SubA : TIntegerComponent;
+    SubB : TStringComponent;
+  end;
+
+  // Method tests.
+
+  THandler = Procedure of Object;
+
+  // Method property that points to own method.
+  TMethodComponent = Class(TComponent)
+  Private
+    F : THandler;
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod;
+    Property MethodProp : THandler Read F Write F;
+  end;
+
+  // Method property of owned component that points to own method.
+  TMethodComponent2 = Class(TChildrenComponent)
+  Public
+    Constructor Create(AOwner : TComponent);  override;
+  Published
+    Procedure MyMethod2;
+  end;
+
+  { TVariantComponent }
+
+  TVariantComponent = Class(TComponent)
+  private
+    FVariant: Variant;
+  Published
+    Property VariantProp : Variant Read FVariant Write FVariant;
+  end;
+
+  TBooleanComponent = Class(TComponent)
+  private
+    FBoolean: Boolean;
+  Published
+    Property BooleanProp : Boolean Read FBoolean Write FBoolean;
+  end;
+
+  TemptyPersistent = Class(TPersistent);
+
+  { TStringsCOmponent }
+
+  TStringsCOmponent = Class(TComponent)
+  private
+    FStrings: TStrings;
+    procedure SetStrings(AValue: TStrings);
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+  Published
+    Property StringsProp : TStrings Read FStrings Write SetStrings;
+  end;
+Implementation
+
+{ TStringsCOmponent }
+
+procedure TStringsCOmponent.SetStrings(AValue: TStrings);
+begin
+  if FStrings=AValue then Exit;
+  FStrings.Assign(AValue);
+end;
+
+constructor TStringsCOmponent.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FStrings:=TStringList.Create;
+  FStrings.Add('One');
+  FStrings.Add('Two');
+  FStrings.Add('Three');
+end;
+
+destructor TStringsCOmponent.Destroy;
+begin
+  FreeAndNil(FStrings);
+  inherited Destroy;
+end;
+
+procedure TChildrenComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+
+Var
+  I : Integer;
+
+begin
+  For I:=0 to ComponentCount-1 do
+    Proc(Components[i]);
+end;
+
+
+{ TIntegerComponent }
+
+constructor TIntegerComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=3;
+end;
+
+
+{ TInt64Component }
+
+constructor TInt64Component.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=4;
+end;
+
+{ TInt64Component2 }
+
+constructor TInt64Component2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=2 shl 9;
+end;
+
+{ TIntegerComponent2 }
+
+constructor TIntegerComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 9;
+end;
+
+{ TIntegerComponent3 }
+
+constructor TIntegerComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component3 }
+
+constructor TInt64Component3.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=2 shl 17;
+end;
+
+{ TInt64Component4 }
+
+constructor TInt64Component4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=Int64(MaxInt)+Int64(2 shl 17);
+end;
+
+{ TStringComponent }
+
+constructor TStringComponent.Create(AOwner: TComponent);
+begin
+  Inherited;
+  F:='A string';
+end;
+
+{ TWideStringComponent }
+
+constructor TWideStringComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:='Some WideString';
+end;
+
+{ TSingleComponent }
+
+constructor TSingleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=1.23;
+end;
+
+{ TDoubleComponent }
+
+constructor TDoubleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=2.34;
+end;
+
+{ TExtendedComponent }
+
+constructor TExtendedComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=3.45;
+end;
+
+{ TCompComponent }
+
+constructor TCompComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=4.56;
+end;
+
+{ TCurrencyComponent }
+
+constructor TCurrencyComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=5.67;
+end;
+
+{ TDateTimeComponent }
+
+constructor TDateTimeComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1);
+end;
+
+{ TDateTimeComponent2 }
+
+constructor TDateTimeComponent2.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeTime(23,20,0,0);
+end;
+
+{ TDateTimeComponent3 }
+
+constructor TDateTimeComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=EncodeDate(1996,8,1)+EncodeTime(23,20,0,0);
+end;
+
+{ TEnumComponent }
+
+constructor TEnumComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Four;
+end;
+
+{ TSetComponent }
+
+constructor TSetComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[two,five];
+end;
+
+{ TIntegerComponent4 }
+
+constructor TIntegerComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=6;
+end;
+
+{ TIntegerComponent5 }
+
+constructor TIntegerComponent5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=5;
+end;
+
+{ TInt64Component5 }
+
+constructor TInt64Component5.Create(AOwner: TComponent);
+begin
+  inherited;
+  FIntProp:=7;
+end;
+
+{ TInt64Component6 }
+
+constructor TInt64Component6.Create(AOwner: TComponent);
+begin
+  inherited;
+  FintProp:=8;
+end;
+
+{ TEnumComponent3 }
+
+constructor TEnumComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Three;
+end;
+
+{ TEnumComponent4 }
+
+constructor TEnumComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=Two;
+end;
+
+{ TSetComponent4 }
+
+constructor TSetComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[Three,Six];
+end;
+
+{ TSetComponent3 }
+
+constructor TSetComponent3.Create(AOwner: TComponent);
+begin
+  inherited;
+  F:=[One,Four];
+end;
+
+{ TMultipleComponent }
+
+constructor TMultipleComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FInt:=1;
+  FCurrency:=2.3;
+  FString:='A String';
+  FDice:=two;
+  F:=[three,four];
+end;
+
+{ TTestPersistent1 }
+
+procedure TTestPersistent1.Assign(ASource: TPersistent);
+
+Var
+  T :TTestPersistent1;
+
+begin
+  If ASource is TTestPersistent1 then
+    begin
+    T:=ASource as TTestPersistent1;
+    FInt:=T.FInt;
+    FAString:=T.FAString;
+    end
+  else
+    inherited;
+end;
+
+{ TPersistentComponent }
+
+constructor TPersistentComponent.Create(AOwner: TComponent);
+begin
+  inherited;
+  FPers:=TTestPersistent1.Create;
+  FPers.AInteger:=3;
+  FPers.AString:='A persistent string';
+end;
+
+Destructor TPersistentComponent.Destroy;
+
+begin
+  FreeAndNil(FPers);
+  Inherited;
+end;
+
+procedure TPersistentComponent.SetPers(const Value: TTestPersistent1);
+begin
+  FPers.Assign(Value);
+end;
+
+{ TCollectionComponent }
+
+Procedure TCollectionComponent.SetColl(AColl : TCollection);
+
+begin
+  FColl.Assign(AColl);
+end;
+
+Constructor TCollectionComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  FColl:=TCollection.Create(TTestItem);
+end;
+
+Destructor TCollectionComponent.Destroy;
+
+begin
+  FreeAndNil(FColl);
+  Inherited;
+end;
+
+{ TCollectionComponent2 }
+
+Constructor TCollectionComponent2.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='Second';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponen3 }
+
+Constructor TCollectionComponent3.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  (FColl.Add as TTestItem).StrProp:='First';
+  (FColl.Add as TTestItem).StrProp:='';
+  (FColl.Add as TTestItem).StrProp:='Third';
+end;
+
+{ TCollectionComponent4 }
+
+constructor TCollectionComponent4.Create(AOwner: TComponent);
+begin
+  inherited;
+  FColl:=TTestCollection.Create;
+  (FColl.Add as TTestItem).StrProp:='Something'
+end;
+
+destructor TCollectionComponent4.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited;
+end;
+
+procedure TCollectionComponent4.SetColl(AColl: TTestCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+{ TCollectionComponent5 }
+
+procedure TCollectionComponent5.SetColl(AColl: TCollection);
+begin
+  FColl.Assign(AColl);
+end;
+
+constructor TCollectionComponent5.Create(AOwner: TComponent);
+var
+  Item : TTest2Item;
+begin
+  inherited Create(AOwner);
+  FColl:=TCollection.Create(TTest2Item);
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something';
+  Item.StrProp2 := 'Otherthing';
+  Item := FColl.Add as TTest2Item;
+  Item.StrProp1 := 'Something 2';
+  Item.StrProp2 := 'Otherthing 2';
+end;
+
+destructor TCollectionComponent5.Destroy;
+begin
+  FreeAndNil(FColl);
+  inherited Destroy;
+end;
+
+{ TTestCollection }
+
+Constructor TTestCollection.Create;
+begin
+  Inherited Create(TTestitem);
+  PropName:='MyCollProp';
+end;
+
+{ TStreamedOwnedComponent }
+
+Constructor TStreamedOwnedComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+  Sub:=TIntegerComponent.Create(Self);
+  Sub.Name:='Sub';
+end;
+
+{ TStreamedOwnedComponents }
+
+constructor TStreamedOwnedComponents.Create(AOwner: TComponent);
+begin
+  inherited;
+  SubA:=TIntegerComponent.Create(Self);
+  SubA.Name:='SubA';
+  SubB:=TStringComponent.Create(Self);
+  SubB.Name:='SubB';
+end;
+
+
+Constructor TOwnedComponent.Create(AOwner : TComponent);
+
+Var
+  C: TComponent;
+
+begin
+  Inherited;
+  C:=TIntegerComponent.Create(Self);
+  C.Name:='SubComponent';
+  CompProp:=C;
+end;
+
+
+{ TMethodComponent }
+
+Constructor TMethodComponent.Create(AOwner : TComponent);
+
+begin
+  Inherited;
+{$ifdef fpc}
+  MethodProp:=@MyMethod;
+{$else}
+  MethodProp:=MyMethod;
+{$endif}
+end;
+
+Procedure TMethodComponent.MyMethod;
+
+begin
+  // Do nothing.
+end;
+
+{ TMethodComponent2 }
+
+constructor TMethodComponent2.Create(AOwner: TComponent);
+
+Var
+  C : TMethodComponent;
+
+begin
+  inherited;
+  C:=TMethodComponent.Create(Self);
+  C.Name:='AComponent';
+{$ifdef fpc}
+  C.MethodProp:=@MyMethod2;
+{$else}
+  C.MethodProp:=MyMethod2;
+{$endif}
+end;
+
+Procedure TMethodComponent2.MyMethod2;
+
+begin
+ // Do nothng
+end;
+
+
+end.

+ 7 - 1
packages/fcl-json/tests/testjson.lpi

@@ -25,7 +25,7 @@
     <RunParams>
     <RunParams>
       <local>
       <local>
         <FormatVersion Value="1"/>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="--suite=TTestParser.TestComment"/>
+        <CommandLineParams Value="--suite=TTestJSONDeStreamer.TestDateTimeFormat"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
       </local>
     </RunParams>
     </RunParams>
@@ -67,6 +67,12 @@
         <UseAnsiStrings Value="False"/>
         <UseAnsiStrings Value="False"/>
       </SyntaxOptions>
       </SyntaxOptions>
     </Parsing>
     </Parsing>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+        <TrashVariables Value="True"/>
+      </Debugging>
+    </Linking>
   </CompilerOptions>
   </CompilerOptions>
   <Debugging>
   <Debugging>
     <Exceptions Count="2">
     <Exceptions Count="2">

+ 3 - 3
packages/fcl-json/tests/testjson.pp

@@ -17,7 +17,8 @@
 program testjson;
 program testjson;
 
 
 uses
 uses
-  Classes, testjsondata, testjsonparser, consoletestrunner; //, testjsonrtti, fpjsonrtti;
+  Classes, testjsondata, testjsonparser, testjsonrtti, consoletestrunner;
+
 type
 type
   { TLazTestRunner }
   { TLazTestRunner }
    TMyTestRunner = class(TTestRunner)
    TMyTestRunner = class(TTestRunner)
@@ -30,8 +31,7 @@ var
 begin
 begin
   DefaultFormat := fPlain;
   DefaultFormat := fPlain;
   DefaultRunAllTests := True;
   DefaultRunAllTests := True;
-
-  Application := TMyTestRunner.Create(nil); 
+  Application := TMyTestRunner.Create(nil);
   Application.Initialize;
   Application.Initialize;
   Application.Run;  
   Application.Run;  
   Application.Free;
   Application.Free;

File diff suppressed because it is too large
+ 178 - 112
packages/fcl-json/tests/testjsonrtti.pp


Some files were not shown because too many files changed in this diff