* Merging revisions r43654,r43662,r43663,r43664 from trunk:

    ------------------------------------------------------------------------
    r43654 | michael | 2019-12-06 09:53:43 +0100 (Fri, 06 Dec 2019) | 1 line
    
    * Fix bug #0035436
    ------------------------------------------------------------------------
    r43662 | michael | 2019-12-08 21:05:14 +0100 (Sun, 08 Dec 2019) | 1 line
    
    * Fix memleaks (bug ID 36408)
    ------------------------------------------------------------------------
    r43663 | michael | 2019-12-08 21:05:53 +0100 (Sun, 08 Dec 2019) | 1 line
    
    * Fix memleak in comparer, improve date recognition
    ------------------------------------------------------------------------
    r43664 | michael | 2019-12-08 21:11:23 +0100 (Sun, 08 Dec 2019) | 1 line
    
    * Fix lime color (bug ID 0036407)
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43666 -

packages/fcl-db/src/json/fpjsondataset.pp

@@ -179,6 +179,7 @@ type
     Function Compare(aRowindex : integer) : Integer;
   Public
     Constructor Create(aDataset : TBaseJSONDataset; aFields : String; aValues : Variant; aOptions : TLocateOptions);
+    Destructor Destroy; override;
     Property Dataset : TBaseJSONDataset Read FDataset;
     property Items [Index : Integer] : TFieldComparer Read GetFieldComparer;
     Property Options : TLocateOptions Read FOptions Write FOptions;
@@ -408,7 +409,10 @@ var
 
 begin
   S1:=GetFieldValue(Rowindex).AsString;
-  S2:=String(aValue);
+  if varIsNull(aValue) then
+    S2:=''
+  else
+    S2:=String(aValue);
   if loPartialKey in Options then
     S1:=Copy(S1,1,Length(S2));
   if loCaseInsensitive in options then
@@ -543,6 +547,18 @@ begin
   ConstructItems(aFields);
 end;
 
+destructor TRecordComparer.Destroy;
+
+Var
+  F : TFieldComparer;
+
+begin
+  For F in Fitems do
+     F.Free;
+  FItems:=Nil;
+  inherited Destroy;
+end;
+
 { TDefaultJSONIndex }
 
 
@@ -1049,7 +1065,7 @@ begin
   end;
   If (Ptrn='') then
     Case F.DataType of
-      ftDate : Result:=StrToDate(S,'y/m/d');
+      ftDate : Result:=StrToDate(S,'y/m/d','-');
       ftTime : Result:=StrToTime(S);
       ftDateTime : Result:=StrToDateTime(S);
     end
@@ -1077,7 +1093,7 @@ begin
   end;
   If (Ptrn='') then
     Case F.DataType of
-      ftDate : Result:=DateToStr(DT);
+      ftDate : Result:=FormatDateTime('yyyy/mm/dd',DT);
       ftTime : Result:=TimeToStr(DT);
       ftDateTime : Result:=DateTimeToStr(DT);
     end

packages/fcl-db/tests/testjsondataset.pp

@@ -1,15 +1,15 @@
-program devds;
+program testjsondataset;
 
 {$DEFINE TESTCALCFIELDS}
 {$DEFINE TESTLOOKUPFIELDS}
 
-uses variants, varutils, sysutils, db, fpjson , fpjsondataset, ExtJSDataset, types;
+uses classes, variants, varutils, sysutils, db, fpjson , fpjsondataset, ExtJSDataset, types;
 
 Type
 
   { TApp }
 
-  TApp = Class(TObject)
+  TApp = Class(TComponent)
   private
     DS : TExtJSJSONObjectDataSet;
     DC : TExtJSJSONObjectDataSet;
@@ -70,7 +70,7 @@ Var
 
 begin
   Writeln('Creating dataset');
