mORMot and Open Source friends
Check-in [5e5b7d9e7c]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:{3588} ensure SameValue() algorithm matches System.Math version
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5e5b7d9e7c9324ed6f1b024798ae7ddec0a553ae
User & Date: ab 2017-04-06 12:40:01
Context
2017-04-07
07:26
{3589} another fix for implementing ranges in http.sys to match the headers reported by http://stackoverflow.com/a/8507991/458259 for a WebKit/Safari client check-in: 01f901ec1e user: ab tags: trunk
2017-04-06
12:40
{3588} ensure SameValue() algorithm matches System.Math version check-in: 5e5b7d9e7c user: ab tags: trunk
10:47
{3587} TDocVariantData.SearchItemByProp/DeleteByProp will work on dvObject and not only dvArray check-in: bf920333a3 user: ab tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to SynCommons.pas.

15371
15372
15373
15374
15375
15376
15377
15378

15379
15380
15381
15382
15383
15384
15385
15386
15387
.....
27360
27361
27362
27363
27364
27365
27366



27367
27368
27369


27370
27371
27372



27373
27374
27375


27376
27377
27378
27379
27380
27381
27382
27383


27384
27385
27386



27387
27388
27389


27390
27391
27392
27393
27394
27395
27396
27397
27398
27399
.....
42705
42706
42707
42708
42709
42710
42711

42712
42713



42714
42715
42716
42717
42718
42719
42720
42721
42722
42723
42724
42725
42726
42727
42728
42729
42730
42731
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item will be deleted, on match
    // - returns FALSE if no match is found, TRUE if found and deleted
    // - will call VariantEquals() for value comparison
    function DeleteByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): boolean;
    /// delete one or several value/item in this document, from its value
    // - return TRUE on success, FALSE if the supplied value does not exist

    // - if the value exists several times, all occurences would be removed
    function DeleteByValue(const aValue: Variant; CaseInsensitive: boolean=false): boolean;
    /// delete all values matching the first characters of a property name
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - will use IdemPChar(), so search would be case-insensitive
    function DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
................................................................................
begin
  result[0] := #2;
  if Value>99 then
    Value := 99;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;




function SameValue(const A, B: Double; DoublePrec: double): Boolean;
var AbsA,AbsB: double;
begin // faster than the Math unit version


  AbsA := Abs(A);
  AbsB := Abs(B);
  if AbsA<AbsB then



    AbsA := AbsA*DoublePrec else
    AbsA := AbsB*DoublePrec; // AbsA := Min(Abs(A),Abs(B))*DoublePrec
  // AbsA is the allowed Epsilon value


  if AbsA<DoublePrec then
    Result := Abs(A-B)<=DoublePrec else
    Result := Abs(A-B)<=AbsA;
end;

function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended): Boolean;
var AbsA,AbsB: TSynExtended;
begin // faster than the Math unit version


  AbsA := Abs(A);
  AbsB := Abs(B);
  if AbsA<AbsB then



    AbsA := AbsA*DoublePrec else
    AbsA := AbsB*DoublePrec; // AbsA := Min(Abs(A),Abs(B))*DoublePrec
  // AbsA is the allowed Epsilon value


  if AbsA<DoublePrec then
    Result := Abs(A-B)<=DoublePrec else
    Result := Abs(A-B)<=AbsA;
end;

/// return the index of Value in Values[], -1 if not found
function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer;
begin
  if CaseSensitive then begin
................................................................................
function TDocVariantData.Delete(const aName: RawUTF8): boolean;
begin
  result := Delete(GetValueIndex(aName));
end;

function TDocVariantData.DeleteByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): boolean;

begin
  result := Delete(SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive));



end;

function TDocVariantData.DeleteByValue(const aValue: Variant;
  CaseInsensitive: boolean=false): boolean;
var ndx: integer;
begin
  result := false;
  for ndx := VCount-1 downto 0 do
  if SortDynArrayVariantComp(TVarData(VValue[ndx]),TVarData(aValue),CaseInsensitive)=0 then begin
    Delete(ndx);
    result := true;
  end;
end;

function TDocVariantData.DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
var ndx: integer;
    upname: array[byte] of AnsiChar;
begin






|
>

|







 







>
>
>


