diff --git a/collection/706.dat b/collection/706.dat new file mode 100644 index 0000000..d5b92f7 --- /dev/null +++ b/collection/706.dat @@ -0,0 +1,261 @@ +type + TIntegerRange = record + strict private + var + fLowerBound: Integer; + fUpperBound: Integer; + function GetLowerBound: Integer; + function GetUpperBound: Integer; + function IsSubrangeOf(const ARange: TIntegerRange): Boolean; + public + // Constructs a range whose bounds are A and B. The lowest of the two + // parameters is taken as the lower bound of the range with the other + // parameter taken as the upper bound. + // Valid bounds must fall in the range -MaxInt..MaxInt. An + // EArgumentException exception is raised otherwise. + constructor Create(const A, B: Integer); + + // Constructs an empty range. + class function CreateEmpty: TIntegerRange; static; + + // Checks if the range is empty. + function IsEmpty: Boolean; + + // Returns the length of the range, i.e. the number of integers in the range. + function Length: Cardinal; + + // Constrains AValue to fall within this range. If the value lies within the + // range it is returned unchanged. If it is outside the range then either + // LowerBound or UpperBound is returned, depending on whether the value + // falls below or above the range, respectively. + // An EInvalidOpException exception is raised if the range is empty. + function Constrain(const AValue: Integer): Integer; + + // Checks if this range overlaps with ARange, i.e. the interection of the + // ranges is non empty. Empty ranges cannot overlap with any range. + function OverlapsWith(const ARange: TIntegerRange): Boolean; + + // Checks if this range is immediately adjacent to ARange, with no overlap. + // Empty ranges are never contiguous with other ranges or themselves. + function IsContiguousWith(const ARange: TIntegerRange): Boolean; + + // Checks if the set of all values in this range and ARange form a + // continuous sequence. This implies that a range is continuous with itself. + // Since adding an empty range to a non-empty range doesn't change the + // non-empty range we define empty ranges to be continuous with any range. + function IsContinuousWith(const ARange: TIntegerRange): Boolean; + + // Checks if ranges A and B are the same + class operator Equal(const A, B: TIntegerRange): Boolean; + + // Checks if ranges A and B are not the same + class operator NotEqual(const A, B: TIntegerRange): Boolean; + + // Checks if range A is contained in, or is the same as, range B. + // An empty range is deemed to be contained in any other range. + class operator LessThanOrEqual(const A, B: TIntegerRange): Boolean; + + // Checks if range A is contains, or is the same as, range B. + // A non-empty range is never contained in an empty range. + class operator GreaterThanOrEqual(const A, B: TIntegerRange): Boolean; + + // Combine two ranges, A and B. The result is the smallest range that + // contains both A and B. + // If A and B are not continuous the resulting range will contain values + // that were not in either A or B. + // Combining any range either with itself or with an empty range is a no-op. + class operator Add(const A, B: TIntegerRange): TIntegerRange; + + // Returns a range that is the intersection of ranges A and B. + // Returns an empty range if A and B do not overlap. + class operator Multiply(const A, B: TIntegerRange): TIntegerRange; + + // Checks if integer AValue is contained within range ARange. + class operator In(const AValue: Integer; const ARange: TIntegerRange): + Boolean; + + // Implicitly casts ARange to a string. If ARange is non-empty the string + // has format [X..Y], where X and Y are the lower and upper bounds of + // ARange respectively. If ARange is empty then [] is returned. + // This means that ARange can be assigned directly to a string. + class operator Implicit(const ARange: TIntegerRange): string; + + // Explicitly casts ARange to a string. If ARange is non-empty the string + // has format [X..Y], where X and Y are the lower and upper bounds of + // ARange respectively. If ARange is empty then [] is returned. + // This means that ARange can be explicitly cast to a string using + // string(ARange). + class operator Explicit(const ARange: TIntegerRange): string; + + // The lower bound of a non-empty range. + // EInvalidOpException is raised if the property is read when the range is + // empty. + property LowerBound: Integer read GetLowerBound; + + // The upper bound of a non-empty range. + // EInvalidOpException is raised if the property is read when the range is + // empty. + property UpperBound: Integer read GetUpperBound; + end; + +class operator TIntegerRange.Add(const A, B: TIntegerRange): TIntegerRange; +begin + if A.IsEmpty then + Exit(B); + if B.IsEmpty then + Exit(A); + Result := TIntegerRange.Create( + Math.Min(A.fLowerBound, B.fLowerBound), + Math.Max(A.fUpperBound, B.fUpperBound) + ); +end; + +function TIntegerRange.Constrain(const AValue: Integer): Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.Constrain not valid for an empty range.' + ); + Result := Math.EnsureRange(AValue, fLowerBound, fUpperBound); +end; + +constructor TIntegerRange.Create(const A, B: Integer); +begin + // Normalise range so that smallest parameter is the lower bound + fLowerBound := Math.Min(A, B); + fUpperBound := Math.Max(A, B); + if fLowerBound = Low(Integer) then + // This restriction is required to prevent the Length method's Cardinal + // return value from wrapping around / overflowing + raise SysUtils.EArgumentException.CreateFmt( + 'TIntegerRange.Create: Arguments must be greater than %d', [Low(Integer)] + ); +end; + +class function TIntegerRange.CreateEmpty: TIntegerRange; +begin + Result.fLowerBound := High(Integer); + Result.fUpperBound := Low(Integer); +end; + +class operator TIntegerRange.Equal(const A, B: TIntegerRange): Boolean; +begin + if A.IsEmpty or B.IsEmpty then + Exit(A.IsEmpty and B.IsEmpty); + Result := (A.fLowerBound = B.fLowerBound) and (A.fUpperBound = B.fUpperBound); +end; + +class operator TIntegerRange.Explicit(const ARange: TIntegerRange): string; +begin + if ARange.IsEmpty then + Exit('[]'); + Result := SysUtils.Format( + '[%d..%d]', [ARange.fLowerBound, ARange.fUpperBound] + ); +end; + +function TIntegerRange.GetLowerBound: Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.LowerBound not valid for an empty range.' + ); + Result := fLowerBound; +end; + +function TIntegerRange.GetUpperBound: Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.LowerBound not valid for an empty range.' + ); + Result := fUpperBound; +end; + +class operator TIntegerRange.GreaterThanOrEqual(const A, B: TIntegerRange): + Boolean; +begin + Result := B.IsSubrangeOf(A); +end; + +class operator TIntegerRange.Implicit(const ARange: TIntegerRange): string; +begin + Result := string(ARange); // calls Explicit cast operator +end; + +class operator TIntegerRange.In(const AValue: Integer; + const ARange: TIntegerRange): Boolean; +begin + if ARange.IsEmpty then + Exit(False); + Result := (AValue >= ARange.fLowerBound) and (AValue <= ARange.fUpperBound); +end; + +function TIntegerRange.IsContiguousWith(const ARange: TIntegerRange): Boolean; +begin + if Self.IsEmpty or ARange.IsEmpty then + Exit(False); + Result := (Self + ARange).Length = (Self.Length + ARange.Length); +end; + +function TIntegerRange.IsContinuousWith(const ARange: TIntegerRange): Boolean; +begin + if Self.IsEmpty or ARange.IsEmpty then + // Empty ranges are only continuous with other empty ranges + Exit(True); + Result := IsContiguousWith(ARange) or OverlapsWith(ARange); +end; + +function TIntegerRange.IsEmpty: Boolean; +begin + Result := fLowerBound > fUpperBound; +end; + +function TIntegerRange.IsSubrangeOf(const ARange: TIntegerRange): Boolean; +begin + if ARange.IsEmpty then + Exit(Self.IsEmpty); + Result := (Self.fLowerBound >= ARange.fLowerBound) + and (Self.fUpperBound <= ARange.fUpperBound) + or Self.IsEmpty +end; + +function TIntegerRange.Length: Cardinal; +begin + if IsEmpty then + Exit(0); + Result := fUpperBound - fLowerBound + 1 +end; + +class operator TIntegerRange.LessThanOrEqual(const A, B: TIntegerRange): + Boolean; +begin + Result := A.IsSubrangeOf(B); +end; + +class operator TIntegerRange.Multiply(const A, B: TIntegerRange): TIntegerRange; +var + Up, Lo: Integer; +begin + if A.IsEmpty or B.IsEmpty then + Exit(TIntegerRange.CreateEmpty); + Lo := Math.Max(A.fLowerBound, B.fLowerBound); + Up := Math.Min(A.fUpperBound, B.fUpperBound); + if Lo <= Up then + Result := TIntegerRange.Create(Lo, Up) + else + Result := TIntegerRange.CreateEmpty; +end; + +class operator TIntegerRange.NotEqual(const A, B: TIntegerRange): Boolean; +begin + if A.IsEmpty or B.IsEmpty then + Exit(A.IsEmpty <> B.IsEmpty); + Result := (A.fLowerBound <> B.fLowerBound) + or (A.fUpperBound <> B.fUpperBound); +end; + +function TIntegerRange.OverlapsWith(const ARange: TIntegerRange): Boolean; +begin + Result := not (Self * ARange).IsEmpty; +end; \ No newline at end of file diff --git a/collection/707.dat b/collection/707.dat new file mode 100644 index 0000000..5bf0e60 --- /dev/null +++ b/collection/707.dat @@ -0,0 +1,8 @@ +function RandomString(const SL: Classes.TStrings): string; overload; +begin + if SL.Count = 0 then + raise SysUtils.EArgumentException.Create( + 'RandomString called with empty string list' + ); + Result := SL[Random(SL.Count)]; +end; \ No newline at end of file diff --git a/collection/arrays.ini b/collection/arrays.ini index 19ac33c..11ffc5a 100644 --- a/collection/arrays.ini +++ b/collection/arrays.ini @@ -9,6 +9,9 @@ DescEx="

Copies the elements of string array Strings to string list SL, replacing any existing contents of SL.

" SeeAlso=StringListToArray Units=Classes +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=533.dat Delphi2=N Delphi3=N @@ -32,6 +35,9 @@ FPC=Y [ByteArraysEqual] DescEx="

Checks if two byte arrays are equal.

The arrays are equal if they have the same number of elements and elements at the same position in the array are equal.

" SeeAlso=ByteArraysSameStart +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=365.dat Delphi2=N Delphi3=N @@ -55,6 +61,9 @@ FPC=Y [ByteArraysSameStart] DescEx="

Checks if two byte arrays B1 and B2 are equal for the first Count elements.

False is returned if any array has less than Count elements.

Count must be >= 1.

" SeeAlso=ByteArraysEqual +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=481.dat Delphi2=N Delphi3=N @@ -78,6 +87,9 @@ FPC=Y [IndexOfByte] DescEx="

Returns the index of the first occurrence of byte B in byte array A, or -1 if B is not in A.

" SeeAlso=LastIndexOfByte +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=482.dat Delphi2=N Delphi3=N @@ -101,6 +113,9 @@ FPC=Y [LastIndexOfByte] DescEx="

Returns the index of the last occurrence of byte B in byte array A, or -1 if B is not in A.

" SeeAlso=IndexOfByte +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=483.dat Delphi2=N Delphi3=N @@ -125,6 +140,9 @@ FPC=Y DescEx="

Creates and returns a dynamic string array containing all the strings from the given string list.

" SeeAlso=ArrayToStringList Units=Classes,Types +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=347.dat Delphi2=N Delphi3=N @@ -149,6 +167,9 @@ FPC=Y DescEx="

Appends array of bytes B2 to the end of byte array B1.

" Depends=TBytes SeeAlso=ConcatByteArrays +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=364.dat Delphi2=N Delphi3=N @@ -173,6 +194,9 @@ FPC=Y DescEx="

Deletes a sequence of bytes from byte array B starting at index Start with length Len.

If either Start or Len are less than 0 they are taken as zero. If Start is beyond the end of the array or if Len is 0 then the whole array is returned unchanged. If the sequence of bytes to be chopped extends beyond the end of the array it is truncated from Start.

" Depends=TBytes,ConcatByteArrays,SliceByteArray SeeAlso=SliceByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=366.dat Delphi2=N Delphi3=N @@ -198,6 +222,9 @@ DescEx="

Makes a copy of an array of bytes.

" Extra="

Useful for creating a TBytes array from a constant array or for cloning an existing byte array.

" Depends=TBytes SeeAlso=AppendByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=367.dat Delphi2=N Delphi3=N @@ -222,6 +249,9 @@ FPC=Y DescEx="

Concatenates two byte arrays B1 and B2 and returns the resulting array.

The result is the contents of B1 followed by the contents of B2.

" Depends=TBytes,AppendByteArray,CloneByteArray SeeAlso=AppendByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=368.dat Delphi2=N Delphi3=N @@ -246,6 +276,9 @@ FPC=Y DescEx="

Removes the last element of byte array A and returns the element. The length of A shrinks by one.

A must not be empty.

" Depends=TBytes SeeAlso=PushByteArray,ShiftByteArray,UnShiftByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=484.dat Delphi2=N Delphi3=N @@ -270,6 +303,9 @@ FPC=Y DescEx="

Pushes byte B onto the end of byte array A. The length of A grows by one.

" Depends=TBytes SeeAlso=PopByteArray,ShiftByteArray,UnShiftByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=485.dat Delphi2=N Delphi3=N @@ -294,6 +330,9 @@ FPC=Y DescEx="

