diff --git a/.gitattributes b/.gitattributes index 86387dbaed..6e53766227 100644 --- a/.gitattributes +++ b/.gitattributes @@ -12268,7 +12268,14 @@ tests/test/units/sharemem/test1.pp svneol=native#text/plain tests/test/units/softfpu/sfttst.pp svneol=native#text/plain tests/test/units/strings/tstrcopy.pp svneol=native#text/plain tests/test/units/strings/tstrings1.pp svneol=native#text/plain +tests/test/units/strutils/taddchar.pp svneol=native#text/plain +tests/test/units/strutils/taddcharr.pp svneol=native#text/plain +tests/test/units/strutils/tbintohex.pp svneol=native#text/plain +tests/test/units/strutils/thextobin.pp svneol=native#text/plain tests/test/units/strutils/tiswild.pp svneol=native#text/plain +tests/test/units/strutils/tpadcenter.pp svneol=native#text/plain +tests/test/units/strutils/tpadleft.pp svneol=native#text/plain +tests/test/units/strutils/tpadright.pp svneol=native#text/plain tests/test/units/strutils/tposextest.pp svneol=native#text/plain tests/test/units/system/interlocked1.pp svneol=native#text/plain tests/test/units/system/tabs.pp svneol=native#text/plain diff --git a/tests/test/units/strutils/taddchar.pp b/tests/test/units/strutils/taddchar.pp new file mode 100644 index 0000000000..6f45367bdf --- /dev/null +++ b/tests/test/units/strutils/taddchar.pp @@ -0,0 +1,41 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + StrUtils; + +var + exitCode: integer = 0; + +procedure addCharTest(c: char; + const s: ansistring; + n: integer; + const expectation: ansistring; + const testnr: integer); + + begin + if AddChar(c, s, n) <> expectation then + begin + writeln('Testing strUtils/AddChar: Test ', testnr, + ' with N = ', n, ' failed.'); + exitCode := 1; + end; + end; + +var + i, j: integer; + testString: ansistring; + +begin + for i := 1 to 1024 do + begin + testString := 'abcd'; + for j := 1 to i - 4 do + testString := 'A' + testString; + addCharTest('A', 'abcd', i, testString, i); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/taddcharr.pp b/tests/test/units/strutils/taddcharr.pp new file mode 100644 index 0000000000..df523a663a --- /dev/null +++ b/tests/test/units/strutils/taddcharr.pp @@ -0,0 +1,41 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + StrUtils; + +var + exitCode: integer = 0; + +procedure addCharRTest(c: char; + const s: ansistring; + n: integer; + const expectation: ansistring; + const testnr: integer); + + begin + if AddCharR(c, s, n) <> expectation then + begin + writeln('Testing strUtils/AddCharR: Test ', testnr, + ' with N = ', n, ' failed.'); + exitCode := 1; + end; + end; + +var + i, j: integer; + testString: ansistring; + +begin + for i := 1 to 1024 do + begin + testString := 'abcd'; + for j := 1 to i - 4 do + testString := testString + 'A'; + addCharRTest('A', 'abcd', i, testString, i); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/tbintohex.pp b/tests/test/units/strutils/tbintohex.pp new file mode 100644 index 0000000000..90ea700791 --- /dev/null +++ b/tests/test/units/strutils/tbintohex.pp @@ -0,0 +1,80 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + Strings, + StrUtils; + +var + exitCode: integer = 0; + +Function Memblock(Size : Integer) : PChar; + +begin + Result:=getmem(Size); + fillchar(Result^,Size,0); +end; + +procedure BinToHexTest(const binValue: Pchar; + const binBufSize: integer; + const expectation: Pchar; + const testnr: integer); + var + hexValue: Pchar; + begin + hexValue := memblock(2*binBufSize + 1); + BinToHex(binValue, hexValue, binBufSize); + if strcomp(hexValue, expectation) <> 0 then + begin + writeln('Testing strUtils/BinToHex: Test ', testnr, ' failed.'); + writeln('Returned String: ', hexValue); + writeln('Expected String: ', expectation); + exitCode := 1; + end; + FreeMem(hexValue); + end; + +const + maxLen = 512; + codes: array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); + +var + i, j, binBufSize, value: integer; + testbin: Pchar; + testhex: Pchar; + +begin + binBufSize := 1; + testbin := memblock(binBufSize + 1); + testhex := memblock(2*binBufSize + 1); + for i := 0 to 255 do + begin + testbin[0] := char(i); + testhex[0] := codes[i div 16]; + testhex[1] := codes[i mod 16]; + BinToHexTest(testbin, binBufSize, testhex, 1 + i); + end; + FreeMem(TestBin); + FreeMem(TestHex); + randomize; + for i := 1 to 1000 do + begin + binBufSize := 1 + random(maxLen); + testbin := memblock(binBufSize + 1); + testhex := memblock(2*binBufSize + 1); + for j := 0 to binBufSize - 1 do + begin + value := random(256); + testbin[j] := char(value); + testhex[2*j] := codes[value div 16]; + testhex[2*j + 1] := codes[value mod 16]; + end; + BinToHexTest(testbin, binBufSize, testhex, 255 + i); + FreeMem(TestBin); + FreeMem(TestHex); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/thextobin.pp b/tests/test/units/strutils/thextobin.pp new file mode 100644 index 0000000000..bf1a84fa00 --- /dev/null +++ b/tests/test/units/strutils/thextobin.pp @@ -0,0 +1,89 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + SysUtils, + StrUtils; + +var + exitCode: integer = 0; + +Function Memblock(Size : Integer) : PChar; + +begin + Result:=getmem(Size); + fillchar(Result^,Size,0); +end; + + +procedure HexToBinTest(const hexValue: Pchar; + const binBufSize: integer; + const expectation: Pchar; + const testnr: integer); + var + binValue: Pchar; + l : Integer; + begin + L:=(binBufSize - 1 ) div 2 + 1; + binValue := memblock(L); + HexToBin(hexValue, binValue,L-1); + if strcomp(binValue, expectation) <> 0 then + begin + writeln('Testing strUtils/HexToBin: Test ', testnr, ' failed.'); + writeln(binBufSize); + writeln(strlen(hexValue)); + writeln(strlen(expectation)); + writeln(strlen(binValue)); + write('Hex Input: ', hexValue); + writeln('Returned list: ', byte(binValue[0])); + writeln('Expected list: ', byte(expectation[0])); + exitCode := 1; + end; + FreeMem(binvalue); + end; + +const + maxLen = 512; + codes: array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'); + +var + i, j, binBufSize, value: integer; + testbin: Pchar; + testhex: Pchar; + +begin + binBufSize := 3; + testhex := memblock(binBufSize); + testbin := memblock(2); + for i := 0 to 17 do + begin + testbin[0] := char(i); + testhex[0] := codes[i div 16]; + testhex[1] := codes[i mod 16]; + HexToBinTest(testhex, binbufsize, testbin, 1 + i); + end; + FreeMem(testbin); + FreeMem(testhex); + randomize; + for i := 1 to 1000 do + begin + binBufSize := 1 + random(maxLen); + binBufSize := binBufSize * 2; + testbin := memblock(binBufSize + 1); + testhex := memblock(binBufSize * 2 + 1); + for j := 0 to binBufSize - 1 do + begin + value := random(256); + testbin[j] := char(value); + testhex[2*j] := codes[value div 16]; + testhex[2*j + 1] := codes[value mod 16]; + end; + HexToBinTest(testhex, binBufSize * 2 + 1, testbin, 255 + i); + FreeMem(testbin); + FreeMem(testhex); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/tpadcenter.pp b/tests/test/units/strutils/tpadcenter.pp new file mode 100644 index 0000000000..6c3ada4c76 --- /dev/null +++ b/tests/test/units/strutils/tpadcenter.pp @@ -0,0 +1,43 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + StrUtils; + +var + exitCode: integer = 0; + +procedure padCenterTest(const s: ansistring; + n: integer; + const expectation: ansistring; + const testnr: integer); + + begin + if padCenter(s, n) <> expectation then + begin + writeln('Testing strUtils/PadCenter: Test ', testnr, + ' with N = ', n, ' failed.'); + exitCode := 1; + end; + end; + +var + i, j: integer; + testString: ansistring; + +begin + for i := 1 to 1024 do + begin + testString := 'abcd'; + for j := 1 to i - 4 do + if odd(j) then + testString := testString + ' ' + else + testString := ' ' + testString; + padCenterTest('abcd', i, testString, i); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/tpadleft.pp b/tests/test/units/strutils/tpadleft.pp new file mode 100644 index 0000000000..16abdfb1f4 --- /dev/null +++ b/tests/test/units/strutils/tpadleft.pp @@ -0,0 +1,40 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + StrUtils; + +var + exitCode: integer = 0; + +procedure padLeftTest(const s: ansistring; + n: integer; + const expectation: ansistring; + const testnr: integer); + + begin + if padLeft(s, n) <> expectation then + begin + writeln('Testing strUtils/PadLeft: Test ', testnr, + ' with N = ', n, ' failed.'); + exitCode := 1; + end; + end; + +var + i, j: integer; + testString: ansistring; + +begin + for i := 1 to 1024 do + begin + testString := 'abcd'; + for j := 1 to i - 4 do + testString := ' ' + testString; + padLeftTest('abcd', i, testString, i); + end; + + halt(exitCode); +end. diff --git a/tests/test/units/strutils/tpadright.pp b/tests/test/units/strutils/tpadright.pp new file mode 100644 index 0000000000..ac55c8131e --- /dev/null +++ b/tests/test/units/strutils/tpadright.pp @@ -0,0 +1,40 @@ +{$mode objfpc} +{$h+} +{$hints on} +{$warnings on} + +uses + StrUtils; + +var + exitCode: integer = 0; + +procedure padRightTest(const s: ansistring; + n: integer; + const expectation: ansistring; + const testnr: integer); + + begin + if padRight(s, n) <> expectation then + begin + writeln('Testing strUtils/PadRight: Test ', testnr, + ' with N = ', n, ' failed.'); + exitCode := 1; + end; + end; + +var + i, j: integer; + testString: ansistring; + +begin + for i := 1 to 1024 do + begin + testString := 'abcd'; + for j := 1 to i - 4 do + testString := testString + ' '; + padRightTest('abcd', i, testString, i); + end; + + halt(exitCode); +end.