<
>
>
|
|
|
>
>
>
|
<
<
>
>
|
|
<




<
>
>
|
|
|
>
>
>
|
<
<
>
>
|
|
<







 







>

|
>
>
>



|


|



|







15371
15372
15373
15374
15375
15376
15377
15378
15379
15380
15381
15382
15383
15384
15385
15386
15387
15388
.....
27361
27362
27363
27364
27365
27366
27367
27368
27369
27370
27371
27372

27373
27374
27375
27376
27377
27378
27379
27380
27381


27382
27383
27384
27385

27386
27387
27388
27389

27390
27391
27392
27393
27394
27395
27396
27397
27398


27399
27400
27401
27402

27403
27404
27405
27406
27407
27408
27409
.....
42715
42716
42717
42718
42719
42720
42721
42722
42723
42724
42725
42726
42727
42728
42729
42730
42731
42732
42733
42734
42735
42736
42737
42738
42739
42740
42741
42742
42743
42744
42745
    // - {aPropName:aPropValue} will be searched within the stored array or
    // object, and the corresponding item will be deleted, on match
    // - returns FALSE if no match is found, TRUE if found and deleted
    // - will call VariantEquals() for value comparison
    function DeleteByProp(const aPropName,aPropValue: RawUTF8;
      aPropValueCaseSensitive: boolean): boolean;
    /// delete one or several value/item in this document, from its value
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - if the value exists several times, all occurences would be removed
    function DeleteByValue(const aValue: Variant; CaseInsensitive: boolean=false): integer;
    /// delete all values matching the first characters of a property name
    // - returns the number of deleted items
    // - returns 0 if the document is not a dvObject, or if no match was found
    // - will use IdemPChar(), so search would be case-insensitive
    function DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
    /// search a property match in this document, handled as array or object
    // - {aPropName:aPropValue} will be searched within the stored array or
................................................................................
begin
  result[0] := #2;
  if Value>99 then
    Value := 99;
  PWord(@result[1])^ := TwoDigitLookupW[Value];
end;

const
  DOUBLE_RESOLUTION = 1E-12; // also for TSynExtended (FPC uses 1E-4!)

function SameValue(const A, B: Double; DoublePrec: double): Boolean;
var AbsA,AbsB: double;

begin
  if PInt64(@DoublePrec)^=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    if AbsA<AbsB then
      DoublePrec := AbsA*DOUBLE_RESOLUTION else
      DoublePrec := AbsB*DOUBLE_RESOLUTION;
    if DoublePrec<DOUBLE_RESOLUTION then
      DoublePrec := DOUBLE_RESOLUTION;


  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;

end;

function SameValueFloat(const A, B: TSynExtended; DoublePrec: TSynExtended): Boolean;
var AbsA,AbsB: TSynExtended;

begin
  if DoublePrec=0 then begin // Max(Min(Abs(A),Abs(B))*1E-12,1E-12)
    AbsA := Abs(A);
    AbsB := Abs(B);
    if AbsA<AbsB then
      DoublePrec := AbsA*DOUBLE_RESOLUTION else
      DoublePrec := AbsB*DOUBLE_RESOLUTION;
    if DoublePrec<DOUBLE_RESOLUTION then
      DoublePrec := DOUBLE_RESOLUTION;


  end;
  if A<B then
    result := (B-A)<=DoublePrec else
    result := (A-B)<=DoublePrec;

end;

/// return the index of Value in Values[], -1 if not found
function FindRawUTF8(const Values: TRawUTF8DynArray; const Value: RawUTF8;
  CaseSensitive: boolean=true): integer;
begin
  if CaseSensitive then begin
................................................................................
function TDocVariantData.Delete(const aName: RawUTF8): boolean;
begin
  result := Delete(GetValueIndex(aName));
end;

function TDocVariantData.DeleteByProp(const aPropName,aPropValue: RawUTF8;
  aPropValueCaseSensitive: boolean): boolean;
var ndx: integer;
begin
  ndx := SearchItemByProp(aPropName,aPropValue,aPropValueCaseSensitive);
  if ndx<0 then
    result := false else
    result := Delete(ndx);
end;

function TDocVariantData.DeleteByValue(const aValue: Variant;
  CaseInsensitive: boolean=false): integer;