Removes the first element of byte array A and returns the element. The length of A shrinks by one.

A must not be empty.

" Depends=TBytes SeeAlso=PopByteArray,PushByteArray,UnShiftByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=486.dat Delphi2=N Delphi3=N @@ -318,6 +357,9 @@ FPC=Y DescEx="

Slices a range of bytes from byte array B, starting at index Start with length Len, and returns the result.

If either Start or Len are less than 0, they are taken as 0. If Start is beyond the end of the array or if Len is 0 then an empty array is returned. If the sequence of bytes to be sliced extends beyond the end of the array it is truncated from Start.

" Depends=TBytes SeeAlso=ChopByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=369.dat Delphi2=N Delphi3=N @@ -342,6 +384,9 @@ FPC=Y DescEx="

Inserts byte B at the beginning of byte array A. The length of A grows by one.

" Depends=TBytes SeeAlso=PopByteArray,PushByteArray,ShiftByteArray +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Arrays" Snip=487.dat Delphi2=N Delphi3=N diff --git a/collection/string.ini b/collection/string.ini index a7ee191..6d65508 100644 --- a/collection/string.ini +++ b/collection/string.ini @@ -1807,3 +1807,14 @@ DelphiXE4=Y Delphi10S=Y Delphi12A=Y FPC=Y + +[RandomString] +DescEx="

Returns a random string from the given non-empty string list.

An EArgumentException exception is raised if the string list is empty.

" +Extra="

The Delphi RTL has a similar RandomFrom function in StrUtils that returns a random string from a string array.

" +Units=SysUtils,Classes +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-String" +Snip=707.dat +DelphiXE=Y +Delphi12A=Y diff --git a/collection/structs.ini b/collection/structs.ini index f338d9d..3091f08 100644 --- a/collection/structs.ini +++ b/collection/structs.ini @@ -9,6 +9,9 @@ DescEx="

Constructs and returns a TRectF record with the given top-left coordinate, width and height.

" SeeAlso=RectF,TRectF Depends=TRectF +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=493.dat Delphi2=Y Delphi3=Y @@ -31,6 +34,9 @@ FPC=Y [PointF] DescEx="

Constructs and returns a TPointF record with the given x & y coordinates.

" +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" SeeAlso=TPointF,RectF Depends=TPointF Snip=491.dat @@ -54,10 +60,13 @@ Delphi12A=Y FPC=Y [Range] -DescEx="

Constructs and returns a TRange record with bounds A and B.

The smaller of A and B is used as the lower bound and the larger as the upper bound. If both values are equal then the range will be empty.

" +DescEx="

Constructs and returns a TRange record with bounds A and B.

The smaller of A and B is used as the lower bound and the other parameter is used as the upper bound.

" Depends=TRange SeeAlso=TRange -SeeAlso=TRange,TRangeEx +SeeAlso=TRange,TRangeEx,TIntegerRange +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=580.dat Delphi7=Y Delphi2005Win32=Y @@ -77,6 +86,9 @@ FPC=Y DescEx="

Constructs and returns a TRectF record with the given left, top, right & bottom coordinates.

" SeeAlso=BoundsF,PointF,TRectF Depends=TRectF +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=492.dat Delphi2=Y Delphi3=Y @@ -102,6 +114,9 @@ DescEx="

Constructs and returns a TSize record with the given dimen Extra="

This routine complements the Rect and Point routines defined in the Delphi RTL.

For versions of Delphi before Delphi 6 replace the Types unit with Windows to get the routine to compile.

" Units=Types SeeAlso=TSizeEx +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=488.dat Delphi2=N Delphi3=N @@ -122,10 +137,27 @@ Delphi10S=Y Delphi12A=Y FPC=Y +[TIntegerRange] +DisplayName=TIntegerRange +DescEx="

An advanced record that encapsulates an integer range along with operations on it.

The range is immutable, so the constructor must be used to instantiate a non-empty range.

" +Extra="

TIntegerRange supports various operator overloads, which operate in a way similar to the Pascal set operators:

= compares two ranges for equality.

<> compares two ranges for inequality.

<= checks if the left operand is wholly contained in, or is equal to the right operand (c.f. Pascal subset operator).

>= checks if the left operand wholly contains, or is equal to, the right hand operand (c.f. Pascal proper superset operator).

+ creates the union of the two ranges specified by the operands, i.e. a new range that is the smallest range that contains both operands. For example, representing a range as [A..B], [1..3] + [7..10] = [1..10] (c.f. Pascal union operator).

* creates a new range that the largest range contained in both ranges specified by the operands, or an empty range if the operands do not overlap. For example, [1..3] * [2..7] = [2..3] while [1..3] * [6..9] is an empty range. (c.f. Pascal intersection operator).

in checks if the integer specified in the left hand operand is contained in the range specified by the right hand operand (c.f. Pascal membership operator).

" +Kind=class +Units=SysUtils,Math +SeeAlso=TRange,TRangeEx +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" +Snip=706.dat +DelphiXE=Y +Delphi12A=Y + [TPointF] Kind=type DescEx="

Encapsulates a point with double precision floating point coordinates.

" SeeAlso=PointF,TRectF +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=489.dat Delphi2=Y Delphi3=Y @@ -150,7 +182,10 @@ FPC=Y Kind=type DescEx="

Encapsulates the upper and lower bounds of a range of values.

" SeeAlso=Range -SeeAlso=Range,TRangeEx +SeeAlso=Range,TRangeEx,TIntegerRange +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=579.dat Delphi7=Y Delphi2005Win32=Y @@ -171,6 +206,9 @@ Kind=type DescEx="

Encapsulates a rectangle with double precision floating point size and position.

" SeeAlso=RectF,BoundsF,TPointF Depends=TPointF +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=490.dat Delphi2=Y Delphi3=Y @@ -194,8 +232,12 @@ FPC=Y [TRangeEx] Kind=class DescEx="

Encapsulates a range of integers with a methods to test whether a value falls within the range and to adjust the value to fit.

" +Extra="

Warning: It is up to the caller to ensure that the Min field is always less than or equal to the Max field otherwise the Constrain method will return crazy values and Contains will always return False .

" Units=Math -SeeAlso=Range,TRange +SeeAlso=Range,TRange,TIntegerRange +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=578.dat Delphi2=N Delphi3=N @@ -221,6 +263,9 @@ Kind=class DescEx="

Record that represents the size, i.e. the width and height, of something.

This is an extended version of the TSize record that features equality and inequality operator overloading, a test for zero size and a constructor.

TSizeEx is assignment compatible and comparible with the Delphi RTL's TSize record.