-  DS:=TExtJSJSONObjectDataSet.Create(Nil);
+  DS:=TExtJSJSONObjectDataSet.Create(Self);
   DS.MetaData:=GetJSON('{ "fields" : [ '+
                                           ' { "name": "firstname"}, '+
                                           ' { "name": "lastname"}, '+
@@ -85,7 +85,7 @@ begin
                                   '  {"firstname" : "Bruno", "lastname" : "Fierens", "children" : 3, "birthday" : "1970-07-09", "business" : true, "weight": 77.3, "country": "BE"  },'+
                                   '  {"firstname" : "Detlef", "lastname" : "Overbeek", "children" : 2, "birthday" : "1950-07-08", "business" : true, "weight": 78.8, "country": "NL"  }'+
                                   ' ]') as TJSONArray;
-  DC:=TExtJSJSONObjectDataSet.Create(Nil);
+  DC:=TExtJSJSONObjectDataSet.Create(Self);
   DC.MetaData:=GetJSON('{ "fields" : [ '+
                                        ' { "name": "code"}, '+
                                        ' { "name": "name"} '+
@@ -174,7 +174,7 @@ begin
   Writeln('Modified before  (expect False): ',DS.Modified);
   DumpRecord(DS);
   DS.FieldByName('firstname').AsString:='Florian';
-  Writeln('Old value of field first name (expect null): ', DS.FieldByName('firstname').OldValue);
+  Writeln('Old value of field first name (expect null): ', varisNull(DS.FieldByName('firstname').OldValue) );
   DS.FieldByName('lastname').AsString:='Klaempfl';
   DS.FieldByName('children').AsInteger:=1;
   DS.FieldByName('birthday').AsDateTime:=EncodeDate(1980,5,4);
@@ -288,7 +288,7 @@ begin
   DSS:=Nil;
   t:=TDataLink.Create;
   try
-    DSS:=TDatasource.Create(Nil);
+    DSS:=TDatasource.Create(self);
     DSS.DataSet:=DS;
     Writeln('Buffercount');
     t.BufferCount := 10;
@@ -323,6 +323,7 @@ begin
   DSS:=Nil;
   t:=TDataLink.Create;
   try
+    DSS:=TDatasource.Create(Self);
     DSS.DataSet:=DS;
     DSS.DataSet:=DS;
     t.DataSource := DSS;
@@ -421,9 +422,9 @@ begin
 
     DC.Open;
     DS.Open;
-//    TestLocate;
+    TestLocate;
     TestLookup;
-    exit;
+//    exit;
     TestNavigation;
     TestAppend;
     TestEdit;
@@ -444,7 +445,11 @@ begin
 end;
 
 begin
-  With Tapp.Create do
-    Run;
+  With Tapp.Create(nil) do
+    try
+      Run;
+    finally
+      Free;
+    end;  
 end.
 

packages/fcl-image/src/fpcolors.inc

@@ -43,7 +43,7 @@ const
   colPurple     : TFPColor = (Red: $8000; Green: $0000; Blue: $8000; Alpha: alphaOpaque);
   colTeal       : TFPColor = (Red: $0000; Green: $8000; Blue: $8000; Alpha: alphaOpaque);
   colSilver     : TFPColor = (Red: $c000; Green: $c000; Blue: $c000; Alpha: alphaOpaque);
-  colLime       : TFPColor = (Red: $0000; Green: $ffff; Blue: $0000; Alpha: alphaOpaque);
+  colLime       : TFPColor = (Red: $bfbf; Green: $ffff; Blue: $0000; Alpha: alphaOpaque);
   colFuchsia    : TFPColor = (Red: $ffff; Green: $0000; Blue: $ffff; Alpha: alphaOpaque);
   colAqua       : TFPColor = (Red: $0000; Green: $ffff; Blue: $ffff; Alpha: alphaOpaque);
 

packages/fcl-web/src/base/restbase.pp

@@ -730,7 +730,7 @@ Var
   D : TJSONEnum;
   O : TObjectArray;
   I : Integer;
-  PA : ^pdynarraytypeinfo;
+  PTD : PTypeData;
   ET : PTypeInfo;
   LPN,AN : String;
   AP : Pointer;
@@ -760,10 +760,8 @@ begin
     begin
     // Get array value
     AP:=GetObjectProp(Self,P);
-    i:=Length(P^.PropType^.name);
-    PA:=@(pdynarraytypeinfo(P^.PropType)^.elesize)+i;
-    PA:=@(pdynarraytypeinfo(P^.PropType)^.eletype)+i;
-    ET:=PTYpeInfo(PA^);
+    PTD:=GetTypeData(P^.PropType);
+    ET:=PTD^.ElType2;
     if (ET^.Kind=tkClass) then
       begin
       // get object type name
@@ -814,7 +812,6 @@ Var
   I : Integer;
   L : TBaseObjectList;
   NL : TBaseNamedObjectList;
-  PA : ^pdynarraytypeinfo;
 
 begin
   if P^.PropType^.Kind=tkDynArray then
@@ -822,12 +819,9 @@ begin
     A:=GetDynArrayProp(P);
     For I:=0 to Length(TObjectArray(A))-1 do
       FreeAndNil(TObjectArray(A)[i]);
-    // Writeln(ClassName,' (Object) Setting length of array property ',P^.Name,'(type: ',P^.PropType^.Name,')  to ',AValue.Count,' (current: ',Length(TObjectArray(A)),')');
     SetLength(TObjectArray(A),AValue.Count);
-    i:=Length(P^.PropType^.name);
-    PA:=@(pdynarraytypeinfo(P^.PropType)^.elesize)+i;
-    PA:=@(pdynarraytypeinfo(P^.PropType)^.eletype)+i;
-    AN:=PTYpeInfo(PA^)^.Name;
+    T:=GetTypeData(P^.PropType);
+    AN:=T^.ElType2^.Name;
     I:=0;
     For D in AValue do
       begin
@@ -841,15 +835,6 @@ begin
       end;
     // Writeln(ClassName,' Done with array ',P^.Name,', final array length: ', Length(TObjectArray(A)));
     SetDynArrayProp(P,A);
-    {
-      For I:=0 to Length(TObjectArray(A))-1 do
-        if IsPublishedProp(TObjectArray(A)[i],'name') then
-    SetDynArrayProp(P,AP);
-      //   Writeln(ClassName,'.',P^.name,'[',i,'] : ',getStrProp(TObjectArray(A)[I],'name'));
-      B:=GetDynArrayProp(P);
-      If Pointer(B)<>Pointer(A) then
-      //  Writeln(ClassName,': Array ',P^.Name,'was not set correctly');
-    }
     Exit;
     end;
   if Not (P^.PropType^.Kind=tkClass) then
@@ -987,8 +972,8 @@ function TBaseObject.GetArrayProperty(P: PPropInfo): TJSONData;
 Var
   AO : TObject;
   I : Integer;
-  PA : ^pdynarraytypeinfo;
   ET : PTypeInfo;
+  PTD : PTypeData;
   AP : Pointer;
   A : TJSONArray;
   O : TJSONObject;
@@ -998,9 +983,8 @@ begin
   Result:=A;
   // Get array value type
   AP:=GetObjectProp(Self,P);
-  i:=Length(P^.PropType^.name);
-  PA:=@(pdynarraytypeinfo(P^.PropType)^.eletype)+i;
-  ET:=PTYpeInfo(PA^);
+  PTD:=GetTypeData(P^.PropType);
+  ET:=PTD^.ElType2;
   // Fill in all elements
   Case ET^.Kind of
   tkClass:
@@ -1069,7 +1053,7 @@ var
   P : PPropInfo;
   i,j,count,len:integer;
   A : pointer;
-  PA : ^pdynarraytypeinfo;
+  PTD : PTypeData;
   O : TObject;
 
 begin
@@ -1091,8 +1075,8 @@ begin
           if (ctArray in ChildTypes) then
             begin
             len:=Length(P^.PropType^.Name);
-            PA:=@(pdynarraytypeinfo(P^.PropType)^.eletype)+len;
-            if PTYpeInfo(PA^)^.Kind=tkClass then
+            PTD:=GetTypeData(P^.PropType);
+            if PTD^.ElType2^.Kind=tkClass then
               begin
               A:=GetDynArrayProp(P);
 {$IFDEF DUMPARRAY}