var ndx: integer;
begin
  result := 0;
  for ndx := VCount-1 downto 0 do
  if SortDynArrayVariantComp(TVarData(VValue[ndx]),TVarData(aValue),CaseInsensitive)=0 then begin
    Delete(ndx);
    inc(result);
  end;
end;

function TDocVariantData.DeleteByStartName(aStartName: PUTF8Char; aStartNameLen: integer): integer;
var ndx: integer;
    upname: array[byte] of AnsiChar;
begin

Changes to SynSelfTests.pas.

3076
3077
3078
3079
3080
3081
3082


3083
3084
3085
3086
3087
3088
3089
....
3285
3286
3287
3288
3289
3290
3291

3292
3293
3294
3295
3296
3297
3298
....
4399
4400
4401
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
.....
14178
14179
14180
14181
14182
14183
14184
14185
14186
14187
14188
14189
14190
14191
14192
14193
14194
14195
14196
14197
14198
14199
14200
14201
14202
14203
14204
.....
15208
15209
15210
15211
15212
15213
15214
15215
15216
15217
15218
15219
15220
15221
15222
.....
15251
15252
15253
15254
15255
15256
15257
15258
15259
15260
15261
15262
15263
15264
15265
    u: string;
    varint: array[0..31] of byte;
    PB,PC: PByte;
    P: PUTF8Char;
    crc: cardinal;
    Timer: TPrecisionTimer;
begin


  Check(IntToThousandString(0)='0');
  Check(IntToThousandString(1)='1');
  Check(IntToThousandString(10)='10');
  Check(IntToThousandString(100)='100');
  Check(IntToThousandString(1000)='1,000');
  Check(IntToThousandString(10000)='10,000');
  Check(IntToThousandString(100000)='100,000');
................................................................................
    str(d,a);
    s := RawUTF8(a);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d)); // test str()
    s := ExtendedToStr(d,DOUBLE_PRECISION);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d));

    u := DoubleToString(d);
    Check(Ansi7ToString(s)=u,u);
    PC := ToVarUInt32(juint,@varint);
    Check(PC<>nil);
    Check(PAnsiChar(PC)-@varint=integer(ToVarUInt32Length(juint)));
    PB := @varint;
    Check(PtrUInt(FromVarUint32(PB))=juint);
................................................................................
  L := TSynLogFile.Create(pointer(LOG),length(LOG));
  try
    Check(L.ExecutableName='D:\Dev\lib\SQLite3\exe\TestSQL3.exe');
    Check(L.ExecutableVersion='1.2.3.4');
    if trunc(ExpectedDate)=40640 then
      Check(L.InstanceName='D:\Dev\MyLibrary.dll') else
      Check(L.InstanceName='');
    CheckSame(L.ExecutableDate,ExpectedDate,1e-7);
    Check(L.ComputerHost='MyPC');
    Check(L.LevelUsed=[sllEnter,sllLeave,sllDebug]);
    Check(L.RunningUser='MySelf');
    Check(L.CPU='2*0-15-1027');
    {$ifdef MSWINDOWS}
    Check(L.OS=wXP);
    Check(L.ServicePack=3);
    Check(not L.Wow64);
    {$endif}
    Check(L.Freq=0);
    CheckSame(L.StartDateTime,40640.502882,1E-10);
    if CheckFailed(L.Count=3) then
      exit;
    Check(L.EventLevel[0]=sllEnter);
    Check(L.EventLevel[1]=sllDebug);
    CheckSame(L.EventDateTime(1),L.StartDateTime,1 / SecsPerDay);
    Check(L.EventLevel[2]=sllLeave);
    if CheckFailed(L.LogProcCount=1) then
      exit;
    Check(L.LogProc[0].Index=0);
    Check(L.LogProc[0].Time=10020006);
  finally
    L.Free;
