* Added tests for various strutils functions by Karl-Michael Schindler (bug ID 25756)

git-svn-id: trunk@26833 -

.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

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.

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.

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.

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.

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.

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.

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.