Skip to content

Commit 77e27c2

Browse files
delphidabblerdelphidabbler
committed
Add more unit tests for structs category snippets
Added tests to TestUStructCatSnippets unit for all snippets in the Structures category except for TIntegerRange, which was the only snippet in the category to have tests. Advanced records had dedicated unit test classes. The remaining simple record types and functions had tests grouped together in a single new unit test class.
1 parent 5acf299 commit 77e27c2

File tree

1 file changed

+349
-0
lines changed

1 file changed

+349
-0
lines changed

‎tests/Cat-Structs/TestUStructCatSnippets.pas‎

Lines changed: 349 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,42 @@ interface
77

88
implementation
99

10+
uses
11+
Types;
12+
1013
type
14+
15+
TestMiscStructsCatSnippets = class(TTestCase)
16+
published
17+
procedure TestType_TPointF;
18+
procedure TestType_TRange;
19+
procedure TestType_TRectF; // requires TPointF
20+
procedure TestFunction_PointF; // requires TPointF
21+
procedure TestFunction_Range; // requires TRange
22+
procedure TestFunction_RectF; // requires TPointF & TRectF
23+
procedure TestFunction_Size;
24+
procedure TestFunction_BoundsF; // requires TRectF & RectF
25+
end;
26+
27+
TestTSizeEx = class(TTestCase)
28+
published
29+
// Order of tests is important Ctor then implicit ops then equality ops and
30+
// IsZero method
31+
procedure TestCtorAndFields;
32+
procedure TestImplicitOp_TSizeToTSizeEx;
33+
procedure TestImplicitOp_TSizeExToTSize;
34+
procedure TestEqualOp;
35+
procedure TestNotEqualOp;
36+
procedure TestIsZero;
37+
end;
38+
39+
TestTRangeEx = class(TTestCase)
40+
published
41+
procedure TestCtorAndFields;
42+
procedure TestContains;
43+
procedure TestConstrain;
44+
end;
45+
1146
TestTIntegerRange = class(TTestCase)
1247
private
1348
procedure TestCtorAndPropsException;
@@ -35,6 +70,316 @@ TestTIntegerRange = class(TTestCase)
3570
procedure TestIsContinuousWith;
3671
end;
3772