................................................................................
    C2.Free;
    Item.Free;
    List.Free;
    Copy.Free;
  end;
  n2 := Inst.CN.Imaginary;
  for c := 0 to Iterations shr 2 do begin
    CheckSame(Inst.CN.Imaginary,n2);
    n1 := Random*1000;
    Inst.CN.Real := n1;
    CheckSame(Inst.CN.Real,n1);
    CheckSame(Inst.CN.Imaginary,n2);
    n2 := Random*1000;
    Inst.CN.Imaginary := n2;
    CheckSame(Inst.CN.Real,n1);
    CheckSame(Inst.CN.Imaginary,n2);
    Inst.CN.Add(1,2);
    CheckSame(Inst.CN.Real,n1+1);
    n2 := n2+2;
    CheckSame(Inst.CN.Imaginary,n2);
  end;
  {$endif}
  Inst.CN.Assign(3.14,1.05946);
  CheckSame(Inst.CN.Real,3.14);
  CheckSame(Inst.CN.Imaginary,1.05946);
  Check(Inst.CU.GetContextSessionID=Inst.ExpectedSessionID);
  Check(Inst.CG.GetContextSessionGroup=Inst.ExpectedGroupID);
................................................................................
  n := Assertions;
  I.Add(1,2); // will launch TInterfaceMock.InternalCheck -> Check(true)
  n := Assertions-n; // tricky code due to Check() inlined Assertions modif.
  Check(n=1,'test should have passed');
  Check(I.Multiply(10,30)=60);
  Check(I.Multiply(2,35)=70);
  for n := 1 to 10000 do
    CheckSame(I.Subtract(n*10.5,n*0.5),n*10);
  n := Assertions;
  I := nil; // release TInterfaceMock -> will check all expectations
  n := Assertions-n;
  Check(n=2,'Add count<>3');
  TInterfaceStub.Create(TypeInfo(ISmsSender),SmsSender).
    Returns('Send',[true]);
  U.Name := 'toto';
................................................................................
     {$ifndef NOVARIANTS}
     Executes('Subtract',IntSubtractVariant,'toto').
     {$endif}
     Fails('Add','expected exception').
     Raises('Add',[1,2],ESynException,'expected exception');
  {$ifndef NOVARIANTS}
  for n := 1 to 10000 do
    CheckSame(I.Subtract(n*10.5,n*0.5),n*10);
  {$endif}
  Check(I.Subtract(10,20)=3,'Explicit result');
  {$WARN SYMBOL_PLATFORM OFF}
  {$ifndef KYLIX3}
  {$ifndef FPC}
  if DebugHook<>0 then
  {$endif}






>
>







 







>







 







|










|




|







 







|



|



|

|

|







 







|







 







|







3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
....
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
....
4402
4403
4404
4405
4406
4407
4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
.....
14181
14182
14183
14184
14185
14186
14187
14188
14189
14190
14191
14192
14193
14194
14195
14196
14197
14198
14199
14200
14201
14202
14203
14204
14205
14206
14207
.....
15211
15212
15213
15214
15215
15216
15217
15218
15219
15220
15221
15222
15223
15224
15225
.....
15254
15255
15256
15257
15258
15259
15260
15261
15262
15263
15264
15265
15266
15267
15268
    u: string;
    varint: array[0..31] of byte;
    PB,PC: PByte;
    P: PUTF8Char;
    crc: cardinal;
    Timer: TPrecisionTimer;
begin
  Check(not SameValue(386.0, 386.1));
  Check(not SameValue(386.0, 700, 2));
  Check(IntToThousandString(0)='0');
  Check(IntToThousandString(1)='1');
  Check(IntToThousandString(10)='10');
  Check(IntToThousandString(100)='100');
  Check(IntToThousandString(1000)='1,000');
  Check(IntToThousandString(10000)='10,000');
  Check(IntToThousandString(100000)='100,000');
................................................................................
    str(d,a);
    s := RawUTF8(a);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d)); // test str()
    s := ExtendedToStr(d,DOUBLE_PRECISION);
    e := GetExtended(Pointer(s),err);
    Check(SameValue(e,d));
    Check(not SameValue(e+1,d));
    u := DoubleToString(d);
    Check(Ansi7ToString(s)=u,u);
    PC := ToVarUInt32(juint,@varint);
    Check(PC<>nil);
    Check(PAnsiChar(PC)-@varint=integer(ToVarUInt32Length(juint)));
    PB := @varint;
    Check(PtrUInt(FromVarUint32(PB))=juint);