" Units=Types SeeAlso=Size +TestInfo=advanced +AdvancedTest.Level=unit-tests +AdvancedTest.URL="https://github.com/delphidabbler/code-snippets/tree/master/tests/Cat-Structs" Snip=510.dat Delphi2=N Delphi3=N diff --git a/tests/Cat-Arrays/TestUArraysCatSnippets.pas b/tests/Cat-Arrays/TestUArraysCatSnippets.pas index baae0e5..4628a3e 100644 --- a/tests/Cat-Arrays/TestUArraysCatSnippets.pas +++ b/tests/Cat-Arrays/TestUArraysCatSnippets.pas @@ -3,7 +3,7 @@ interface uses - TestFramework, UArraysCatSnippets; + TestFramework, UArraysCatSnippets, Types; type @@ -44,16 +44,34 @@ TestTArrayUtils = class(TTestCase) end; TestArraysCatSnippets = class(TTestCase) + private + function StringArraysEqual(const L, R: TStringDynArray): Boolean; + procedure ByteArraysSameStart_AssertionFailure; + procedure PopByteArray_AssertionFailure; + procedure ShiftByteArray_AssertionFailure; published procedure TestByteArraysEqual; - // The following test must come after TestByteArraysEqual since the test calls it - procedure TestReverseByteArray; + procedure TestAppendByteArray; // test requires ByteArraysEqual + procedure TestArrayToStringList; + procedure TestByteArraysSameStart; + procedure TestChopByteArray; // test requires ByteArraysEqual + procedure TestCloneByteArray; // test requires ByteArraysEqual + procedure TestConcatByteArrays; // test requires ByteArraysEqual + procedure TestIndexOfByte; + procedure TestLastIndexOfByte; + procedure TestPopByteArray; // test requires ByteArraysEqual + procedure TestPushByteArray; // test requires ByteArraysEqual + procedure TestReverseByteArray; // test requires ByteArraysEqual + procedure TestShiftByteArray; // test requires ByteArraysEqual + procedure TestSliceByteArray; // test requires ByteArraysEqual + procedure TestStringListToArray; + procedure TestUnShiftByteArray; // test requires ByteArraysEqual end; implementation uses - SysUtils, Generics.Defaults; + SysUtils, Generics.Defaults, Classes; var IntegerCompareFn: TEqualityComparison; @@ -305,6 +323,118 @@ procedure TestTArrayUtils.TestSameStart; { TestArraysCatSnippets } +procedure TestArraysCatSnippets.ByteArraysSameStart_AssertionFailure; +const + A1: array[1..3] of Byte = (1, 2, 3); + A2: array[11..15] of Byte = (1, 2, 3, 4, 5); +begin + ByteArraysSameStart(A1, A2, 0); +end; + +procedure TestArraysCatSnippets.PopByteArray_AssertionFailure; +var + A: TBytes; +begin + // Attempt to pop empty array + SetLength(A, 0); + PopByteArray(A); +end; + +procedure TestArraysCatSnippets.ShiftByteArray_AssertionFailure; +var + A: TBytes; +begin + // Attempt to shift empty array + SetLength(A, 0); + ShiftByteArray(A); +end; + +function TestArraysCatSnippets.StringArraysEqual(const L, R: TStringDynArray): + Boolean; +var + I: Integer; +begin + Result := Length(L) = Length(R); + if Result then + begin + for I := 0 to High(L) do + begin + if L[I] <> R[I] then + begin + Result := False; + Exit; + end; + end; + end; +end; + +procedure TestArraysCatSnippets.TestAppendByteArray; +var + B1, B2, E: TBytes; +begin + B1 := TBytes.Create(42, 56); + B2 := TBytes.Create(99, 199, 201); + E := TBytes.Create(42, 56, 99, 199, 201); + AppendByteArray(B1, B2); + CheckTrue(ByteArraysEqual(E, B1), '#1'); + + SetLength(B1, 0); + B2 := TBytes.Create(1, 2, 3, 4, 5); + E := TBytes.Create(1, 2, 3, 4, 5); + AppendByteArray(B1, B2); + CheckTrue(ByteArraysEqual(E, B1), '#2'); + + SetLength(B1, 0); + SetLength(B2, 0); + SetLength(E, 0); + AppendByteArray(B1, B2); + CheckTrue(ByteArraysEqual(E, B1), '#3'); + + SetLength(B1, 0); + B2 := TBytes.Create(12, 89); + E := TBytes.Create(12, 89); + AppendByteArray(B1, B2); + CheckTrue(ByteArraysEqual(E, B1), '#4'); + + B1 := TBytes.Create(1, 2, 3); + SetLength(B2, 0); + E := TBytes.Create(1, 2, 3); + AppendByteArray(B1, B2); + CheckTrue(ByteArraysEqual(E, B1), '#5'); +end; + +procedure TestArraysCatSnippets.TestArrayToStringList; +const + S1: array[0..0] of string = ('single elem'); + S3: array[1..3] of string = ('one', 'two', 'three'); +var + S0: array of string; + SL: TStringList; + Expected: string; +begin + SetLength(S0, 0); + SL := TStringList.Create; + try + SL.LineBreak := sLineBreak; + ArrayToStringList(S1, SL); + Expected := 'single elem'; + CheckEquals(Expected, Trim(SL.Text), '#1a'); + CheckEquals(1, SL.Count, '#1b'); + + ArrayToStringList(S3, SL); + Expected := 'one' + sLineBreak + 'two' + sLineBreak + 'three'; + CheckEquals(Expected, Trim(SL.Text), '#2a'); + CheckEquals(3, SL.Count, '#2b'); + + ArrayToStringList(S0, SL); + Expected := ''; + CheckEquals(Expected, Trim(SL.Text), '#3a'); + CheckEquals(0, SL.Count, '#3b'); + finally + SL.Free; + end; +end; + procedure TestArraysCatSnippets.TestByteArraysEqual; var A0L, A0R: TBytes; @@ -337,6 +467,215 @@ procedure TestArraysCatSnippets.TestByteArraysEqual; CheckFalse(ByteArraysEqual(A0L, A1L), '#10'); end; +procedure TestArraysCatSnippets.TestByteArraysSameStart; +const + A1: array[1..3] of Byte = (1, 2, 3); + A2: array[11..15] of Byte = (1, 2, 3, 4, 5); + A3: array[0..3] of Byte = (2, 3, 4, 5); + A4: array[0..0] of Byte = (2); +var + A0: array of Byte; +begin + SetLength(A0, 0); + CheckTrue(ByteArraysSameStart(A1, A2, 2), '#1a'); + CheckTrue(ByteArraysSameStart(A1, A2, 3), '#1b'); + CheckFalse(ByteArraysSameStart(A1, A2, 4), '#1c'); + CheckFalse(ByteArraysSameStart(A1, A2, 12), '#1d'); + CheckTrue(ByteArraysSameStart(A3, A4, 1), '#2a'); + CheckFalse(ByteArraysSameStart(A3, A4, 2), '#2b'); + CheckFalse(ByteArraysSameStart(A1, A3, 1), '#3a'); + CheckFalse(ByteArraysSameStart(A1, A3, 2), '#3b'); + CheckFalse(ByteArraysSameStart(A1, A3, 12), '#3c'); + CheckTrue(ByteArraysSameStart(A2, A2, 1), '#4a'); + CheckTrue(ByteArraysSameStart(A2, A2, 5), '#4b'); + CheckFalse(ByteArraysSameStart(A2, A2, 6), '#4c'); + CheckFalse(ByteArraysSameStart(A0, A0, 1), '#5'); + CheckException(ByteArraysSameStart_AssertionFailure, EAssertionFailed, 'Assert failed'); +end; + +procedure TestArraysCatSnippets.TestChopByteArray; +var + A, R, E: TBytes; +begin + // test zero length array => always returns empty array + SetLength(A, 0); + SetLength(E, 0); + R := ChopByteArray(A, 0, 0); + CheckTrue(ByteArraysEqual(E, R), '#1a'); + R := ChopByteArray(A, -3, -3); + CheckTrue(ByteArraysEqual(E, R), '#1b'); + R := ChopByteArray(A, 2, 29); + CheckTrue(ByteArraysEqual(E, R), '#1c'); + + // test normal cases + A := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + R := ChopByteArray(A, 2, 4); + E := TBytes.Create(1, 2, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#2a'); + R := ChopByteArray(A, 0, 2); + E := TBytes.Create(3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#2b'); + R := ChopByteArray(A, 9, 1); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9); + CheckTrue(ByteArraysEqual(E, R), '#2c'); + R := ChopByteArray(A, 0, 10); + SetLength(E, 0); + CheckTrue(ByteArraysEqual(E, R), '#2d'); + R := ChopByteArray(A, 0, 1); + E := TBytes.Create(2, 3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#2e'); + + // test parameter out of bounds cases + // length = 0 => return whole array + A := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + R := ChopByteArray(A, 3, 0); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#3a'); + // start < 0 => start = 0 + R := ChopByteArray(A, -12, 2); + E := TBytes.Create(3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#3b'); + // length < 0 => length = 0 => return whole array + R := ChopByteArray(A, 3, -12); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#3c'); + // start > length of array => return whole array + R := ChopByteArray(A, 11, 4); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#3d'); + // length goes beyond end of array => chop from start to end + R := ChopByteArray(A, 7, 100); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7); + CheckTrue(ByteArraysEqual(E, R), '#3e'); +end; + +procedure TestArraysCatSnippets.TestCloneByteArray; +var + B0, B1, B6, R: TBytes; +begin + SetLength(B0, 0); + B1 := TBytes.Create(42); + B6 := TBytes.Create(1, 1, 2, 3, 5, 8); + R := CloneByteArray(B0); + CheckTrue(ByteArraysEqual(B0, R), '#1'); + R := CloneByteArray(B1); + CheckTrue(ByteArraysEqual(B1, R), '#2'); + R := CloneByteArray(B6); + CheckTrue(ByteArraysEqual(B6, R), '#3'); +end; + +procedure TestArraysCatSnippets.TestConcatByteArrays; +var + B1, B2, R, E: TBytes; +begin + B1 := TBytes.Create(42, 56); + B2 := TBytes.Create(99, 199, 201); + E := TBytes.Create(42, 56, 99, 199, 201); + R := ConcatByteArrays(B1, B2); + CheckTrue(ByteArraysEqual(E, R), '#1'); + + SetLength(B1, 0); + B2 := TBytes.Create(1, 2, 3, 4, 5); + E := TBytes.Create(1, 2, 3, 4, 5); + R := ConcatByteArrays(B1, B2); + CheckTrue(ByteArraysEqual(E, R), '#2'); + + SetLength(B1, 0); + SetLength(B2, 0); + SetLength(E, 0); + R := ConcatByteArrays(B1, B2); + CheckTrue(ByteArraysEqual(E, R), '#3'); + + SetLength(B1, 0); + B2 := TBytes.Create(12, 89); + E := TBytes.Create(12, 89); + R := ConcatByteArrays(B1, B2); + CheckTrue(ByteArraysEqual(E, R), '#4'); + + B1 := TBytes.Create(1, 2, 3); + SetLength(B2, 0); + E := TBytes.Create(1, 2, 3); + R := ConcatByteArrays(B1, B2); + CheckTrue(ByteArraysEqual(E, R), '#5'); +end; + +procedure TestArraysCatSnippets.TestIndexOfByte; +var + B0, B1, B6: TBytes; +begin + SetLength(B0, 0); + B1 := TBytes.Create(3); + B6 := TBytes.Create(1, 1, 2, 3, 5, 8); + CheckEquals(-1, IndexOfByte(3, B0), '#3a'); + CheckEquals(0, IndexOfByte(3, B1), '#3b'); + CheckEquals(3, IndexOfByte(3, B6), '#3c'); + CheckEquals(-1, IndexOfByte(1, B0), '#1a'); + CheckEquals(-1, IndexOfByte(1, B1), '#1b'); + CheckEquals(0, IndexOfByte(1, B6), '#1c'); + CheckEquals(-1, IndexOfByte(8, B0), '#8a'); + CheckEquals(-1, IndexOfByte(8, B1), '#8b'); + CheckEquals(5, IndexOfByte(8, B6), '#8c'); +end; + +procedure TestArraysCatSnippets.TestLastIndexOfByte; +var + B0, B2, B6: TBytes; +begin + SetLength(B0, 0); + B2 := TBytes.Create(3, 3); + B6 := TBytes.Create(1, 1, 2, 3, 5, 8); + CheckEquals(-1, LastIndexOfByte(3, B0), '#3a'); + CheckEquals(1, LastIndexOfByte(3, B2), '#3b'); + CheckEquals(3, LastIndexOfByte(3, B6), '#3c'); + CheckEquals(-1, LastIndexOfByte(1, B0), '#1a'); + CheckEquals(-1, LastIndexOfByte(1, B2), '#1b'); + CheckEquals(1, LastIndexOfByte(1, B6), '#1c'); + CheckEquals(-1, LastIndexOfByte(8, B0), '#8a'); + CheckEquals(-1, LastIndexOfByte(8, B2), '#8b'); + CheckEquals(5, LastIndexOfByte(8, B6), '#8c'); +end; + +procedure TestArraysCatSnippets.TestPopByteArray; +var + A, E: TBytes; + R: Byte; +begin + // pop value from end of multi-value array + A := TBytes.Create(1, 2, 3); + E := TBytes.Create(1, 2); + R := PopByteArray(A); + CheckTrue(ByteArraysEqual(E, A), '#1a'); + CheckEquals(2, Length(A), '#1b'); + CheckEquals(3, R, '#1c'); + // pop value from end of single value array + A := TBytes.Create(1); + SetLength(E, 0); + R := PopByteArray(A); + CheckTrue(ByteArraysEqual(E, A), '#2a'); + CheckEquals(0, Length(A), '#2b'); + CheckEquals(1, R, '#2c'); + // check assertion failure for empty array + CheckException(PopByteArray_AssertionFailure, EAssertionFailed, 'Assert'); +end; + +procedure TestArraysCatSnippets.TestPushByteArray; +var + A, E: TBytes; +begin + // push value to end of non-empty array + A := TBytes.Create(1, 2, 3); + E := TBytes.Create(1, 2, 3, 42); + PushByteArray(42, A); + CheckTrue(ByteArraysEqual(E, A), '#1a'); + CheckEquals(4, Length(A), '#1b'); + // push value to end of empty array + SetLength(A, 0); + E := TBytes.Create(56); + PushByteArray(56, A); + CheckTrue(ByteArraysEqual(E, A), '#2a'); + CheckEquals(1, Length(A), '#2b'); +end; + procedure TestArraysCatSnippets.TestReverseByteArray; var A0, A1, A2, A6, A7, A4Sym, A5Sym: TBytes; @@ -363,6 +702,130 @@ procedure TestArraysCatSnippets.TestReverseByteArray; CheckTrue(ByteArraysEqual(A5Sym, ReverseByteArray(A5Sym)), '#5 sym'); end; +procedure TestArraysCatSnippets.TestShiftByteArray; +var + A, E: TBytes; + R: Byte; +begin + // pop value from start of multi-value array + A := TBytes.Create(1, 2, 3); + E := TBytes.Create(2, 3); + R := ShiftByteArray(A); + CheckTrue(ByteArraysEqual(E, A), '#1a'); + CheckEquals(2, Length(A), '#1b'); + CheckEquals(1, R, '#1c'); + // pop value from start of single value array + A := TBytes.Create(42); + SetLength(E, 0); + R := ShiftByteArray(A); + CheckTrue(ByteArraysEqual(E, A), '#2a'); + CheckEquals(0, Length(A), '#2b'); + CheckEquals(42, R, '#2c'); + // check assertion failure for empty array + CheckException(ShiftByteArray_AssertionFailure, EAssertionFailed, 'Assert'); +end; + +procedure TestArraysCatSnippets.TestSliceByteArray; +var + A, R, E: TBytes; +begin + // test zero length array => always returns empty array + SetLength(A, 0); + SetLength(E, 0); + R := SliceByteArray(A, 0, 0); + CheckTrue(ByteArraysEqual(E, R), '#1a'); + R := SliceByteArray(A, -3, -3); + CheckTrue(ByteArraysEqual(E, R), '#1b'); + R := SliceByteArray(A, 2, 29); + CheckTrue(ByteArraysEqual(E, R), '#1c'); + + // test normal cases + A := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + R := SliceByteArray(A, 3, 5); + E := TBytes.Create(4, 5, 6, 7, 8); + CheckTrue(ByteArraysEqual(E, R), '#2a'); + R := SliceByteArray(A, 0, 1); + E := TBytes.Create(1); + CheckTrue(ByteArraysEqual(E, R), '#2b'); + R := SliceByteArray(A, 7, 3); + E := TBytes.Create(8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#2c'); + R := SliceByteArray(A, 0, 10); + E := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + CheckTrue(ByteArraysEqual(E, R), '#2d'); + + // test parameter out of bounds cases + // length = 0 => return empty array + A := TBytes.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10); + R := SliceByteArray(A, 3, 0); + SetLength(E, 0); + CheckTrue(ByteArraysEqual(E, R), '#3a'); + // start < 0 => start = 0 + R := SliceByteArray(A, -12, 2); + E := TBytes.Create(1, 2); + CheckTrue(ByteArraysEqual(E, R), '#3b'); + // length < 0 => length = 0 => return empty array + R := SliceByteArray(A, 3, -12); + SetLength(E, 0); + CheckTrue(ByteArraysEqual(E, R), '#3c'); + // start > length of array => return empty array + R := SliceByteArray(A, 11, 4); + SetLength(E, 0); + CheckTrue(ByteArraysEqual(E, R), '#3d'); + // length goes beyond end of array => return from start to end of array + R := SliceByteArray(A, 8, 100); + E := TBytes.Create(9, 10); + CheckTrue(ByteArraysEqual(E, R), '#3e'); +end; + +procedure TestArraysCatSnippets.TestStringListToArray; +var + SL: TStringList; + A, E: TStringDynArray; +begin + SL := TStringList.Create; + try + SL.Clear; + SetLength(E, 0); + A := StringListToArray(SL); + CheckTrue(StringArraysEqual(E, A), '#1'); + + SL.Clear; + SL.Add('one'); + A := StringListToArray(SL); + E := TStringDynArray.Create('one'); + CheckTrue(StringArraysEqual(E, A), '#2'); + + SL.Clear; + SL.Add('one'); + SL.Add('two'); + SL.Add('three'); + A := StringListToArray(SL); + E := TStringDynArray.Create('one', 'two', 'three'); + CheckTrue(StringArraysEqual(E, A), '#3'); + finally + SL.Free; + end; +end; + +procedure TestArraysCatSnippets.TestUnShiftByteArray; +var + A, E: TBytes; +begin + // push value to start of non-empty array + A := TBytes.Create(1, 2, 3); + E := TBytes.Create(42, 1, 2, 3); + UnShiftByteArray(42, A); + CheckTrue(ByteArraysEqual(E, A), '#1a'); + CheckEquals(4, Length(A), '#1b'); + // push value to start of empty array + SetLength(A, 0); + E := TBytes.Create(56); + UnShiftByteArray(56, A); + CheckTrue(ByteArraysEqual(E, A), '#2a'); + CheckEquals(1, Length(A), '#2b'); +end; + initialization IntegerCompareFn := function (const Left, Right: Integer): Boolean diff --git a/tests/Cat-String/TestUStringCatSnippets.pas b/tests/Cat-String/TestUStringCatSnippets.pas index b814a84..4deb37e 100644 --- a/tests/Cat-String/TestUStringCatSnippets.pas +++ b/tests/Cat-String/TestUStringCatSnippets.pas @@ -8,6 +8,7 @@ interface type TestStringCatSnippets = class(TTestCase) private + procedure RandomString_Exception; published procedure TestStripAccelChars; procedure TestReverseStr; @@ -15,12 +16,13 @@ TestStringCatSnippets = class(TTestCase) procedure TestIsNumeric; procedure TestSplitString; procedure TestParseStr; + procedure TestRandomString; end; implementation uses - Classes; + SysUtils, Classes; function IsEqualStringList(const Expected, Actual: TStrings): Boolean; var @@ -37,6 +39,18 @@ function IsEqualStringList(const Expected, Actual: TStrings): Boolean; { TestStringCatSnippets } +procedure TestStringCatSnippets.RandomString_Exception; +var + SL: TStrings; +begin + SL := TStringList.Create; + try + RandomString(SL); + finally + SL.Free; + end; +end; + procedure TestStringCatSnippets.TestIsNumeric; begin CheckTrue(IsNumeric('123', False, False), 'Test 1'); @@ -133,6 +147,41 @@ procedure TestStringCatSnippets.TestParseStr; end; end; +procedure TestStringCatSnippets.TestRandomString; +var + SL5, SL1: TStrings; + S: string; + Idx, I: Integer; +begin + SL1 := nil; + SL5 := nil; + try + SL5 := TStringList.Create; + SL5.Add('one'); + SL5.Add('two'); + SL5.Add('three'); + SL5.Add('four'); + SL5.Add('five'); + for I := 1 to 5 do + begin + S := RandomString(SL5); + Idx := SL5.IndexOf(S); + CheckTrue(Idx >= 0, Format('SL5.%d', [I])); + SL5.Delete(Idx); + end; + + SL1 := TStringList.Create; + SL1.Add('only'); + S := RandomString(SL1); + CheckEquals('only', S, '#2'); + finally + SL5.Free; + SL1.Free; + end; + + CheckException(RandomString_Exception, EArgumentException, 'Exception'); +end; + procedure TestStringCatSnippets.TestReverseStr; begin CheckEquals('derf', ReverseStr('fred'), 'Test 1'); diff --git a/tests/Cat-String/UStringCatSnippets.pas b/tests/Cat-String/UStringCatSnippets.pas index f4de3eb..7afd6c0 100644 --- a/tests/Cat-String/UStringCatSnippets.pas +++ b/tests/Cat-String/UStringCatSnippets.pas @@ -1,14 +1,25 @@ { - * This file was generated from the DelphiDabbler Code Snippets collection. - * - * See https://github.com/delphidabsbler/code-snippets/tree/master/LICENSE.md for - * full license & copyright information. + * This unit was generated automatically. It incorporates a selection of source + * code taken from the Code Snippets Database at + * https://github.com/delphidabbler/code-snippets. + * + * The unit is copyright 2005-2025 by Peter Johnson & Contributors and is + * licensed under the MIT License (https://opensource.org/licenses/MIT). + * + * Generated on : Sat, 05 Apr 2025 12:14:56 GMT. + * Generated by : DelphiDabbler CodeSnip Release 4.24.0. + * + * The latest version of CodeSnip is available from the CodeSnip GitHub project + * at https://github.com/delphidabbler/codesnip. } unit UStringCatSnippets; {$IFNDEF FPC} {$IFDEF CONDITIONALEXPRESSIONS} + {$IF CompilerVersion >= 24.00} + {$LEGACYIFEND ON} + {$IFEND} {$IF CompilerVersion >= 14.00} {$WARN SYMBOL_PLATFORM OFF} {$WARN SYMBOL_DEPRECATED OFF} @@ -29,31 +40,116 @@ interface uses - SysUtils, StrUtils, Classes, Windows; + SysUtils, Classes, StrUtils; -function StripAccelChars(const S: string): string; +{ + Checks if the string Value contains a valid numeric value and returns True if + so or False if not. + If AllowFloat is true then Value may contain a floating point number, + otherwise it must be an integer. If TrimWhiteSpace is True any white space + surrounding Value is trimmed before testing. +} +function IsNumeric(Value: string; const AllowFloat: Boolean; + const TrimWhiteSpace: Boolean = True): Boolean; + +{ + Splits the string StrToParse into segments separated by Delimiter and stores + each segment in turn in string list Words, replacing any existing content. +} +procedure ParseStr(const StrToParse: string; const Delimiter: Char; + const Words: Classes.TStringList); +{ + Returns a random string from the given non-empty string list. + An EArgumentException exception is raised if the string list is empty. +} +function RandomString(const SL: Classes.TStrings): string; overload; + +{ + Returns the reverse of the given string. +} function ReverseStr(S: string): string; +{ + Returns the reverse of the given string. +} function ReverseStrR(const S: string): string; -function IsNumeric(Value: string; const AllowFloat: Boolean; - const TrimWhiteSpace: Boolean = True): Boolean; - +{ + Splits the string AText into segments separated by Delimiter and creates and + returns a string list containing the segments. + The caller is responsible for freeing the returnd string list object. +} function SplitString(const AText, ADelimiter: string): Classes.TStringList; -procedure ParseStr(const StrToParse: string; const Delimiter: Char; - const Words: Classes.TStringList); +{ + Strips all accelerator ('&') characters from the given string and returns the + resulting string. +} +function StripAccelChars(const S: string): string; implementation -function StripAccelChars(const S: string): string; +{ + Checks if the string Value contains a valid numeric value and returns True if + so or False if not. + If AllowFloat is true then Value may contain a floating point number, + otherwise it must be an integer. If TrimWhiteSpace is True any white space + surrounding Value is trimmed before testing. +} +function IsNumeric(Value: string; const AllowFloat: Boolean; + const TrimWhiteSpace: Boolean = True): Boolean; +var + ValueInt: Int64; // dummy integer value + ValueFloat: Extended; // dummy float value begin - Result := SysUtils.StringReplace( - S, '&', SysUtils.EmptyStr, [SysUtils.rfReplaceAll] - ); + if TrimWhiteSpace then + Value := SysUtils.Trim(Value); + // Check for valid integer + Result := SysUtils.TryStrToInt64(Value, ValueInt); + if not Result and AllowFloat then + // Wasn't valid as integer, try float + Result := SysUtils.TryStrToFloat(Value, ValueFloat); +end; + +{ + Splits the string StrToParse into segments separated by Delimiter and stores + each segment in turn in string list Words, replacing any existing content. +} +procedure ParseStr(const StrToParse: string; const Delimiter: Char; + const Words: Classes.TStringList); +var + TmpInStr: string; +begin + TmpInStr := StrToParse; + Words.Clear; + if Length(TmpInStr) > 0 then + begin + while Pos(Delimiter, TmpInStr) > 0 do + begin + Words.Append(Copy(TmpInStr, 1, Pos(Delimiter, TmpInStr) - 1)); + Delete(TmpInStr, 1, Pos(Delimiter, TmpInStr)); + end; + Words.Append(TmpInStr); + end; end; +{ + Returns a random string from the given non-empty string list. + An EArgumentException exception is raised if the string list is empty. +} +function RandomString(const SL: Classes.TStrings): string; overload; +begin + if SL.Count = 0 then + raise SysUtils.EArgumentException.Create( + 'RandomString called with empty string list' + ); + Result := SL[Random(SL.Count)]; +end; + +{ + Returns the reverse of the given string. +} function ReverseStr(S: string): string; begin Result := SysUtils.EmptyStr; @@ -64,6 +160,9 @@ function ReverseStr(S: string): string; end; end; +{ + Returns the reverse of the given string. +} function ReverseStrR(const S: string): string; begin if SysUtils.AnsiSameText(S, SysUtils.EmptyStr) or (System.Length(S) = 1) then @@ -73,21 +172,11 @@ function ReverseStrR(const S: string): string; + ReverseStrR(StrUtils.LeftStr(S, System.Length(S) - 1)) end; -function IsNumeric(Value: string; const AllowFloat: Boolean; - const TrimWhiteSpace: Boolean = True): Boolean; -var - ValueInt: Int64; // dummy integer value - ValueFloat: Extended; // dummy float value -begin - if TrimWhiteSpace then - Value := SysUtils.Trim(Value); - // Check for valid integer - Result := SysUtils.TryStrToInt64(Value, ValueInt); - if not Result and AllowFloat then - // Wasn't valid as integer, try float - Result := SysUtils.TryStrToFloat(Value, ValueFloat); -end; - +{ + Splits the string AText into segments separated by Delimiter and creates and + returns a string list containing the segments. + The caller is responsible for freeing the returnd string list object. +} function SplitString(const AText, ADelimiter: string): Classes.TStringList; var LTxt, LTmp: string; @@ -104,23 +193,15 @@ function SplitString(const AText, ADelimiter: string): Classes.TStringList; Result.Add(LTxt); end; -procedure ParseStr(const StrToParse: string; const Delimiter: Char; - const Words: Classes.TStringList); -var - TmpInStr: string; +{ + Strips all accelerator ('&') characters from the given string and returns the + resulting string. +} +function StripAccelChars(const S: string): string; begin - TmpInStr := StrToParse; - Words.Clear; - if Length(TmpInStr) > 0 then - begin - while Pos(Delimiter, TmpInStr) > 0 do - begin - Words.Append(Copy(TmpInStr, 1, Pos(Delimiter, TmpInStr) - 1)); - Delete(TmpInStr, 1, Pos(Delimiter, TmpInStr)); - end; - Words.Append(TmpInStr); - end; + Result := SysUtils.StringReplace( + S, '&', SysUtils.EmptyStr, [SysUtils.rfReplaceAll] + ); end; end. - diff --git a/tests/Cat-Structs/TestCatStructsXE.dpr b/tests/Cat-Structs/TestCatStructsXE.dpr new file mode 100644 index 0000000..cc5d08d --- /dev/null +++ b/tests/Cat-Structs/TestCatStructsXE.dpr @@ -0,0 +1,35 @@ +program TestCatStructsXE; +{ + +Delphi DUnit Test Project +------------------------- +This project contains the DUnit test framework and the GUI/Console test runners. +Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options +to use the console test runner. Otherwise the GUI test runner will be used by +default. + +} + +{$IFDEF CONSOLE_TESTRUNNER} +{$APPTYPE CONSOLE} +{$ENDIF} + +uses + Forms, + TestFramework, + GUITestRunner, + TextTestRunner, + TestUStructCatSnippets in 'TestUStructCatSnippets.pas', + UStructCatSnippets in 'UStructCatSnippets.pas'; + +{$R *.RES} + +begin + Application.Initialize; + if IsConsole then + with TextTestRunner.RunRegisteredTests do + Free + else + GUITestRunner.RunRegisteredTests; +end. + diff --git a/tests/Cat-Structs/TestCatStructsXE.dproj b/tests/Cat-Structs/TestCatStructsXE.dproj new file mode 100644 index 0000000..49810fe --- /dev/null +++ b/tests/Cat-Structs/TestCatStructsXE.dproj @@ -0,0 +1,118 @@ + + + {CEAD8332-8CBB-45F7-BC9C-CF3ED093133E} + TestCatStructsXE.dpr + 12.3 + True + Debug + Win32 + Application + VCL + DCC32 + + + true + + + true + Base + true + + + true + Base + true + + + $(BDS)\Source\DUnit\src;$(DCC_UnitSearchPath) + 00400000 + _build\Exe + WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;$(DCC_UnitAlias) + _CONSOLE_TESTRUNNER;$(DCC_Define) + _build\Bin\Cat-Structs + false + false + false + false + false + + + DEBUG;$(DCC_Define) + false + true + + + false + RELEASE;$(DCC_Define) + 0 + false + + + + MainSource + + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + + + Delphi.Personality.12 + + + + + False + False + 1 + 0 + 0 + 0 + False + False + False + False + False + 2057 + 1252 + + + + + 1.0.0.0 + + + + + + 1.0.0.0 + + + + TestCatStructsXE.dpr + + + + True + + + DUnit / Delphi Win32 + GUI + C:\Code\Repos\delphidabbler\code-snippets\tests\Cat-Hex\TestHexCat.dproj + + + + 12 + + diff --git a/tests/Cat-Structs/TestCatStructsXE.res b/tests/Cat-Structs/TestCatStructsXE.res new file mode 100644 index 0000000..2c52f20 Binary files /dev/null and b/tests/Cat-Structs/TestCatStructsXE.res differ diff --git a/tests/Cat-Structs/TestUStructCatSnippets.pas b/tests/Cat-Structs/TestUStructCatSnippets.pas new file mode 100644 index 0000000..48f0bb8 --- /dev/null +++ b/tests/Cat-Structs/TestUStructCatSnippets.pas @@ -0,0 +1,900 @@ +unit TestUStructCatSnippets; + +interface + +uses + SysUtils, TestFramework, UStructCatSnippets; + +implementation + +uses + Types; + +type + + TestMiscStructsCatSnippets = class(TTestCase) + published + procedure TestType_TPointF; + procedure TestType_TRange; + procedure TestType_TRectF; // requires TPointF + procedure TestFunction_PointF; // requires TPointF + procedure TestFunction_Range; // requires TRange + procedure TestFunction_RectF; // requires TPointF & TRectF + procedure TestFunction_Size; + procedure TestFunction_BoundsF; // requires TRectF & RectF + end; + + TestTSizeEx = class(TTestCase) + published + // Order of tests is important Ctor then implicit ops then equality ops and + // IsZero method + procedure TestCtorAndFields; + procedure TestImplicitOp_TSizeToTSizeEx; + procedure TestImplicitOp_TSizeExToTSize; + procedure TestEqualOp; + procedure TestNotEqualOp; + procedure TestIsZero; + end; + + TestTRangeEx = class(TTestCase) + published + procedure TestCtorAndFields; + procedure TestContains; + procedure TestConstrain; + end; + + TestTIntegerRange = class(TTestCase) + private + procedure TestCtorAndPropsException; + procedure TestConstrainException; + published + procedure TestCtorAndProps; + procedure TestCreateEmpty; + procedure TestIsEmpty; + procedure TestLength; + procedure TestConstrain; + procedure TestEqualOp; + procedure TestNotEqualOp; + procedure TestLessThanOrEqualOp; + procedure TestGreaterThanOrEqualOp; + procedure TestAddOp; + procedure TestMultiplyOp; + procedure TestInOp; + procedure TestImplicitToStringOp; + procedure TestExplicitToStringOp; + procedure TestOverlapsWith; // depends upon operator overloads + procedure TestIsContiguousWith; + procedure TestIsContinuousWith; + end; + +{ TestMiscStructsCatSnippets } + +procedure TestMiscStructsCatSnippets.TestFunction_BoundsF; +var + R, Expected: TRectF; +const + Delta = 0.00000001; +begin + R := BoundsF(10.3, 20.4, 10.5, 20.6); + Expected := RectF(10.3, 20.4, 10.3+10.5, 20.4+20.6); + CheckEquals(Expected.Left, R.Left, Delta, 'left'); + CheckEquals(Expected.Top, R.Top, Delta, 'top'); + CheckEquals(Expected.Right, R.Right, Delta, 'right'); + CheckEquals(Expected.Bottom, R.Bottom, Delta, 'bottom'); +end; + +procedure TestMiscStructsCatSnippets.TestFunction_PointF; +var + P: TPointF; +const + Delta = 0.00000001; +begin + P := PointF(0.0, 0.0); + CheckEquals(0.0, P.X, Delta, '#1X'); + CheckEquals(0.0, P.Y, Delta, '#1Y'); + P := PointF(42.56, -12.345); + CheckEquals(42.56, P.X, Delta, '#2X'); + CheckEquals(-12.345, P.Y, Delta, '#2Y'); +end; + +procedure TestMiscStructsCatSnippets.TestFunction_Range; +var + R: TRange; +begin + // Range function orders parameters + R := Range(42, 56); + CheckEquals(42, R.Lower, '#1 lower'); + CheckEquals(56, R.Upper, '#1 upper'); + R := Range(56, 42); + CheckEquals(42, R.Lower, '#2 lower'); + CheckEquals(56, R.Upper, '#2 upper'); +end; + +procedure TestMiscStructsCatSnippets.TestFunction_RectF; +var + R: TRectF; +const + Delta = 0.00000001; +begin + R := RectF(0.0, -10.8, 34.56, 20.3); + CheckEquals(0.0, R.Left, Delta, 'left'); + CheckEquals(-10.8, R.Top, Delta, 'top'); + CheckEquals(34.56, R.Right, Delta, 'right'); + CheckEquals(20.3, R.Bottom, Delta, 'bottom'); + CheckEquals(0.0, R.TopLeft.X, Delta, 'topleft.x'); + CheckEquals(-10.8, R.TopLeft.Y, Delta, 'topleft.y'); + CheckEquals(34.56, R.BottomRight.X, Delta, 'bottomright.x'); + CheckEquals(20.3, R.BottomRight.Y, Delta, 'bottomright.y'); +end; + +procedure TestMiscStructsCatSnippets.TestFunction_Size; +var + S: TSize; +begin + S.cx := 42; + S.cy := 56; + CheckEquals(42, S.cx, 'cx'); + CheckEquals(56, S.cy, 'cy'); +end; + +procedure TestMiscStructsCatSnippets.TestType_TPointF; +var + P: TPointF; +const + Delta = 0.00000001; +begin + P.X := 0.0; + P.Y := 0.0; + CheckEquals(0.0, P.X, Delta, '#1X'); + CheckEquals(0.0, P.Y, Delta, '#1Y'); + P.X := 42.56; + P.Y := -12.345; + CheckEquals(42.56, P.X, Delta, '#2X'); + CheckEquals(-12.345, P.Y, Delta, '#2Y'); +end; + +procedure TestMiscStructsCatSnippets.TestType_TRange; +var + R: TRange; +begin + // Test direct field setting + R.Lower := 42; + R.Upper := 56; + CheckEquals(42, R.Lower, '#1 lower'); + CheckEquals(56, R.Upper, '#1 upper'); + R.Lower := 56; + R.Upper := 42; + CheckEquals(56, R.Lower, '#2 lower'); + CheckEquals(42, R.Upper, '#2 upper'); +end; + +procedure TestMiscStructsCatSnippets.TestType_TRectF; +var + R: TRectF; + TL, BR: TPointF; +const + Delta = 0.00000001; +begin + // Set Left, Right, Top & Bottom fields + R.Left := 2.2; + R.Right := 6.6; + R.Top := 8.8; + R.Bottom := 16.16; + TL.X := 2.2; + TL.Y := 8.8; + BR.X := 6.6; + BR.Y := 16.16; + CheckEquals(2.2, R.Left, Delta, '#1 left'); + CheckEquals(6.6, R.Right, Delta, '#1 right'); + CheckEquals(8.8, R.Top, Delta, '#1 top'); + CheckEquals(16.16, R.Bottom, Delta, '#1 bottom'); + CheckEquals(2.2, R.TopLeft.X, Delta, '#1 topleft.x'); + CheckEquals(8.8, R.TopLeft.Y, Delta, '#1 topleft.y'); + CheckEquals(6.6, R.BottomRight.X, Delta, '#1 bottomright.x'); + CheckEquals(16.16, R.BottomRight.Y, Delta, '#1 bottomright.y'); + // Set TopLeft & BottomRight TPointF properties + TL.X := 10.11; + TL.Y := 12.13; + BR.X := 11.12; + BR.Y := 13.14; + R.TopLeft := TL; + R.BottomRight := BR; + CheckEquals(10.11, R.Left, Delta, '#2 left'); + CheckEquals(12.13, R.Top, Delta, '#2 top'); + CheckEquals(11.12, R.Right, Delta, '#2 right'); + CheckEquals(13.14, R.Bottom, Delta, '#2 bottom'); +end; + +{ TestTSizeEx } + +procedure TestTSizeEx.TestCtorAndFields; +var + S: TSizeEx; +begin + // Test direct field access + S.CX := 42; + S.CY := -56; + CheckEquals(42, S.CX, '#1a'); + CheckEquals(-56, S.CY, '#1b'); + // Text Ctor + S := TSizeEx.Create(42, -56); + CheckEquals(42, S.CX, '#2a'); + CheckEquals(-56, S.CY, '#2b'); +end; + +procedure TestTSizeEx.TestEqualOp; +var + Sx0, Sx1a, Sx1b, Sx2: TSizeEx; + S0, S1, S2: TSize; +begin + // Test with both operands TSizeEx + Sx0 := TSizeEx.Create(0, 0); + Sx1a := TSizeEx.Create(42, 56); + Sx1b := TSizeEx.Create(42, 56); + Sx2 := TSizeEx.Create(99, 99); + CheckTrue(Sx1a = Sx1b, '#1a'); + CheckFalse(Sx0 = Sx2, '#1b'); + CheckFalse(Sx1a = Sx2, '#1c'); + // Test with one TSizeEx and one TSize operanc + S0 := Sx0; + S1 := Sx1a; + S2 := Sx2; + CheckTrue(Sx1a = S1, '#2a'); + CheckFalse(S0 = Sx2, '#2b'); + CheckTrue(S2 = Sx2, '#2c'); +end; + +procedure TestTSizeEx.TestImplicitOp_TSizeExToTSize; +var + Src: TSizeEx; + Dest: TSize; +begin + Src := TSizeEx.Create(23, -99); + Dest := Src; + CheckEquals(23, Dest.cx, 'cx'); + CheckEquals(-99, Dest.cy, 'cy'); +end; + +procedure TestTSizeEx.TestImplicitOp_TSizeToTSizeEx; +var + Src: TSize; + Dest: TSizeEx; +begin + Src := TSizeEx.Create(23, 423); + Dest := Src; + CheckEquals(23, Dest.CX, 'CX'); + CheckEquals(423, Dest.CY, 'CY'); +end; + +procedure TestTSizeEx.TestIsZero; +var + S: TSizeEx; +begin + S := TSizeEx.Create(12, 23); + CheckFalse(S.IsZero, '#1'); + S := TSizeEx.Create(0, 0); + CheckTrue(S.IsZero, '#2'); + S := TSizeEx.Create(0, 1); + CheckTrue(S.IsZero, '#3'); + S := TSizeEx.Create(-1, 0); + CheckTrue(S.IsZero, '#4'); +end; + +procedure TestTSizeEx.TestNotEqualOp; +var + Sx0, Sx1a, Sx1b, Sx2: TSizeEx; + S0, S1, S2: TSize; +begin + // Test with both operands TSizeEx + Sx0 := TSizeEx.Create(0, 0); + Sx1a := TSizeEx.Create(42, 56); + Sx1b := TSizeEx.Create(42, 56); + Sx2 := TSizeEx.Create(99, 99); + CheckFalse(Sx1a <> Sx1b, '#1a'); + CheckTrue(Sx0 <> Sx2, '#1b'); + CheckTrue(Sx1a <> Sx2, '#1c'); + // Test with one TSizeEx and one TSize operanc + S0 := Sx0; + S1 := Sx1a; + S2 := Sx2; + CheckFalse(Sx1a <> S1, '#2a'); + CheckTrue(S0 <> Sx2, '#2b'); + CheckFalse(S2 <> Sx2, '#2c'); +end; + +{ TestTRangeEx } + +procedure TestTRangeEx.TestConstrain; +var + R: TRangeEx; +begin + // Min < Max => expected results + R := TRangeEx.Create(-42, 56); + CheckEquals(2, R.Constrain(2), '#1a'); + CheckEquals(-42, R.Constrain(-42), '#1b'); + CheckEquals(56, R.Constrain(56), '#1c'); + CheckEquals(-42, R.Constrain(-99), '#1d'); + CheckEquals(56, R.Constrain(99), '#1e'); + // Min > Max => bonkers results !!! + R := TRangeEx.Create(56, 42); + CheckEquals(56, R.Constrain(2), '#2a'); // !!! should be 42 + CheckEquals(56, R.Constrain(42), '#2b'); // !!! should be 42 + CheckEquals(42, R.Constrain(56), '#2c'); // !!! should be 56 + CheckEquals(56, R.Constrain(48), '#2d'); // !!! should be 48 + CheckEquals(56, R.Constrain(40), '#2e'); // !!! should be 42 + CheckEquals(42, R.Constrain(99), '#2f'); // !!! should be 56 + // Min = Max => expected results + R := TRangeEx.Create(3, 3); + CheckEquals(3, R.Constrain(2), '#1a'); + CheckEquals(3, R.Constrain(3), '#1b'); + CheckEquals(3, R.Constrain(4), '#1c'); +end; + +procedure TestTRangeEx.TestContains; +var + R: TRangeEx; +begin + // Min < Max => expected results + R := TRangeEx.Create(-42, 56); + CheckTrue(R.Contains(2), '#1a'); + CheckTrue(R.Contains(-42), '#1b'); + CheckTrue(R.Contains(56), '#1c'); + CheckFalse(R.Contains(-99), '#1d'); + CheckFalse(R.Contains(57), '#1e'); + // Max > Min => bonkers results !!! + R := TRangeEx.Create(56, 42); + CheckFalse(R.Contains(48), '#2a'); // !!! Should be True + CheckFalse(R.Contains(2), '#2b'); + CheckFalse(R.Contains(99), '#2c'); + CheckFalse(R.Contains(42), '#2b'); // !!! Should be True + CheckFalse(R.Contains(56), '#2b'); // !!! Should be True + // Min = Max => expected results + R := TRangeEx.Create(3, 3); + CheckFalse(R.Contains(2), '#3a'); + CheckFalse(R.Contains(4), '#3b'); + CheckTrue(R.Contains(3), '#3c'); +end; + +procedure TestTRangeEx.TestCtorAndFields; +var + R: TRangeEx; +begin + // Direct field access: no ordering of range + R.Min := 42; + R.Max := 56; + CheckEquals(42, R.Min, '#1 min'); + CheckEquals(56, R.Max, '#1 max'); + R.Min := 56; + R.Max := 42; + CheckEquals(56, R.Min, '#2 min'); + CheckEquals(42, R.Max, '#2 max'); + // Ctor: also no ordering of range + R := TRangeEx.Create(42, 56); + CheckEquals(42, R.Min, '#3 min'); + CheckEquals(56, R.Max, '#3 max'); + R := TRangeEx.Create(56, 42); + CheckEquals(56, R.Min, '#3 min'); + CheckEquals(42, R.Max, '#3 max'); +end; + +{ TestTIntegerRange } + +procedure TestTIntegerRange.TestAddOp; +var + L, R, E: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + E := TIntegerRange.Create(0, 0); + CheckTrue(E = L + R, '#1a'); + CheckTrue(E = R + L, '#1b'); + L := TIntegerRange.Create(1, 4); + R := TIntegerRange.Create(7, 10); + E := TIntegerRange.Create(1, 10); + CheckTrue(E = L + R, '#2a'); + CheckTrue(E = R + L, '#2b'); + L := TIntegerRange.Create(2, 5); + R := TIntegerRange.Create(4, 10); + E := TIntegerRange.Create(2, 10); + CheckTrue(E = L + R, '#3a'); + CheckTrue(E = R + L, '#3b'); + L := TIntegerRange.Create(2, 5); + R := TIntegerRange.Create(-3, 10); + E := TIntegerRange.Create(-3, 10); + CheckTrue(E = L + R, '#4a'); + CheckTrue(E = R + L, '#4b'); + L := TIntegerRange.Create(2, 5); + R := TIntegerRange.Create(5, 5); + E := TIntegerRange.Create(2, 5); + CheckTrue(E = L + R, '#5a'); + CheckTrue(E = R + L, '#5b'); + L := TIntegerRange.Create(2, 5); + R := TIntegerRange.Create(2, 5); + E := TIntegerRange.Create(2, 5); + CheckTrue(E = L + R, '#6a'); + CheckTrue(E = R + L, '#6b'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + E := TIntegerRange.CreateEmpty; + CheckTrue(E = L + R, '#9'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.CreateEmpty; + E := TIntegerRange.Create(10, 10); + CheckTrue(E = L + R, '#10a'); + CheckTrue(E = R + L, '#10b'); +end; + +procedure TestTIntegerRange.TestConstrain; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(0, 0); + CheckEquals(0, R.Constrain(-2), '#1a'); + CheckEquals(0, R.Constrain(4356), '#1b'); + CheckEquals(0, R.Constrain(0), '#1c'); + R := TIntegerRange.Create(-42, 56); + CheckEquals(-2, R.Constrain(-2), '#2a'); + CheckEquals(56, R.Constrain(4356), '#2b'); + CheckEquals(56, R.Constrain(56), '#2c'); + CheckEquals(-42, R.Constrain(-42), '#2d'); + CheckEquals(-42, R.Constrain(-43), '#2e'); + CheckEquals(56, R.Constrain(57), '#2f'); + CheckEquals(12, R.Constrain(12), '#2g'); + CheckException(TestConstrainException, EInvalidOpException, '#3'); +end; + +procedure TestTIntegerRange.TestConstrainException; +var + R: TIntegerRange; +begin + R := TIntegerRange.CreateEmpty; + R.Constrain(0); +end; + +procedure TestTIntegerRange.TestCreateEmpty; +var + R: TIntegerRange; +begin + R := TIntegerRange.CreateEmpty; + CheckTrue(R.IsEmpty, '#1'); +end; + +procedure TestTIntegerRange.TestCtorAndProps; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(0, 0); + CheckEquals(0, R.LowerBound, '#1a'); + CheckEquals(0, R.UpperBound, '#1b'); + R := TIntegerRange.Create(-3, 10); + CheckEquals(-3, R.LowerBound, '#2a'); + CheckEquals(10, R.UpperBound, '#2b'); + R := TIntegerRange.Create(10, -42); + CheckEquals(-42, R.LowerBound, '#3a'); + CheckEquals(10, R.UpperBound, '#3b'); + R := TIntegerRange.Create(10, 10); + CheckEquals(10, R.LowerBound, '#4a'); + CheckEquals(10, R.UpperBound, '#4b'); + R := TIntegerRange.Create(MaxInt, -MaxInt);; + CheckEquals(-MaxInt, R.LowerBound, '#5a'); + CheckEquals(MaxInt, R.UpperBound, '#5b'); + CheckException(TestCtorAndPropsException, EArgumentException, '#6'); +end; + +procedure TestTIntegerRange.TestCtorAndPropsException; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(Low(Integer), 0); +end; + +procedure TestTIntegerRange.TestEqualOp; +var + L, R: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + CheckTrue(L = R, '#1a'); + CheckTrue(R = L, '#1b'); + L := TIntegerRange.Create(-3, 11); + R := TIntegerRange.Create(-3, 10); + CheckFalse(L = R, '#2a'); + CheckFalse(R = L, '#2b'); + L := TIntegerRange.Create(-43, 9); + R := TIntegerRange.Create(10, -42); + CheckFalse(L = R, '#3a'); + CheckFalse(R = L, '#3b'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.Create(10, 10); + CheckTrue(L = R, '#4a'); + CheckTrue(R = L, '#4b'); + CheckTrue(R = R, '#5'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + CheckTrue(L = R, '#6'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.CreateEmpty; + CheckFalse(L = R, '#6'); +end; + +procedure TestTIntegerRange.TestExplicitToStringOp; +var + R: TIntegerRange; +begin + R := TIntegerRange.CreateEmpty; + CheckEquals('[]', string(R)); + R := TIntegerRange.Create(0, 0); + CheckEquals('[0..0]', string(R)); + R := TIntegerRange.Create(-42, 56); + CheckEquals('[-42..56]', string(R)); +end; + +procedure TestTIntegerRange.TestGreaterThanOrEqualOp; +var + L, R: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + CheckTrue(L >= R, '#1a'); + CheckTrue(R >= L, '#1b'); + L := TIntegerRange.Create(0, 1); + R := TIntegerRange.Create(0, 0); + CheckTrue(L >= R, '#2a'); + CheckFalse(R >= L, '#2b'); + L := TIntegerRange.Create(-3, 12); + R := TIntegerRange.Create(-5, 18); + CheckFalse(L >= R, '#3a'); + CheckTrue(R >= L, '#3b'); + L := TIntegerRange.Create(-5, 17); + R := TIntegerRange.Create(-5, 18); + CheckFalse(L >= R, '#4a'); + CheckTrue(R >= L, '#4b'); + L := TIntegerRange.Create(-4, 18); + R := TIntegerRange.Create(-5, 18); + CheckFalse(L >= R, '#5a'); + CheckTrue(R >= L, '#5b'); + L := TIntegerRange.Create(-5, 18); + R := TIntegerRange.Create(-5, 18); + CheckTrue(L >= R, '#6a'); + CheckTrue(R >= L, '#6b'); + L := TIntegerRange.Create(-5, 2); + R := TIntegerRange.Create(4, 18); + CheckFalse(L >= R, '#7a'); + CheckFalse(R >= L, '#7b'); + L := TIntegerRange.Create(1, 1); + R := TIntegerRange.Create(4, 18); + CheckFalse(L >= R, '#8a'); + CheckFalse(R >= L, '#8b'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + Checktrue(L >= R, '#9'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.CreateEmpty; + CheckTrue(L >= R, '#10a'); + CheckFalse(R >= L, '#10b'); +end; + +procedure TestTIntegerRange.TestImplicitToStringOp; +var + R: TIntegerRange; +begin + R := TIntegerRange.CreateEmpty; + CheckEquals('[]', R); + R := TIntegerRange.Create(0, 0); + CheckEquals('[0..0]', R); + R := TIntegerRange.Create(-42, 56); + CheckEquals('[-42..56]', R); +end; + +procedure TestTIntegerRange.TestInOp; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(0, 0); + CheckTrue(0 in R, '#1'); + CheckFalse(-2 in R, '#2'); + R := TIntegerRange.Create(-42, 56); + CheckTrue(0 in R, '#3'); + CheckTrue(-2 in R, '#4'); + CheckTrue(-42 in R, '#5'); + CheckTrue(56 in R, '#6'); + CheckFalse(-43 in R, '#7'); + CheckFalse(57 in R, '#8'); + R := TIntegerRange.Create(999, 999); + CheckTrue(999 in R, '#9'); + CheckFalse(998 in R, '#10'); + R := TIntegerRange.CreateEmpty; + CheckFalse(0 in R, '#11'); + CheckFalse(High(Integer) in R, '#12'); + CheckFalse(Low(Integer) in R, '#13'); +end; + +procedure TestTIntegerRange.TestIsContiguousWith; +var + R, S: TIntegerRange; +begin + R := TIntegerRange.Create(4, 7); + S := TIntegerRange.Create(8, 12); + CheckTrue(R.IsContiguousWith(S), '#1a'); + CheckTrue(S.IsContiguousWith(R), '#1b'); + R := TIntegerRange.Create(4, 7); + S := TIntegerRange.Create(7, 12); + CheckFalse(R.IsContiguousWith(S), '#2a'); + CheckFalse(S.IsContiguousWith(R), '#2b'); + R := TIntegerRange.Create(1, 3); + S := TIntegerRange.Create(7, 12); + CheckFalse(R.IsContiguousWith(S), '#3a'); + CheckFalse(S.IsContiguousWith(R), '#3b'); + R := TIntegerRange.CreateEmpty; + S := TIntegerRange.Create(7, 12); + CheckFalse(R.IsContiguousWith(S), '#4a'); + CheckFalse(S.IsContiguousWith(R), '#4b'); + R := TIntegerRange.CreateEmpty; + S := TIntegerRange.CreateEmpty; + CheckFalse(R.IsContiguousWith(S), '#5a'); + CheckFalse(S.IsContiguousWith(R), '#5b'); + R := TIntegerRange.Create(0, 0); + S := TIntegerRange.Create(-1, -1); + CheckTrue(R.IsContiguousWith(S), '#6a'); + CheckTrue(S.IsContiguousWith(R), '#6b'); + R := TIntegerRange.Create(1, 3); + S := TIntegerRange.Create(-3, 5); + CheckFalse(R.IsContiguousWith(S), '#7a'); + CheckFalse(S.IsContiguousWith(R), '#7b'); +end; + +procedure TestTIntegerRange.TestIsContinuousWith; +var + R, S: TIntegerRange; +begin + R := TIntegerRange.Create(4, 7); + S := TIntegerRange.Create(8, 12); + CheckTrue(R.IsContinuousWith(S), '#1a'); + CheckTrue(S.IsContinuousWith(R), '#1b'); + R := TIntegerRange.Create(4, 7); + S := TIntegerRange.Create(7, 12); + CheckTrue(R.IsContinuousWith(S), '#2a'); + CheckTrue(S.IsContinuousWith(R), '#2b'); + R := TIntegerRange.Create(1, 3); + S := TIntegerRange.Create(7, 12); + CheckFalse(R.IsContinuousWith(S), '#3a'); + CheckFalse(S.IsContinuousWith(R), '#3b'); + R := TIntegerRange.CreateEmpty; + S := TIntegerRange.Create(7, 12); + CheckTrue(R.IsContinuousWith(S), '#4a'); + CheckTrue(S.IsContinuousWith(R), '#4b'); + R := TIntegerRange.CreateEmpty; + S := TIntegerRange.CreateEmpty; + CheckTrue(R.IsContinuousWith(S), '#5a'); + CheckTrue(S.IsContinuousWith(R), '#5b'); + R := TIntegerRange.Create(0, 0); + S := TIntegerRange.Create(-1, -1); + CheckTrue(R.IsContinuousWith(S), '#6a'); + CheckTrue(S.IsContinuousWith(R), '#6b'); + R := TIntegerRange.Create(1, 3); + S := TIntegerRange.Create(-3, 5); + CheckTrue(R.IsContinuousWith(S), '#7a'); + CheckTrue(S.IsContinuousWith(R), '#7b'); +end; + +procedure TestTIntegerRange.TestIsEmpty; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(0, 0); + CheckFalse(R.IsEmpty, '#1'); + R := TIntegerRange.Create(-3, 10); + CheckFalse(R.IsEmpty, '#2'); + R := TIntegerRange.Create(10, -42); + CheckFalse(R.IsEmpty, '#3'); + R := TIntegerRange.Create(10, 10); + CheckFalse(R.IsEmpty, '#4'); + R := TIntegerRange.CreateEmpty; + CheckTrue(R.IsEmpty, '#5'); +end; + +procedure TestTIntegerRange.TestLength; +var + R: TIntegerRange; +begin + R := TIntegerRange.Create(0, 0); + CheckEquals(1, R.Length, '#1'); + R := TIntegerRange.Create(-3, 10); + CheckEquals(14, R.Length, '#2'); + R := TIntegerRange.Create(10, -42); + CheckEquals(53, R.Length, '#3'); + R := TIntegerRange.Create(10, 10); + CheckEquals(1, R.Length, '#4'); + R := TIntegerRange.Create(12, 11); + CheckEquals(2, R.Length, '#5'); + R := TIntegerRange.CreateEmpty; + CheckEquals(0, R.Length, '#6'); + R := TIntegerRange.Create(-MaxInt, MaxInt); + CheckEquals(High(Cardinal), R.Length, '#7'); +end; + +procedure TestTIntegerRange.TestLessThanOrEqualOp; +var + L, R: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + CheckTrue(L <= R, '#1a'); + CheckTrue(R <= L, '#1b'); + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 1); + CheckTrue(L <= R, '#2a'); + CheckFalse(R <= L, '#2b'); + L := TIntegerRange.Create(-3, 12); + R := TIntegerRange.Create(-5, 18); + CheckTrue(L <= R, '#3a'); + CheckFalse(R <= L, '#3b'); + L := TIntegerRange.Create(-5, 17); + R := TIntegerRange.Create(-5, 18); + CheckTrue(L <= R, '#4a'); + CheckFalse(R <= L, '#4b'); + L := TIntegerRange.Create(-4, 18); + R := TIntegerRange.Create(-5, 18); + CheckTrue(L <= R, '#5a'); + CheckFalse(R <= L, '#5b'); + L := TIntegerRange.Create(-5, 18); + R := TIntegerRange.Create(-5, 18); + CheckTrue(L <= R, '#6a'); + CheckTrue(R <= L, '#6b'); + L := TIntegerRange.Create(-5, 2); + R := TIntegerRange.Create(4, 18); + CheckFalse(L <= R, '#7a'); + CheckFalse(R <= L, '#7b'); + L := TIntegerRange.Create(1, 1); + R := TIntegerRange.Create(4, 18); + CheckFalse(L <= R, '#8a'); + CheckFalse(R <= L, '#8b'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + CheckTrue(L <= R, '#9'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.CreateEmpty; + CheckFalse(L <= R, '#10a'); + CheckTrue(R <= L, '#10b'); +end; + +procedure TestTIntegerRange.TestMultiplyOp; +var + L, R, E: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + E := TIntegerRange.Create(0, 0); + CheckTrue(E = L * R, '#1a'); + CheckTrue(E = R * L, '#1b'); + L := TIntegerRange.Create(4, 4); + R := TIntegerRange.Create(4, 4); + E := TIntegerRange.Create(4, 4); + CheckTrue(E = L * R, '#2a'); + CheckTrue(E = R * L, '#2b'); + L := TIntegerRange.Create(3, 3); + R := TIntegerRange.Create(4, 4); + E := TIntegerRange.CreateEmpty; + CheckTrue(E = L * R, '#3a'); + CheckTrue(E = R * L, '#3b'); + L := TIntegerRange.Create(-9, 0); + R := TIntegerRange.Create(1, 9); + E := TIntegerRange.CreateEmpty; + CheckTrue(E = L * R, '#4a'); + CheckTrue(E = R * L, '#4b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(5, 12); + E := TIntegerRange.Create(5, 10); + CheckTrue(E = L * R, '#5a'); + CheckTrue(E = R * L, '#5b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(4, 4); + E := TIntegerRange.Create(4, 4); + CheckTrue(E = L * R, '#6a'); + CheckTrue(E = R * L, '#6b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(1, 9); + E := TIntegerRange.Create(1, 9); + CheckTrue(E = L * R, '#7a'); + CheckTrue(E = R * L, '#7b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(2, 10); + E := TIntegerRange.Create(2, 10); + CheckTrue(E = L * R, '#8a'); + CheckTrue(E = R * L, '#8b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(4, 6); + E := TIntegerRange.Create(4, 6); + CheckTrue(E = L * R, '#9a'); + CheckTrue(E = R * L, '#9b'); + L := TIntegerRange.Create(1, 10); + R := TIntegerRange.Create(1, 10); + E := TIntegerRange.Create(1, 10); + CheckTrue(E = L * R, '#10a'); + CheckTrue(E = R * L, '#10b'); + L := TIntegerRange.Create(0, 10); + R := TIntegerRange.Create(10, 20); + E := TIntegerRange.Create(10, 10); + CheckTrue(E = L * R, '#11a'); + CheckTrue(E = R * L, '#11b'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + E := TIntegerRange.CreateEmpty; + CheckTrue(E = L * R, '#12'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.Create(10, 20); + E := TIntegerRange.CreateEmpty; + CheckTrue(E = L * R, '#13a'); + CheckTrue(E = R * L, '#13b'); +end; + +procedure TestTIntegerRange.TestNotEqualOp; +var + L, R: TIntegerRange; +begin + L := TIntegerRange.Create(0, 0); + R := TIntegerRange.Create(0, 0); + CheckFalse(L <> R, '#1a'); + CheckFalse(R <> L, '#1b'); + L := TIntegerRange.Create(-3, 11); + R := TIntegerRange.Create(-3, 10); + CheckTrue(L <> R, '#2a'); + CheckTrue(R <> L, '#2b'); + L := TIntegerRange.Create(-43, 9); + R := TIntegerRange.Create(10, -42); + CheckTrue(L <> R, '#3a'); + CheckTrue(R <> L, '#3b'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.Create(10, 10); + CheckFalse(L <> R, '#4a'); + CheckFalse(R <> L, '#4b'); + CheckFalse(R <> R, '#5'); + L := TIntegerRange.CreateEmpty; + R := TIntegerRange.CreateEmpty; + CheckFalse(L <> R, '#6'); + L := TIntegerRange.Create(10, 10); + R := TIntegerRange.CreateEmpty; + CheckTrue(L <> R, '#6'); +end; + +procedure TestTIntegerRange.TestOverlapsWith; +var + A, B: TIntegerRange; +begin + A := TIntegerRange.Create(1, 4); + B := TIntegerRange.Create(3, 10); + CheckTrue(A.OverlapsWith(B), '#1a'); + CheckTrue(B.OverlapsWith(A), '#1b'); + A := TIntegerRange.Create(1, 4); + B := TIntegerRange.Create(4, 10); + CheckTrue(A.OverlapsWith(B), '#2a'); + CheckTrue(B.OverlapsWith(A), '#2b'); + A := TIntegerRange.CreateEmpty; + B := TIntegerRange.CreateEmpty; + CheckFalse(A.OverlapsWith(B), '#3'); + A := TIntegerRange.CreateEmpty; + B := TIntegerRange.Create(4, 10); + CheckFalse(A.OverlapsWith(B), '#4a'); + CheckFalse(B.OverlapsWith(A), '#4b'); + A := TIntegerRange.Create(-MaxInt, MaxInt); + B := TIntegerRange.Create(4, 10); + CheckTrue(A.OverlapsWith(B), '#5a'); + CheckTrue(B.OverlapsWith(A), '#5b'); + A := TIntegerRange.Create(1, 3); + B := TIntegerRange.Create(4, 10); + CheckFalse(A.OverlapsWith(B), '#6a'); + CheckFalse(B.OverlapsWith(A), '#6b'); + A := TIntegerRange.Create(-MaxInt, MaxInt); + B := TIntegerRange.Create(-MaxInt, MaxInt); + CheckTrue(A.OverlapsWith(B), '#7'); +end; + +initialization + + // Register any test cases with the test runner + RegisterTest(TestTIntegerRange.Suite); + RegisterTest(TestTRangeEx.Suite); + RegisterTest(TestTSizeEx.Suite); + RegisterTest(TestMiscStructsCatSnippets.Suite); + +end. diff --git a/tests/Cat-Structs/UStructCatSnippets.pas b/tests/Cat-Structs/UStructCatSnippets.pas new file mode 100644 index 0000000..2b21608 --- /dev/null +++ b/tests/Cat-Structs/UStructCatSnippets.pas @@ -0,0 +1,519 @@ +{ + * This unit was generated automatically. It incorporates a selection of source + * code taken from the Code Snippets Database at + * https://github.com/delphidabbler/code-snippets. + * + * The unit is copyright 2005-2025 by Peter Johnson & Contributors and is + * licensed under the MIT License (https://opensource.org/licenses/MIT). + * + * Generated on : Fri, 04 Apr 2025 08:38:43 GMT. + * Generated by : DelphiDabbler CodeSnip Release 4.24.0. + * + * The latest version of CodeSnip is available from the CodeSnip GitHub project + * at https://github.com/delphidabbler/codesnip. +} + +unit UStructCatSnippets; + +interface + +uses + Types, SysUtils, Math; + +{ + Encapsulates a point with double precision floating point coordinates. +} +type + TPointF = record + X, Y: Double; // x and y coordinates + end; + +{ + Encapsulates a rectangle with double precision floating point size and + position. +} +type + TRectF = record + case Integer of + 0: (Left, Top, Right, Bottom: Double); + 1: (TopLeft, BottomRight: TPointF); + end; + +{ + Encapsulates the upper and lower bounds of a range of values. +} +type + TRange = record + Lower: Integer; // lower bound of range + Upper: Integer; // upper bound of range + end; + +{ + An advanced record that encapsulates an integer range along with operations on + it. + The range is immutable, so the constructor must be used to instantiate a + non-empty range. +} +type + TIntegerRange = record + strict private + var + fLowerBound: Integer; + fUpperBound: Integer; + function GetLowerBound: Integer; + function GetUpperBound: Integer; + function IsSubrangeOf(const ARange: TIntegerRange): Boolean; + public + // Constructs a range whose bounds are A and B. The lowest of the two + // parameters is taken as the lower bound of the range with the other + // parameter taken as the upper bound. + // Valid bounds must fall in the range -MaxInt..MaxInt. An + // EArgumentException exception is raised otherwise. + constructor Create(const A, B: Integer); + + // Constructs an empty range. + class function CreateEmpty: TIntegerRange; static; + + // Checks if the range is empty. + function IsEmpty: Boolean; + + // Returns the length of the range, i.e. the number of integers in the range. + function Length: Cardinal; + + // Constrains AValue to fall within this range. If the value lies within the + // range it is returned unchanged. If it is outside the range then either + // LowerBound or UpperBound is returned, depending on whether the value + // falls below or above the range, respectively. + // An EInvalidOpException exception is raised if the range is empty. + function Constrain(const AValue: Integer): Integer; + + // Checks if this range overlaps with ARange, i.e. the interection of the + // ranges is non empty. Empty ranges cannot overlap with any range. + function OverlapsWith(const ARange: TIntegerRange): Boolean; + + // Checks if this range is immediately adjacent to ARange, with no overlap. + // Empty ranges are never contiguous with other ranges or themselves. + function IsContiguousWith(const ARange: TIntegerRange): Boolean; + + // Checks if the set of all values in this range and ARange form a + // continuous sequence. This implies that a range is continuous with itself. + // Since adding an empty range to a non-empty range doesn't change the + // non-empty range we define empty ranges to be continuous with any range. + function IsContinuousWith(const ARange: TIntegerRange): Boolean; + + // Checks if ranges A and B are the same + class operator Equal(const A, B: TIntegerRange): Boolean; + + // Checks if ranges A and B are not the same + class operator NotEqual(const A, B: TIntegerRange): Boolean; + + // Checks if range A is contained in, or is the same as, range B. + // An empty range is deemed to be contained in any other range. + class operator LessThanOrEqual(const A, B: TIntegerRange): Boolean; + + // Checks if range A is contains, or is the same as, range B. + // A non-empty range is never contained in an empty range. + class operator GreaterThanOrEqual(const A, B: TIntegerRange): Boolean; + + // Combine two ranges, A and B. The result is the smallest range that + // contains both A and B. + // If A and B are not continuous the resulting range will contain values + // that were not in either A or B. + // Combining any range either with itself or with an empty range is a no-op. + class operator Add(const A, B: TIntegerRange): TIntegerRange; + + // Returns a range that is the intersection of ranges A and B. + // Returns an empty range if A and B do not overlap. + class operator Multiply(const A, B: TIntegerRange): TIntegerRange; + + // Checks if integer AValue is contained within range ARange. + class operator In(const AValue: Integer; const ARange: TIntegerRange): + Boolean; + + // Implicitly casts ARange to a string. If ARange is non-empty the string + // has format [X..Y], where X and Y are the lower and upper bounds of + // ARange respectively. If ARange is empty then [] is returned. + // This means that ARange can be assigned directly to a string. + class operator Implicit(const ARange: TIntegerRange): string; + + // Explicitly casts ARange to a string. If ARange is non-empty the string + // has format [X..Y], where X and Y are the lower and upper bounds of + // ARange respectively. If ARange is empty then [] is returned. + // This means that ARange can be explicitly cast to a string using + // string(ARange). + class operator Explicit(const ARange: TIntegerRange): string; + + // The lower bound of a non-empty range. + // EInvalidOpException is raised if the property is read when the range is + // empty. + property LowerBound: Integer read GetLowerBound; + + // The upper bound of a non-empty range. + // EInvalidOpException is raised if the property is read when the range is + // empty. + property UpperBound: Integer read GetUpperBound; + end; + +{ + Encapsulates a range of integers with a methods to test whether a value falls + within the range and to adjust the value to fit. +} +type + TRangeEx = record + // Minimum and maximum bounds of range. + Min, Max: Integer; + // Constructs record with given minimum and maximum bounds. + constructor Create(AMin, AMax: Integer); + // Checks if the given value is contained within the range. + function Contains(const Value: Integer): Boolean; + // Adjusts the given value to lie within the range, and returns it. If the + // value is less than Min, Min is returned. If the value is greater than Max + // then max is returned. If the value is in the range it is returned + // unchanged. + function Constrain(const Value: Integer): Integer; + end; + +{ + Record that represents the size, i.e. the width and height, of something. + This is an extended version of the TSize record that features equality and + inequality operator overloading, a test for zero size and a constructor. + TSizeEx is assignment compatible and comparible with the Delphi RTL's TSize + record. +} +type + TSizeEx = record + public + // Width + CX: Integer; + // Height + CY: Integer; + // Constructs record with two given CX and CY field values + constructor Create(ACX, ACY: Integer); + // Enables TSize to be assigned to and compared with TSizeEx + class operator Implicit(S: Types.TSize): TSizeEx; + // Enables TSizeEx to be assigned to and compared with TSize + class operator Implicit(S: TSizeEx): Types.TSize; + // Tests for equality of TSizeEx records. Also works if one record is TSize. + class operator Equal(S1, S2: TSizeEx): Boolean; + // Tests for inequality of TSizeEx records. Also works if one record is + // TSize. + class operator NotEqual(S1, S2: TSizeEx): Boolean; + // Tests if a TSizeEx instance is zero (i.e. one of fields is zero) + function IsZero: Boolean; + end; + +{ + Constructs and returns a TRectF record with the given top-left coordinate, + width and height. +} +function BoundsF(ALeft, ATop, AWidth, AHeight: Double): TRectF; + +{ + Constructs and returns a TPointF record with the given x & y coordinates. +} +function PointF(const AX, AY: Double): TPointF; + +{ + Constructs and returns a TRange record with bounds A and B. + The smaller of A and B is used as the lower bound and the larger as the upper + bound. If both values are equal then the range will be empty. +} +function Range(const A, B: Integer): TRange; + +{ + Constructs and returns a TRectF record with the given left, top, right & + bottom coordinates. +} +function RectF(const ALeft, ATop, ARight, ABottom: Double): TRectF; + +{ + Constructs and returns a TSize record with the given dimensions. +} +function Size(const ACX, ACY: Integer): Types.TSize; + +implementation + +{ + Constructs and returns a TRectF record with the given top-left coordinate, + width and height. +} +function BoundsF(ALeft, ATop, AWidth, AHeight: Double): TRectF; +begin + Result.Left := ALeft; + Result.Top := ATop; + Result.Right := ALeft + AWidth; + Result.Bottom := ATop + AHeight; +end; + +{ + Constructs and returns a TPointF record with the given x & y coordinates. +} +function PointF(const AX, AY: Double): TPointF; +begin + Result.X := AX; + Result.Y := AY; +end; + +{ + Constructs and returns a TRange record with bounds A and B. + The smaller of A and B is used as the lower bound and the larger as the upper + bound. If both values are equal then the range will be empty. +} +function Range(const A, B: Integer): TRange; +begin + if A <= B then + begin + Result.Lower := A; + Result.Upper := B; + end + else + begin + Result.Lower := B; + Result.Upper := A; + end; +end; + +{ + Constructs and returns a TRectF record with the given left, top, right & + bottom coordinates. +} +function RectF(const ALeft, ATop, ARight, ABottom: Double): TRectF; +begin + Result.Left := ALeft; + Result.Top := ATop; + Result.Right := ARight; + Result.Bottom := ABottom; +end; + +{ + Constructs and returns a TSize record with the given dimensions. +} +function Size(const ACX, ACY: Integer): Types.TSize; +begin + Result.cx := ACX; + Result.cy := ACY; +end; + +class operator TIntegerRange.Add(const A, B: TIntegerRange): TIntegerRange; +begin + if A.IsEmpty then + Exit(B); + if B.IsEmpty then + Exit(A); + Result := TIntegerRange.Create( + Math.Min(A.fLowerBound, B.fLowerBound), + Math.Max(A.fUpperBound, B.fUpperBound) + ); +end; + +function TIntegerRange.Constrain(const AValue: Integer): Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.Constrain not valid for an empty range.' + ); + Result := Math.EnsureRange(AValue, fLowerBound, fUpperBound); +end; + +constructor TIntegerRange.Create(const A, B: Integer); +begin + // Normalise range so that smallest parameter is the lower bound + fLowerBound := Math.Min(A, B); + fUpperBound := Math.Max(A, B); + if fLowerBound = Low(Integer) then + // This restriction is required to prevent the Length method's Cardinal + // return value from wrapping around / overflowing + raise SysUtils.EArgumentException.CreateFmt( + 'TIntegerRange.Create: Arguments must be greater than %d', [Low(Integer)] + ); +end; + +class function TIntegerRange.CreateEmpty: TIntegerRange; +begin + Result.fLowerBound := High(Integer); + Result.fUpperBound := Low(Integer); +end; + +class operator TIntegerRange.Equal(const A, B: TIntegerRange): Boolean; +begin + if A.IsEmpty or B.IsEmpty then + Exit(A.IsEmpty and B.IsEmpty); + Result := (A.fLowerBound = B.fLowerBound) and (A.fUpperBound = B.fUpperBound); +end; + +class operator TIntegerRange.Explicit(const ARange: TIntegerRange): string; +begin + if ARange.IsEmpty then + Exit('[]'); + Result := SysUtils.Format( + '[%d..%d]', [ARange.fLowerBound, ARange.fUpperBound] + ); +end; + +function TIntegerRange.GetLowerBound: Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.LowerBound not valid for an empty range.' + ); + Result := fLowerBound; +end; + +function TIntegerRange.GetUpperBound: Integer; +begin + if IsEmpty then + raise Sysutils.EInvalidOpException.Create( + 'TIntegerRange.LowerBound not valid for an empty range.' + ); + Result := fUpperBound; +end; + +class operator TIntegerRange.GreaterThanOrEqual(const A, B: TIntegerRange): + Boolean; +begin + Result := B.IsSubrangeOf(A); +end; + +class operator TIntegerRange.Implicit(const ARange: TIntegerRange): string; +begin + Result := string(ARange); // calls Explicit cast operator +end; + +class operator TIntegerRange.In(const AValue: Integer; + const ARange: TIntegerRange): Boolean; +begin + if ARange.IsEmpty then + Exit(False); + Result := (AValue >= ARange.fLowerBound) and (AValue <= ARange.fUpperBound); +end; + +function TIntegerRange.IsContiguousWith(const ARange: TIntegerRange): Boolean; +begin + if Self.IsEmpty or ARange.IsEmpty then + Exit(False); + Result := (Self + ARange).Length = (Self.Length + ARange.Length); +end; + +function TIntegerRange.IsContinuousWith(const ARange: TIntegerRange): Boolean; +begin + if Self.IsEmpty or ARange.IsEmpty then + // Empty ranges are only continuous with other empty ranges + Exit(True); + Result := IsContiguousWith(ARange) or OverlapsWith(ARange); +end; + +function TIntegerRange.IsEmpty: Boolean; +begin + Result := fLowerBound > fUpperBound; +end; + +function TIntegerRange.IsSubrangeOf(const ARange: TIntegerRange): Boolean; +begin + if ARange.IsEmpty then + Exit(Self.IsEmpty); + Result := (Self.fLowerBound >= ARange.fLowerBound) + and (Self.fUpperBound <= ARange.fUpperBound) + or Self.IsEmpty +end; + +function TIntegerRange.Length: Cardinal; +begin + if IsEmpty then + Exit(0); + Result := fUpperBound - fLowerBound + 1 +end; + +class operator TIntegerRange.LessThanOrEqual(const A, B: TIntegerRange): + Boolean; +begin + Result := A.IsSubrangeOf(B); +end; + +class operator TIntegerRange.Multiply(const A, B: TIntegerRange): TIntegerRange; +var + Up, Lo: Integer; +begin + if A.IsEmpty or B.IsEmpty then + Exit(TIntegerRange.CreateEmpty); + Lo := Math.Max(A.fLowerBound, B.fLowerBound); + Up := Math.Min(A.fUpperBound, B.fUpperBound); + if Lo <= Up then + Result := TIntegerRange.Create(Lo, Up) + else + Result := TIntegerRange.CreateEmpty; +end; + +class operator TIntegerRange.NotEqual(const A, B: TIntegerRange): Boolean; +begin + if A.IsEmpty or B.IsEmpty then + Exit(A.IsEmpty <> B.IsEmpty); + Result := (A.fLowerBound <> B.fLowerBound) + or (A.fUpperBound <> B.fUpperBound); +end; + +function TIntegerRange.OverlapsWith(const ARange: TIntegerRange): Boolean; +begin + Result := not (Self * ARange).IsEmpty; +end; + +function TRangeEx.Constrain(const Value: Integer): Integer; +begin + if Value < Min then + Result := Min + else if Value > Max then + Result := Max + else + Result := Value; +end; + +function TRangeEx.Contains(const Value: Integer): Boolean; +begin + Result := Math.InRange(Value, Min, Max); +end; + +constructor TRangeEx.Create(AMin, AMax: Integer); +begin + Min := AMin; + Max := AMax; +end; + +constructor TSizeEx.Create(ACX, ACY: Integer); +begin + CX := ACX; + CY := ACY; +end; + +class operator TSizeEx.Equal(S1, S2: TSizeEx): Boolean; +begin + // zero records are special: can be zero when only one of CX or CY is zero + if S1.IsZero and S2.IsZero then + begin + Result := True; + Exit; + end; + Result := (S1.CX = S1.CX) and (S1.CY = S2.CY); +end; + +class operator TSizeEx.Implicit(S: Types.TSize): TSizeEx; +begin + Result.CX := S.cx; + Result.CY := S.cy; +end; + +class operator TSizeEx.Implicit(S: TSizeEx): Types.TSize; +begin + Result.cx := S.CX; + Result.cy := S.CY; +end; + +function TSizeEx.IsZero: Boolean; +begin + Result := (CX = 0) or (CY = 0); +end; + +class operator TSizeEx.NotEqual(S1, S2: TSizeEx): Boolean; +begin + Result := not (S1 = S2); +end; + +end. diff --git a/tests/CodeSnippetsTestsXE.groupproj b/tests/CodeSnippetsTestsXE.groupproj index 5c76171..86d2da7 100644 --- a/tests/CodeSnippetsTestsXE.groupproj +++ b/tests/CodeSnippetsTestsXE.groupproj @@ -24,6 +24,9 @@ + + + Default.Personality.12 @@ -95,14 +98,23 @@ + + + + + + + + + - + - + - + diff --git a/tests/README.md b/tests/README.md index ee26a9e..203d090 100644 --- a/tests/README.md +++ b/tests/README.md @@ -2,6 +2,8 @@ This project provides tests and demos of snippets from the [DelphiDabbler Code Snippets Database](https://github.com/delphidabbler/code-snippets). +> ⚠️ Recent changes have only been compiled and tested with Delphi XE and later. While project files for earlier versions of Delphi remain available it is not guaranteed that any of the projects will compile with versions of Delphi prior to Delphi XE. + ## Directory Structure The project has the following directories: @@ -15,7 +17,7 @@ Contains: ### `./Cat-Arrays` -Contains the _TestArraysCat_[^2] project that provides _DUnit_ tests for snippets from the database's _Arrays_ category. Currently tests are only available for the _TArrayUtils_ advanced record. +Contains the _TestArraysCat_[^2] project that provides _DUnit_ tests for all the snippets in the database's _Arrays_ category. ### `./Cat-Date` @@ -27,7 +29,7 @@ Contains the _TestDriveCat_[^2] project that implements a GUI application that e ### `./Cat-Hex` -Contains the _TestHexCat_[^2] project that provides _DUnit_ tests for all the snippets from the database's _Hex Utilities_ category. +Contains the _TestHexCat_[^2] project that provides _DUnit_ tests for all the snippets in the database's _Hex Utilities_ category. ### `./Cat-Maths` @@ -37,9 +39,13 @@ Contains the _TestCatMaths_[^2] project that provides _DUnit_ tests for selected Contains the _TestCatString_[^2] project that provides _DUnit_ tests for selected snippets from the database's _String Management_ category. +### `./Cat-Structs` + +Contains the _TestCatStructsXE_[^3] project that provides _DUnit_ tests for all snippets in the database's _Structures_ category. + ### `./Cat-WinSys` -Contains the _TextWinSysCat_[^2] project that provides a GUI application that exercises and demonstrates all the code from the database's _Windows System_ category. +Contains the _TestWinSysCat_[^2] project that provides a GUI application that exercises and demonstrates all the code from the database's _Windows System_ category. ### History @@ -47,6 +53,8 @@ These test files originated as a [zip file on Google Drive](https://drive.google All subsequent changes to the files were made on GitHub. At present the GitHub repository differs from the original code on Google Drive. -[^1]: There are different versions of the group project file for different Delphi versions: `CodeSnippetsTestsbdsgroup` for Delphi 2006, `CodeSnippetsTests.groupproj` for Delphi 2007-2010 and `CodeSnippetsTestsXE.groupproj` for Delphi XE. +[^1]: There are different versions of the group project file for different Delphi versions: `CodeSnippetsTests.bdsgroup` for Delphi 2006, `CodeSnippetsTests.groupproj` for Delphi 2007-2010 and `CodeSnippetsTestsXE.groupproj` for Delphi XE. + +[^2]: There are different versions of project files for different Delphi versions. They are one or more of `.bdsproj` for Delphi 2006, `.dproj` for Delphi 2007 to 2010 and `XE.dproj` for Delphi XE, where `` is the base name of the project, for example `TestDateCat` or `TestCatMaths`. There are also different `.dpr` files: `.dpr` for compilers earlier than Delphi XE and `XE.dpr` for Delphi XE. -[^2]: There are different versions of project files for different Delphi versions. They are one or more of `.bdsproj` for Delphi 2006, `.dproj` for Delphi 2007 to 2010 and `XE.dproj` for Delphi XE, where `` is the base name of the project, for example `TestDateCat` or `TestCatMaths`. +[^3]: There is only one project file for the _Structures_ category tests, `TesttCatStructsXE.dpr`, which is targetted at Delphi XE. There is no test project targetted at earlier compilers. This project is only included in the `CodeSnippetsTestsXE.groupproj` group and no others. pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy