{ This file is part of the Free Pascal run time library. Copyright (c) 2023 by Michael Van Canneyt member of the Free Pascal development team See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit utcvector; {$mode ObjFPC}{$H+} interface uses Classes, SysUtils, fpcunit, testregistry, types, utmathvectorbase, system.math.vectors; Type { TTestVector } TTestVector = class(TCMathVectorsBase) Private FV : Array[1..3] of TVector; procedure ClearVectors; function GetV(AIndex: Integer): TVector; procedure SetV(AIndex: Integer; AValue: TVector); Protected procedure SetUp; override; procedure TearDown; override; Property V1 : TVector Index 1 Read GetV Write SetV; Property V2 : TVector Index 2 Read GetV Write SetV; Property V3 : TVector Index 3 Read GetV Write SetV; Published procedure TestHookUp; Procedure TestZero; Procedure TestCreate; Procedure TestCreateW; Procedure TestAssign; Procedure TestAssignPointf; Procedure TestAssignToPointf; Procedure TestAdd; Procedure TestMultiplyFactor; Procedure TestDivide; Procedure TestEqual; Procedure TestNotEqual; Procedure TestSubtract; Procedure TestLength; Procedure TestNormalize; Procedure TestCrossProduct; Procedure TestDotProduct; Procedure TestToPointF; end; implementation { TTestVector } function TTestVector.GetV(AIndex: Integer): TVector; begin Result:=FV[aIndex]; end; procedure TTestVector.SetV(AIndex: Integer; AValue: TVector); begin FV[aIndex]:=aValue; end; procedure TTestVector.ClearVectors; var I : integer; begin For I:=1 to 3 do begin FV[I].X:=0; FV[I].Y:=0; FV[I].W:=0; end; end; procedure TTestVector.SetUp; begin inherited SetUp; ClearVectors; end; procedure TTestVector.TearDown; begin inherited TearDown; end; procedure TTestVector.TestHookUp; var I : Integer; begin For I:=1 to 3 do begin AssertEquals('Vector '+intTostr(i)+'.X',0.0,FV[I].X); AssertEquals('Vector '+intTostr(i)+'.Y',0.0,FV[I].Y); AssertEquals('Vector '+intTostr(i)+'.W',0.0,FV[I].W); end; end; procedure TTestVector.TestZero; begin V1:=TVector.Zero; AssertEquals('Vector.X',0.0,V1.X); AssertEquals('Vector.Y',0.0,V1.Y); AssertEquals('Vector.W',0.0,V1.W); end; procedure TTestVector.TestCreate; begin V1:=TVector.Create(1,2); AssertEquals('Vector.X',1.0,V1.X); AssertEquals('Vector.Y',2.0,V1.Y); AssertEquals('Vector.W',DefaultVectorWidth,V1.W); end; procedure TTestVector.TestCreateW; begin V1:=TVector.Create(1,2,3); AssertVector('Vector',1,2,3,V1); end; procedure TTestVector.TestAssign; begin V2:=TVector.Create(1,2,3); V1:=V2; AssertVector('Assign',1,2,3,V1); end; procedure TTestVector.TestAssignPointf; var P : TPointF; begin P:=PointF(1,2); V1:=P; AssertVector('Vector',1,2,DefaultVectorWidth,V1); end; procedure TTestVector.TestAssignToPointf; Var P : TPointF; begin V1:=TVector.Create(1,2,3); P:=V1; AssertEquals('Assign 1',PointF(0.3333,0.6666),P); V1:=TVector.Create(1,2,1); P:=V1; AssertEquals('Assign 2',PointF(1,2),P); V1:=TVector.Create(1,2,0); P:=V1; AssertEquals('Assign 3',PointF(1,2),P); end; procedure TTestVector.TestAdd; begin V1:=TVector.Create(1,2,3); V2:=TVector.Create(6,5,4); V3:=V1+V2; AssertVector('Vector',7,7,7,V3); end; procedure TTestVector.TestMultiplyFactor; begin V1:=TVector.Create(1,2,3); V2:=V1*3; AssertVector('Vector 1',3,6,9,V2); V2:=3*V1; AssertVector('Vector 2',3,6,9,V2); end; procedure TTestVector.TestDivide; begin V1:=TVector.Create(1,2,3); V2:=V1/3; AssertVector('Vector 1',0.3333,0.6666,1,V2); end; procedure TTestVector.TestEqual; begin V1:=TVector.Create(1,2,3); V2:=TVector.Create(1,2,3); AssertTrue('Equal 1',V1=V2); V2:=TVector.Create(3,2,1); AssertFalse('Equal 2',V1=V2); V2:=TVector.Create(1+TEpsilon.Vector*0.99,2,3); AssertTrue('Equal within precision',V1=V2); V2:=TVector.Create(1+TEpsilon.Vector*1.1,2,3); AssertFalse('Unequal outside precision',V1=V2); end; procedure TTestVector.TestNotEqual; begin V1:=TVector.Create(1,2,3); V2:=TVector.Create(1,2,3); AssertFalse('Not Equal',V1<>V2); V2:=TVector.Create(3,2,1); AssertTrue('Equal',V1<>V2); V2:=TVector.Create(1+TEpsilon.Vector*0.99,2,3); AssertFalse('Equal within precision',V1<>V2); V2:=TVector.Create(1+TEpsilon.Vector*1.1,2,3); AssertTrue('Unequal outside precision',V1<>V2); end; procedure TTestVector.TestSubtract; begin V1:=TVector.Create(1,2,3); V2:=TVector.Create(6,5,4); V3:=V2-V1; AssertVector('Vector',5,3,1,V3); end; procedure TTestVector.TestLength; begin V1:=TVector.Create(3,4,0); AssertEquals('Length 1',5,V1.Length); V1:=TVector.Create(3,4,1); AssertEquals('Length 1',Sqrt(26),V1.Length,TEpsilon.Vector); end; procedure TTestVector.TestNormalize; begin V1:=TVector.Create(3,4,0); V2:=V1.Normalize; AssertVector('No width',3/5,4/5,0,V2); AssertEquals('Length 1',1,V2.Length,TEpsilon.Vector); V1:=TVector.Create(3,4,1); V2:=V1.Normalize; AssertVector('No width',3/Sqrt(26),4/Sqrt(26),1/Sqrt(26),V2); AssertEquals('Length 1',1,V2.Length,TEpsilon.Vector); end; procedure TTestVector.TestCrossProduct; begin V1:=TVector.Create(1,1,0); V2:=TVector.Create(2,2,0); V3:=V2.CrossProduct(V1); AssertVector('T1',0,0,0,V3); V1:=TVector.Create(1,1,0); V2:=TVector.Create(2,2,0); V3:=V2.CrossProduct(V1); AssertVector('T1',0,0,0,V3); end; procedure TTestVector.TestDotProduct; begin V1:=TVector.Create(3,4,9); V2:=TVector.Create(3,4,9); AssertEquals('Test 1',9+16+81,V1.DotProduct(V2)); V2:=TVector.Create(1,1,0); AssertEquals('Test 1',7,V1.DotProduct(V2)); end; procedure TTestVector.TestToPointF; var P : TPointF; begin V1:=TVector.Create(1,2,3); P:=V1.ToPointF; AssertEquals('ToPointF 1',PointF(0.3333,0.6666),P); V1:=TVector.Create(1,2,1); P:=V1.ToPointF; AssertEquals('ToPointF 2',PointF(1,2),P); end; initialization RegisterTest(TTestVector); end.