1 { 2 ***************************************************************************** 3 * See the file COPYING.modifiedLGPL.txt, included in this distribution, 4 * for details about the license. 5 ***************************************************************************** 6 7 Authors: Alexander Klenin 8 9 } 10 11 unit UtilsTest; 12 13 {$mode objfpc}{$H+} 14 15 interface 16 17 uses 18 Classes, SysUtils, FPCUnit, TestRegistry, TAChartUtils; 19 20 type 21 22 TIntervalListTest = class(TTestCase) 23 strict private 24 FIList: TIntervalList; 25 protected 26 procedure SetUp; override; 27 procedure TearDown; override; 28 published 29 procedure Basic; 30 procedure Intersect; 31 procedure Merge; 32 end; 33 34 TMathTest = class(TTestCase) 35 published 36 procedure CumulNurmDistrTest; 37 procedure TestIsEquivalent; 38 end; 39 40 TGeometryTest = class(TTestCase) 41 strict private 42 procedure AssertEquals(const Expected, Actual: TDoublePoint); overload; 43 procedure AssertEquals(const Expected, Actual: TPoint); overload; 44 procedure AssertEquals(const Expected, Actual: TRect); overload; 45 published 46 procedure TestExpandRect; 47 procedure TestLineIntersectsLine; 48 procedure TestLineIntersectsRect; 49 procedure TestPointInPolygon; 50 procedure TestPointOnLine; 51 procedure TestPointOperations; 52 procedure TestPolygonIntersectsPolygon; 53 end; 54 55 TColorTest = class(TTestCase) 56 strict private 57 procedure AssertEqualsHex(Expected, Actual: Integer); overload; 58 published 59 procedure TestInterpolate; 60 end; 61 62 TRTTITest = class(TTestCase) 63 published 64 procedure TestSetPropDefaults; 65 end; 66 67 TPublishedIntegerSetTest = class(TTestCase) 68 strict private 69 FISet: TPublishedIntegerSet; 70 protected 71 procedure SetUp; override; 72 published 73 procedure TestAsBooleans; 74 procedure TestAsString; 75 procedure TestIsSet; 76 end; 77 78 type 79 THistoryTest = class(TTestCase) 80 published 81 procedure TestHistory; 82 end; 83 84 implementation 85 86 uses 87 Math, TAGeometry, TAMath, AssertHelpers; 88 89 { TIntervalListTest } 90 91 procedure TIntervalListTest.Basic; 92 begin 93 AssertEquals(0, FIList.IntervalCount); 94 FIList.AddRange(1.0, 2.0); 95 AssertEquals(1, FIList.IntervalCount); 96 FIList.AddPoint(3.0); 97 AssertEquals(2, FIList.IntervalCount); 98 AssertEquals(3.0, FIList.Interval[1].FEnd); 99 FIList.Clear; 100 AssertEquals(0, FIList.IntervalCount); 101 end; 102 103 procedure TIntervalListTest.Intersect; 104 var 105 l, r: Double; 106 hint: Integer = 0; 107 begin 108 FIList.Clear; 109 FIList.AddRange(1.0, 2.0); 110 l := 5.0; 111 r := 6.0; 112 AssertFalse(FIList.Intersect(l, r, hint)); 113 l := 1.5; 114 r := 6.0; 115 AssertTrue(FIList.Intersect(l, r, hint)); 116 AssertEquals(2.0, r); 117 FIList.Epsilon := 0.1; 118 l := 0.5; 119 r := 2.5; 120 AssertTrue(FIList.Intersect(l, r, hint)); 121 AssertEquals(0.9, l); 122 AssertEquals(2.1, r); 123 end; 124 125 procedure TIntervalListTest.Merge; 126 begin 127 FIList.Clear; 128 FIList.AddRange(1.0, 2.0); 129 FIList.AddRange(3.0, 4.0); 130 AssertEquals(2, FIList.IntervalCount); 131 FIList.AddRange(1.5, 2.5); 132 AssertEquals(2, FIList.IntervalCount); 133 AssertEquals(2.5, FIList.Interval[0].FEnd); 134 FIList.AddRange(3.5, 3.6); 135 AssertEquals(2, FIList.IntervalCount); 136 FIList.AddRange(2.5, 3.0); 137 AssertEquals(1, FIList.IntervalCount); 138 FIList.AddPoint(4.0); 139 AssertEquals(1, FIList.IntervalCount); 140 FIList.AddPoint(4.1); 141 AssertEquals(2, FIList.IntervalCount); 142 end; 143 144 procedure TIntervalListTest.SetUp; 145 begin 146 inherited SetUp; 147 FIList := TIntervalList.Create; 148 end; 149 150 procedure TIntervalListTest.TearDown; 151 begin 152 inherited TearDown; 153 FreeAndNil(FIList); 154 end; 155 156 { TMathTest } 157 158 procedure TMathTest.CumulNurmDistrTest; 159 const 160 INV_PTS: array [1..3] of Double = (-1.5, 0.33, 2.0); 161 var 162 p: Double; 163 begin 164 AssertEquals(0, CumulNormDistr(0)); 165 AssertEquals(0.84134, CumulNormDistr(1.0)); 166 for p in INV_PTS do 167 AssertEquals(p, InvCumulNormDistr(CumulNormDistr(p))); 168 end; 169 170 procedure TMathTest.TestIsEquivalent; 171 begin 172 AssertTrue(IsEquivalent(1.2345, 1.2345)); 173 AssertTrue(IsEquivalent(SafeNaN, SafeNaN)); 174 AssertTrue(IsEquivalent(1e100, 1e100+1)); 175 AssertFalse(IsEquivalent(1e10, 1e10+1)); 176 AssertFalse(IsEquivalent(5, SafeNaN)); 177 AssertFalse(IsEquivalent(SafeNaN, 5)); 178 end; 179 180 { TGeometryTest } 181 182 procedure TGeometryTest.AssertEquals(const Expected, Actual: TDoublePoint); 183 begin 184 AssertEquals(Expected.X, Actual.X); 185 AssertEquals(Expected.Y, Actual.Y); 186 end; 187 188 procedure TGeometryTest.AssertEquals(const Expected, Actual: TPoint); 189 begin 190 AssertEquals(Expected.X, Actual.X); 191 AssertEquals(Expected.Y, Actual.Y); 192 end; 193 194 procedure TGeometryTest.AssertEquals(const Expected, Actual: TRect); 195 begin 196 AssertEquals(Expected.TopLeft, Actual.TopLeft); 197 AssertEquals(Expected.BottomRight, Actual.BottomRight); 198 end; 199 200 procedure TGeometryTest.TestExpandRect; 201 var 202 r: TRect; 203 begin 204 r := ZeroRect; 205 ExpandRect(r, Point(1, 2)); 206 AssertEquals(Rect(0, 0, 1, 2), r); 207 ExpandRect(r, Point(-5, -6)); 208 AssertEquals(Rect(-5, -6, 1, 2), r); 209 210 r := Rect(100, 100, 0, 0); 211 ExpandRect(r, Point(3, 1)); 212 AssertEquals(Rect(3, 1, 3, 1), r); 213 end; 214 215 procedure TGeometryTest.TestLineIntersectsLine; 216 var 217 p1, p2: TPoint; 218 begin 219 p1 := Point(0, 0); 220 p2 := Point(1, 1); 221 AssertTrue(IsLineIntersectsLine(Point(1, 0), Point(0, 1), p1, p2)); 222 AssertTrue(IsLineIntersectsLine(Point(1, 0), Point(0, 0), p1, p2)); 223 AssertTrue(IsLineIntersectsLine(Point(1, 1), Point(2, 2), p1, p2)); 224 AssertFalse(IsLineIntersectsLine(Point(2, 2), Point(3, 3), p1, p2)); 225 AssertTrue(IsLineIntersectsLine(Point(2, 0), Point(0, 2), p1, p2)); 226 AssertFalse(IsLineIntersectsLine(Point(3, 0), Point(0, 3), p1, p2)); 227 p2 := Point(1, 0); 228 AssertTrue(IsLineIntersectsLine(Point(0, 0), Point(2, 0), p1, p2)); 229 AssertFalse(IsLineIntersectsLine(Point(0, 1), Point(1, 1), p1, p2)); 230 end; 231 232 procedure TGeometryTest.TestLineIntersectsRect; 233 var 234 r: TDoubleRect = (a: (X: 0; Y: 0); b: (X: 20; Y: 10)); 235 236 procedure Check(AP1, AP2, AR1, AR2: TDoublePoint); 237 begin 238 AssertTrue(LineIntersectsRect(AP1, AP2, r)); 239 AssertEquals(AR1, AP1); 240 AssertEquals(AR2, AP2); 241 end; 242 243 var 244 p1, p2: TDoublePoint; 245 begin 246 p1 := DoublePoint(-1, -1); 247 p2 := DoublePoint(0, 20); 248 AssertFalse(LineIntersectsRect(p1, p2, r)); 249 250 p1 := DoublePoint(100, 20); 251 AssertFalse(LineIntersectsRect(p1, p2, r)); 252 253 p1 := DoublePoint(-1, -1); 254 p2 := DoublePoint(1, 1); 255 Check(p1, p2, DoublePoint(0, 0), p2); 256 257 p1 := DoublePoint(0, 0); 258 Check(p1, p2, p1, p2); 259 260 p1 := DoublePoint(20, 20); 261 p2 := DoublePoint(20, -10); 262 Check(p1, p2, DoublePoint(20, 10), DoublePoint(20, 0)); 263 264 p1 := DoublePoint(10, 20); 265 p2 := DoublePoint(15, -10); 266 Check(p1, p2, DoublePoint(11.6667, 10), DoublePoint(13.3333, 0)); 267 268 p1 := DoublePoint(10, 5); 269 p2 := DoublePoint(SafeInfinity, 5); 270 Check(p1, p2, p1, DoublePoint(20, 5)); 271 p2 := DoublePoint(10, NegInfinity); 272 Check(p1, p2, p1, DoublePoint(10, 0)); 273 end; 274 275 procedure TGeometryTest.TestPointInPolygon; 276 var 277 p: TPoint; 278 r: array [1..4] of TPoint = 279 ((X: 0; Y: 0), (X: 10; Y: 0), (X: 10; Y: 5), (X: 0; Y: 5)); 280 begin 281 p := Point(1, 1); 282 AssertFalse(IsPointInPolygon(p, [])); 283 284 AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(3, 0)])); 285 AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(3, 1)])); 286 AssertTrue(IsPointInPolygon(p, [Point(0, 0), Point(0, 2), Point(1, 1)])); 287 AssertFalse(IsPointInPolygon(p, [Point(2, 0), Point(2, 2), Point(3, 1)])); 288 AssertFalse(IsPointInPolygon(p, [Point(2, 0), Point(1, 2), Point(0, 10)])); 289 290 AssertTrue(IsPointInPolygon(Point(5, 5), r)); 291 AssertTrue(IsPointInPolygon(Point(10, 5), r)); 292 AssertFalse(IsPointInPolygon(Point(11, 5), r)); 293 AssertFalse(IsPointInPolygon(Point(0, -1), r)); 294 end; 295 296 procedure TGeometryTest.TestPointOnLine; 297 begin 298 AssertTrue(IsPointOnLine(Point(0, 0), Point(-1, -1), Point(1, 1))); 299 AssertFalse(IsPointOnLine(Point(1, 0), Point(-1, -1), Point(1, 1))); 300 301 AssertTrue(IsPointOnLine(Point(0, 0), Point(0, -1), Point(0, 1))); 302 AssertFalse(IsPointOnLine(Point(-1, 0), Point(0, -1), Point(0, 1))); 303 304 AssertTrue(IsPointOnLine(Point(0, 0), Point(-1, 0), Point(1, 0))); 305 AssertFalse(IsPointOnLine(Point(0, 1), Point(-1, 0), Point(1, 0))); 306 end; 307 308 procedure TGeometryTest.TestPointOperations; 309 begin 310 AssertEquals(Point(1, 0), RotatePoint(Point(1, 0), 0.0)); 311 AssertEquals(Point(0, 1), RotatePoint(Point(1, 0), Pi / 2)); 312 AssertEquals(Point(14, 0), RotatePoint(Point(10, 10), -Pi / 4)); 313 end; 314 315 procedure TGeometryTest.TestPolygonIntersectsPolygon; 316 OffsetPolygonnull317 function OffsetPolygon(AP: array of TPoint; AOffset: TPoint): TPointArray; 318 var 319 i: Integer; 320 begin 321 SetLength(Result, Length(AP)); 322 for i := 0 to High(AP) do 323 Result[i] := AP[i] + AOffset; 324 end; 325 326 var 327 p1: array [1..4] of TPoint = 328 ((X: 0; Y: 0), (X: 10; Y: 0), (X: 10; Y: 5), (X: 0; Y: 5)); 329 begin 330 AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(0, 0)))); 331 AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(1, 1)))); 332 AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(5, 0)))); 333 AssertTrue(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(10, 0)))); 334 AssertFalse(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(11, 0)))); 335 AssertFalse(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(0, -6)))); 336 end; 337 338 { TColorTest } 339 340 procedure TColorTest.AssertEqualsHex(Expected, Actual: Integer); 341 begin 342 AssertTrue( 343 ComparisonMsg(IntToHex(Expected, 8), IntToHex(Actual, 8)), 344 Expected = Actual); 345 end; 346 347 procedure TColorTest.TestInterpolate; 348 begin 349 AssertEqualsHex($01020304, InterpolateRGB($01020304, $00787980, 0.0)); 350 AssertEqualsHex($00787980, InterpolateRGB($01020304, $00787980, 1.0)); 351 AssertEqualsHex($003D3E42, InterpolateRGB($01020304, $00787980, 0.5)); 352 AssertEqualsHex($01010102, InterpolateRGB($01010100, $02020214, 0.1)); 353 end; 354 355 356 type 357 TE = (eA, eB, eC); 358 TESet = set of TE; 359 360 T1 = class(TPersistent) 361 private 362 FP1: Integer; 363 FP2: Boolean; 364 FP3: TESet; 365 procedure SetP2(AValue: Boolean); 366 public 367 constructor Create; 368 published 369 property P1: Integer read FP1 write FP1 default 5; 370 property P2: Boolean read FP2 write SetP2 default true; 371 property P3: TESet read FP3 write FP3 default [eC]; 372 end; 373 374 T2 = class(T1) 375 published 376 property P1 default 6; 377 property P3 default [eA]; 378 end; 379 380 { T1 } 381 382 constructor T1.Create; 383 begin 384 SetPropDefaults(Self, ['P1', 'P2', 'P3']); 385 end; 386 387 procedure T1.SetP2(AValue: Boolean); 388 begin 389 FP2 := AValue; 390 end; 391 392 { TRTTITest } 393 394 procedure TRTTITest.TestSetPropDefaults; 395 var 396 v1: T1; 397 v2: T2; 398 begin 399 v1 := T1.Create; 400 AssertEquals(5, v1.P1); 401 AssertTrue(v1.P2); 402 AssertTrue(v1.P3 = [eC]); 403 v1.Free; 404 v2 := T2.Create; 405 AssertEquals(6, v2.P1); 406 AssertTrue(v2.P2); 407 AssertTrue(v2.P3 = [eA]); 408 v2.Free; 409 end; 410 411 { TPublishedIntegerSetTest } 412 413 procedure TPublishedIntegerSetTest.SetUp; 414 begin 415 inherited SetUp; 416 FISet.Init; 417 end; 418 419 procedure TPublishedIntegerSetTest.TestAsBooleans; 420 421 procedure AssertBooleans(const AExpected: array of Boolean; ACount: Integer); 422 begin 423 AssertEquals(AExpected, FISet.AsBooleans(ACount)); 424 end; 425 426 begin 427 AssertBooleans([], 0); 428 FISet.AllSet := false; 429 FISet.IsSet[2] := true; 430 AssertBooleans([false, false, true], 3); 431 FISet.AllSet := true; 432 AssertBooleans([true, true, true, true], 4); 433 end; 434 435 procedure TPublishedIntegerSetTest.TestAsString; 436 begin 437 AssertTrue(FISet.AllSet); 438 AssertEquals(PUB_INT_SET_ALL, FISet.AsString); 439 FISet.AllSet := false; 440 AssertFalse(FISet.AllSet); 441 AssertEquals(PUB_INT_SET_EMPTY, FISet.AsString); 442 FISet.AsString := '3 ,1,, 2'; 443 AssertEquals('3,1,2', FISet.AsString); 444 FISet.AsString := PUB_INT_SET_ALL; 445 AssertTrue(FISet.AllSet); 446 FISet.AsString := '+'; 447 AssertEquals(PUB_INT_SET_EMPTY, FISet.AsString); 448 FISet.AsString := '3 ;1;; 2'; 449 AssertEquals('3,1,2', FISet.AsString); 450 FISet.AsString := '3|1||2'; 451 AssertEquals('3,1,2', FISet.AsString); 452 end; 453 454 procedure TPublishedIntegerSetTest.TestIsSet; 455 begin 456 AssertTrue(FISet.AllSet); 457 AssertTrue(FISet.IsSet[100000]); 458 FISet.AllSet := false; 459 AssertFalse(FISet.IsSet[100000]); 460 FISet.IsSet[99] := true; 461 AssertEquals('99', FISet.AsString); 462 FISet.AsString := '3,5'; 463 AssertTrue(FISet.IsSet[3]); 464 AssertFalse(FISet.IsSet[99]); 465 FISet.IsSet[3] := false; 466 FISet.IsSet[5] := false; 467 AssertEquals(PUB_INT_SET_EMPTY, FISet.AsString); 468 end; 469 470 // Workaround: FPC 2.6 fails if this type is made local to TestHistory. 471 type 472 TCharHistory = specialize THistory<Char>; 473 474 { THistoryTest } 475 476 procedure THistoryTest.TestHistory; 477 var 478 h: TCharHistory; 479 480 procedure Check(AMessage, AExpected: String); 481 var 482 actual: String = ''; 483 i: Integer; 484 begin 485 for i := 0 to h.Count - 1 do 486 actual += h.Item[i]; 487 AssertEquals(AMessage, AExpected, actual); 488 end; 489 490 begin 491 h := TCharHistory.Create; 492 try 493 AssertEquals('Initial capacity', 0, h.Capacity); 494 Check('Initial state', ''); 495 h.Add('a'); 496 Check('Zero capacity', ''); 497 h.Capacity := 3; 498 h.Add('a'); 499 h.Add('b'); 500 Check('Normal', 'ab'); 501 h.Add('c'); 502 h.Add('d'); 503 Check('Overflow', 'bcd'); 504 h.Capacity := 2; 505 Check('Reduce capacity 1', 'cd'); 506 h.Add('e'); 507 Check('Reduce capacity 2', 'de'); 508 AssertEquals('Item[-1]', 'e', h[-1]); 509 AssertEquals('Pop', 'e', h.Pop); 510 Check('After pop', 'd'); 511 finally 512 FreeAndNil(h); 513 end; 514 end; 515 516 initialization 517 518 RegisterTests([ 519 TIntervalListTest, TMathTest, TGeometryTest, TColorTest, TRTTITest, 520 TPublishedIntegerSetTest, THistoryTest]); 521 522 end. 523 524