Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Comment: | {3588} ensure SameValue() algorithm matches System.Math version |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
5e5b7d9e7c9324ed6f1b024798ae7dde |
User & Date: | ab 2017-04-06 12:40:01 |
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 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'
|