................................................................................
  L := TSynLogFile.Create(pointer(LOG),length(LOG));
  try
    Check(L.ExecutableName='D:\Dev\lib\SQLite3\exe\TestSQL3.exe');
    Check(L.ExecutableVersion='1.2.3.4');
    if trunc(ExpectedDate)=40640 then
      Check(L.InstanceName='D:\Dev\MyLibrary.dll') else
      Check(L.InstanceName='');
    CheckSame(L.ExecutableDate,ExpectedDate,1/SecsPerDay);
    Check(L.ComputerHost='MyPC');
    Check(L.LevelUsed=[sllEnter,sllLeave,sllDebug]);
    Check(L.RunningUser='MySelf');
    Check(L.CPU='2*0-15-1027');
    {$ifdef MSWINDOWS}
    Check(L.OS=wXP);
    Check(L.ServicePack=3);
    Check(not L.Wow64);
    {$endif}
    Check(L.Freq=0);
    CheckSame(L.StartDateTime,40640.502882,1/SecsPerDay);
    if CheckFailed(L.Count=3) then
      exit;
    Check(L.EventLevel[0]=sllEnter);
    Check(L.EventLevel[1]=sllDebug);
    CheckSame(L.EventDateTime(1),L.StartDateTime,1/SecsPerDay);
    Check(L.EventLevel[2]=sllLeave);
    if CheckFailed(L.LogProcCount=1) then
      exit;
    Check(L.LogProc[0].Index=0);
    Check(L.LogProc[0].Time=10020006);
  finally
    L.Free;
................................................................................
    C2.Free;
    Item.Free;
    List.Free;
    Copy.Free;
  end;
  n2 := Inst.CN.Imaginary;
  for c := 0 to Iterations shr 2 do begin
    CheckSame(Inst.CN.Imaginary,n2,1E-9);
    n1 := Random*1000;
    Inst.CN.Real := n1;
    CheckSame(Inst.CN.Real,n1);
    CheckSame(Inst.CN.Imaginary,n2,1E-9);
    n2 := Random*1000;
    Inst.CN.Imaginary := n2;
    CheckSame(Inst.CN.Real,n1);
    CheckSame(Inst.CN.Imaginary,n2,1E-9);
    Inst.CN.Add(1,2);
    CheckSame(Inst.CN.Real,n1+1,1E-9);
    n2 := n2+2;
    CheckSame(Inst.CN.Imaginary,n2,1E-9);
  end;
  {$endif}
  Inst.CN.Assign(3.14,1.05946);
  CheckSame(Inst.CN.Real,3.14);
  CheckSame(Inst.CN.Imaginary,1.05946);
  Check(Inst.CU.GetContextSessionID=Inst.ExpectedSessionID);
  Check(Inst.CG.GetContextSessionGroup=Inst.ExpectedGroupID);
................................................................................
  n := Assertions;
  I.Add(1,2); // will launch TInterfaceMock.InternalCheck -> Check(true)
  n := Assertions-n; // tricky code due to Check() inlined Assertions modif.
  Check(n=1,'test should have passed');
  Check(I.Multiply(10,30)=60);
  Check(I.Multiply(2,35)=70);
  for n := 1 to 10000 do
    CheckSame(I.Subtract(n*10.5,n*0.5),n*10,1E-9);
  n := Assertions;
  I := nil; // release TInterfaceMock -> will check all expectations
  n := Assertions-n;
  Check(n=2,'Add count<>3');
  TInterfaceStub.Create(TypeInfo(ISmsSender),SmsSender).
    Returns('Send',[true]);
  U.Name := 'toto';
................................................................................
     {$ifndef NOVARIANTS}
     Executes('Subtract',IntSubtractVariant,'toto').
     {$endif}
     Fails('Add','expected exception').
     Raises('Add',[1,2],ESynException,'expected exception');
  {$ifndef NOVARIANTS}
  for n := 1 to 10000 do
    CheckSame(I.Subtract(n*10.5,n*0.5),n*10,1E-9);
  {$endif}
  Check(I.Subtract(10,20)=3,'Explicit result');
  {$WARN SYMBOL_PLATFORM OFF}
  {$ifndef KYLIX3}
  {$ifndef FPC}
  if DebugHook<>0 then
  {$endif}

Changes to SynopseCommit.inc.

1
'1.18.3587'
|
1
'1.18.3588'