mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 12:29:25 +02:00
* 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 -
This commit is contained in:
michael
parent
06ef4e6ca8
commit
2b52be98b5
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user