73+
{ TestMiscStructsCatSnippets }
74+
75+
procedure TestMiscStructsCatSnippets.TestFunction_BoundsF;
76+
var
77+
R, Expected: TRectF;
78+
const
79+
Delta = 0.00000001;
80+
begin
81+
R := BoundsF(10.3, 20.4, 10.5, 20.6);
82+
Expected := RectF(10.3, 20.4, 10.3+10.5, 20.4+20.6);
83+
CheckEquals(Expected.Left, R.Left, Delta, 'left');
84+
CheckEquals(Expected.Top, R.Top, Delta, 'top');
85+
CheckEquals(Expected.Right, R.Right, Delta, 'right');
86+
CheckEquals(Expected.Bottom, R.Bottom, Delta, 'bottom');
87+
end;
88+
89+
procedure TestMiscStructsCatSnippets.TestFunction_PointF;
90+
var
91+
P: TPointF;
92+
const
93+
Delta = 0.00000001;
94+
begin
95+
P := PointF(0.0, 0.0);
96+
CheckEquals(0.0, P.X, Delta, '#1X');
97+
CheckEquals(0.0, P.Y, Delta, '#1Y');
98+
P := PointF(42.56, -12.345);
99+
CheckEquals(42.56, P.X, Delta, '#2X');
100+
CheckEquals(-12.345, P.Y, Delta, '#2Y');
101+
end;
102+
103+
procedure TestMiscStructsCatSnippets.TestFunction_Range;
104+
var
105+
R: TRange;
106+
begin
107+
// Range function orders parameters
108+
R := Range(42, 56);
109+
CheckEquals(42, R.Lower, '#1 lower');
110+
CheckEquals(56, R.Upper, '#1 upper');
111+
R := Range(56, 42);
112+
CheckEquals(42, R.Lower, '#2 lower');
113+
CheckEquals(56, R.Upper, '#2 upper');
114+
end;
115+
116+
procedure TestMiscStructsCatSnippets.TestFunction_RectF;
117+
var
118+
R: TRectF;
119+
const
120+
Delta = 0.00000001;
121+
begin
122+
R := RectF(0.0, -10.8, 34.56, 20.3);
123+
CheckEquals(0.0, R.Left, Delta, 'left');
124+
CheckEquals(-10.8, R.Top, Delta, 'top');
125+
CheckEquals(34.56, R.Right, Delta, 'right');
126+
CheckEquals(20.3, R.Bottom, Delta, 'bottom');
127+
CheckEquals(0.0, R.TopLeft.X, Delta, 'topleft.x');
128+
CheckEquals(-10.8, R.TopLeft.Y, Delta, 'topleft.y');
129+
CheckEquals(34.56, R.BottomRight.X, Delta, 'bottomright.x');
130+
CheckEquals(20.3, R.BottomRight.Y, Delta, 'bottomright.y');
131+
end;
132+
133+
procedure TestMiscStructsCatSnippets.TestFunction_Size;
134+
var
135+
S: TSize;
136+
begin
137+
S.cx := 42;
138+
S.cy := 56;
139+
CheckEquals(42, S.cx, 'cx');
140+
CheckEquals(56, S.cy, 'cy');
141+
end;
142+
143+
procedure TestMiscStructsCatSnippets.TestType_TPointF;
144+
var
145+
P: TPointF;
146+
const
147+
Delta = 0.00000001;
148+
begin
149+
P.X := 0.0;
150+
P.Y := 0.0;
151+
CheckEquals(0.0, P.X, Delta, '#1X');
152+
CheckEquals(0.0, P.Y, Delta, '#1Y');
153+
P.X := 42.56;
154+
P.Y := -12.345;
155+
CheckEquals(42.56, P.X, Delta, '#2X');
156+
CheckEquals(-12.345, P.Y, Delta, '#2Y');
157+
end;
158+
159+
procedure TestMiscStructsCatSnippets.TestType_TRange;
160+
var
161+
R: TRange;
162+
begin
163+
// Test direct field setting
164+
R.Lower := 42;
165+
R.Upper := 56;
166+
CheckEquals(42, R.Lower, '#1 lower');
167+
CheckEquals(56, R.Upper, '#1 upper');
168+
R.Lower := 56;
169+
R.Upper := 42;
170+
CheckEquals(56, R.Lower, '#2 lower');
171+
CheckEquals(42, R.Upper, '#2 upper');
172+
end;
173+
174+
procedure TestMiscStructsCatSnippets.TestType_TRectF;
175+
var
176+
R: TRectF;
177+
TL, BR: TPointF;
178+
const
179+
Delta = 0.00000001;
180+
begin
181+
// Set Left, Right, Top & Bottom fields
182+
R.Left := 2.2;
183+
R.Right := 6.6;
184+
R.Top := 8.8;
185+
R.Bottom := 16.16;
186+
TL.X := 2.2;
187+
TL.Y := 8.8;
188+
BR.X := 6.6;
189+
BR.Y := 16.16;
190+
CheckEquals(2.2, R.Left, Delta, '#1 left');
191+
CheckEquals(6.6, R.Right, Delta, '#1 right');
192+
CheckEquals(8.8, R.Top, Delta, '#1 top');
193+
CheckEquals(16.16, R.Bottom, Delta, '#1 bottom');
194+
CheckEquals(2.2, R.TopLeft.X, Delta, '#1 topleft.x');
195+
CheckEquals(8.8, R.TopLeft.Y, Delta, '#1 topleft.y');
196+
CheckEquals(6.6, R.BottomRight.X, Delta, '#1 bottomright.x');
197+
CheckEquals(16.16, R.BottomRight.Y, Delta, '#1 bottomright.y');
198+
// Set TopLeft & BottomRight TPointF properties
199+
TL.X := 10.11;
200+
TL.Y := 12.13;
201+
BR.X := 11.12;
202+
BR.Y := 13.14;
203+
R.TopLeft := TL;
204+
R.BottomRight := BR;
205+
CheckEquals(10.11, R.Left, Delta, '#2 left');
206+
CheckEquals(12.13, R.Top, Delta, '#2 top');
207+
CheckEquals(11.12, R.Right, Delta, '#2 right');
208+
CheckEquals(13.14, R.Bottom, Delta, '#2 bottom');
209+
end;
210+
211+
{ TestTSizeEx }
212+
213+
procedure TestTSizeEx.TestCtorAndFields;
214+
var
215+
S: TSizeEx;
216+
begin
217+
// Test direct field access
218+
S.CX := 42;
219+
S.CY := -56;
220+
CheckEquals(42, S.CX, '#1a');
221+
CheckEquals(-56, S.CY, '#1b');
222+
// Text Ctor
223+
S := TSizeEx.Create(42, -56);
224+
CheckEquals(42, S.CX, '#2a');
225+
CheckEquals(-56, S.CY, '#2b');
226+
end;
227+
228+
procedure TestTSizeEx.TestEqualOp;
229+
var
230+
Sx0, Sx1a, Sx1b, Sx2: TSizeEx;
231+
S0, S1, S2: TSize;
232+
begin
233+
// Test with both operands TSizeEx
234+
Sx0 := TSizeEx.Create(0, 0);
235+
Sx1a := TSizeEx.Create(42, 56);
236+
Sx1b := TSizeEx.Create(42, 56);
237+
Sx2 := TSizeEx.Create(99, 99);
238+
CheckTrue(Sx1a = Sx1b, '#1a');
239+
CheckFalse(Sx0 = Sx2, '#1b');
240+
CheckFalse(Sx1a = Sx2, '#1c');
241+
// Test with one TSizeEx and one TSize operanc
242+
S0 := Sx0;
243+
S1 := Sx1a;
244+
S2 := Sx2;
245+
CheckTrue(Sx1a = S1, '#2a');
246+
CheckFalse(S0 = Sx2, '#2b');
247+
CheckTrue(S2 = Sx2, '#2c');
248+
end;
249+
250+
procedure TestTSizeEx.TestImplicitOp_TSizeExToTSize;
251+
var
252+
Src: TSizeEx;
253+
Dest: TSize;
254+
begin
255+
Src := TSizeEx.Create(23, -99);
256+
Dest := Src;
257+
CheckEquals(23, Dest.cx, 'cx');
258+
CheckEquals(-99, Dest.cy, 'cy');
259+
end;
260+
261+
procedure TestTSizeEx.TestImplicitOp_TSizeToTSizeEx;
262+
var
263+
Src: TSize;
264+
Dest: TSizeEx;
265+
begin
266+
Src := TSizeEx.Create(23, 423);
267+
Dest := Src;
268+
CheckEquals(23, Dest.CX, 'CX');
269+
CheckEquals(423, Dest.CY, 'CY');
270+
end;
271+
272+
procedure TestTSizeEx.TestIsZero;
273+
var
274+
S: TSizeEx;
275+
begin
276+
S := TSizeEx.Create(12, 23);
277+
CheckFalse(S.IsZero, '#1');
278+
S := TSizeEx.Create(0, 0);
279+
CheckTrue(S.IsZero, '#2');
280+
S := TSizeEx.Create(0, 1);
281+
CheckTrue(S.IsZero, '#3');
282+
S := TSizeEx.Create(-1, 0);
283+
CheckTrue(S.IsZero, '#4');
284+
end;
285+
286+
procedure TestTSizeEx.TestNotEqualOp;
287+
var
288+
Sx0, Sx1a, Sx1b, Sx2: TSizeEx;
289+
S0, S1, S2: TSize;
290+
begin
291+
// Test with both operands TSizeEx
292+
Sx0 := TSizeEx.Create(0, 0);
293+
Sx1a := TSizeEx.Create(42, 56);
294+
Sx1b := TSizeEx.Create(42, 56);
295+
Sx2 := TSizeEx.Create(99, 99);
296+
CheckFalse(Sx1a <> Sx1b, '#1a');
297+
CheckTrue(Sx0 <> Sx2, '#1b');
298+
CheckTrue(Sx1a <> Sx2, '#1c');
299+
// Test with one TSizeEx and one TSize operanc
300+
S0 := Sx0;
301+
S1 := Sx1a;
302+
S2 := Sx2;
303+
CheckFalse(Sx1a <> S1, '#2a');
304+
CheckTrue(S0 <> Sx2, '#2b');
305+
CheckFalse(S2 <> Sx2, '#2c');
306+
end;
307+
308+
{ TestTRangeEx }
309+
310+
procedure TestTRangeEx.TestConstrain;
311+
var
312+
R: TRangeEx;
313+
begin
314+
// Min < Max => expected results
315+
R := TRangeEx.Create(-42, 56);
316+
CheckEquals(2, R.Constrain(2), '#1a');
317+
CheckEquals(-42, R.Constrain(-42), '#1b');
318+
CheckEquals(56, R.Constrain(56), '#1c');
319+
CheckEquals(-42, R.Constrain(-99), '#1d');
320+
CheckEquals(56, R.Constrain(99), '#1e');
321+
// Min > Max => bonkers results !!!
322+
R := TRangeEx.Create(56, 42);
323+
CheckEquals(56, R.Constrain(2), '#2a'); // !!! should be 42
324+
CheckEquals(56, R.Constrain(42), '#2b'); // !!! should be 42
325+
CheckEquals(42, R.Constrain(56), '#2c'); // !!! should be 56
326+
CheckEquals(56, R.Constrain(48), '#2d'); // !!! should be 48
327+
CheckEquals(56, R.Constrain(40), '#2e'); // !!! should be 42
328+
CheckEquals(42, R.Constrain(99), '#2f'); // !!! should be 56
329+
// Min = Max => expected results
330+
R := TRangeEx.Create(3, 3);
331+
CheckEquals(3, R.Constrain(2), '#1a');
332+
CheckEquals(3, R.Constrain(3), '#1b');
333+
CheckEquals(3, R.Constrain(4), '#1c');
334+
end;
335+
336+
procedure TestTRangeEx.TestContains;
337+
var
338+
R: TRangeEx;
339+
begin
340+
// Min < Max => expected results
341+
R := TRangeEx.Create(-42, 56);
342+
CheckTrue(R.Contains(2), '#1a');
343+
CheckTrue(R.Contains(-42), '#1b');
344+
CheckTrue(R.Contains(56), '#1c');
345+
CheckFalse(R.Contains(-99), '#1d');
346+
CheckFalse(R.Contains(57), '#1e');
347+
// Max > Min => bonkers results !!!
348+
R := TRangeEx.Create(56, 42);
349+
CheckFalse(R.Contains(48), '#2a'); // !!! Should be True
350+
CheckFalse(R.Contains(2), '#2b');
351+
CheckFalse(R.Contains(99), '#2c');
352+
CheckFalse(R.Contains(42), '#2b'); // !!! Should be True
353+
CheckFalse(R.Contains(56), '#2b'); // !!! Should be True
354+
// Min = Max => expected results
355+
R := TRangeEx.Create(3, 3);
356+
CheckFalse(R.Contains(2), '#3a');
357+
CheckFalse(R.Contains(4), '#3b');
358+
CheckTrue(R.Contains(3), '#3c');
359+
end;
360+
361+
procedure TestTRangeEx.TestCtorAndFields;
362+
var
363+
R: TRangeEx;
364+
begin
365+
// Direct field access: no ordering of range
366+
R.Min := 42;
367+
R.Max := 56;
368+
CheckEquals(42, R.Min, '#1 min');
369+
CheckEquals(56, R.Max, '#1 max');
370+
R.Min := 56;
371+
R.Max := 42;
372+
CheckEquals(56, R.Min, '#2 min');
373+
CheckEquals(42, R.Max, '#2 max');
374+
// Ctor: also no ordering of range
375+
R := TRangeEx.Create(42, 56);
376+
CheckEquals(42, R.Min, '#3 min');
377+
CheckEquals(56, R.Max, '#3 max');
378+
R := TRangeEx.Create(56, 42);
379+
CheckEquals(56, R.Min, '#3 min');
380+
CheckEquals(42, R.Max, '#3 max');
381+
end;
382+
38383
{ TestTIntegerRange }
39384

40385
procedure TestTIntegerRange.SetUp;
@@ -650,7 +995,11 @@ procedure TestTIntegerRange.TestOverlapsWith;
650995
end;
651996

652997
initialization
998+
653999
// Register any test cases with the test runner
6541000
RegisterTest(TestTIntegerRange.Suite);
1001+
RegisterTest(TestTRangeEx.Suite);
1002+
RegisterTest(TestTSizeEx.Suite);
1003+
RegisterTest(TestMiscStructsCatSnippets.Suite);
6551004

6561005
end.

0 commit comments

Comments
 (0)