* Additional tests from Karl-Michael Schindler

git-svn-id: trunk@35521 -

.gitattributes

@@ -13378,12 +13378,18 @@ 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/tdec2numb.pp svneol=native#text/plain
+tests/test/units/strutils/thex2dec.pp svneol=native#text/plain
 tests/test/units/strutils/thextobin.pp svneol=native#text/plain
+tests/test/units/strutils/tinttobin.pp svneol=native#text/plain
+tests/test/units/strutils/tinttoroman.pp svneol=native#text/plain
 tests/test/units/strutils/tiswild.pp svneol=native#text/plain
+tests/test/units/strutils/tnumb2usa.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/strutils/tromantoint.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/system/talign.pp svneol=native#text/plain

tests/test/units/strutils/tdec2numb.pp

@@ -0,0 +1,91 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  StrUtils;
+
+type
+  Tbase = 2..36;
+
+var
+  exitCode: integer = 0;
+
+procedure Dec2NumbTest(const number: integer;
+                       const strlen: byte;
+                       const base:   Tbase;
+                       const expect: string;
+                       const testnr: integer);
+  var
+    actual: string;
+  begin
+    actual := Dec2Numb(number, strlen, base);
+    if actual <> expect then
+    begin
+      writeln('Testing strUtils/Dec2Numb: Test ', testnr, ' failed.');
+      writeln('Number: ', number, ', base: ', base);
+      writeln('Returned String: ', actual);
+      writeln('Expected String: ', expect);
+      exitCode := 1;
+    end;
+  end;
+
+const
+  codes: array[0..35] of char = ('0','1','2','3','4','5','6','7','8','9',
+                                 'A','B','C','D','E','F','G','H','I','J',
+                                 'K','L','M','N','O','P','Q','R','S','T',
+                                 'U','V','W','X','Y','Z'
+                                );
+
+var
+  number: integer;
+  strlen: byte;
+  base: Tbase;
+  teststring: string;
+  i, j, k, pos: integer;
+
+begin
+  i := 1;
+  strlen := 10;
+  for number := 0 to 1000 do
+    for base := low(Tbase) to high(Tbase) do
+    begin
+      inc(i);
+      teststring := '0000000000';
+      pos := strlen;
+      j := number;
+      while j >= base do
+      begin
+        teststring[pos] := codes[j mod base];
+        dec(pos);
+        j := j div base;
+      end;
+      teststring[pos] := codes[j mod base];
+      Dec2NumbTest(number, strlen, base, teststring, i);
+    end;
+
+  randomize;
+  strlen := 20;
+  for k := 0 to 1000 do
+  begin
+    number := random(512*1024);
+    for base := low(Tbase) to high(Tbase) do
+    begin
+      inc(i);
+      teststring := '00000000000000000000';
+      pos := strlen;
+      j := number;
+      while j >= base do
+      begin
+        teststring[pos] := codes[j mod base];
+        dec(pos);
+        j := j div base;
+      end;
+      teststring[pos] := codes[j mod base];
+      Dec2NumbTest(number, strlen, base, teststring, i);
+    end;
+  end;
+
+  halt(exitCode);
+end.

tests/test/units/strutils/thex2dec.pp

@@ -0,0 +1,73 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  StrUtils;
+
+var
+  exitCode: integer = 0;
+
+procedure Hex2DecTest(const testhex: string;
+                      const testdec: integer;
+                      const testnr: integer);
+  var
+    tempdec: integer;
+  begin
+    tempdec := Hex2Dec(testhex);
+    if tempdec <> testdec then
+    begin
+      writeln('Testing strUtils/Hex2Dec: Test ', testnr, ' with string ', testhex, ' failed.');
+      writeln('Returned number: ', tempdec);
+      writeln('Expected number: ', testdec);
+      exitCode := 1;
+    end;
+  end;
+
+const
+{$IF DECLARED(longint)}
+  maxLen = 8;  { The maximum number of hex digits for longint (32 bit) }
+{$ELSE}
+  maxLen = 4;  { The maximum number of hex digits for smallint (16 bit) }
+{$IFEND}
+  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, length, digit: integer;
+  testdec: integer;
+  testhex: string;
+
+begin
+  for i := 0 to 15 do
+  begin
+    testhex := codes[i];
+    testdec := i;
+    Hex2DecTest(testhex, testdec, 1 + i);
+    Hex2DecTest('$' + testhex, testdec, 1 + i);
+  end;
+
+  randomize;
+  for i := 1 to 1000 do
+  begin
+    length := 2 + random(maxLen - 1);
+    setlength(testhex, length);
+    if length = maxLen then
+      digit := random(8)  { The high byte can only go up to 7, because of ths sign bit }
+    else
+      digit := random(16);
+    testhex[1] := codes[digit];
+    testdec := digit;
+    for j := 2 to length do
+    begin
+      digit := random(16);
+      testhex[j] := codes[digit];
+      testdec := testdec * 16 + digit;
+    end;
+
+    Hex2DecTest(testhex, testdec, 16 + i);
+    Hex2DecTest('$' + testhex, testdec, 16 + i);
+  end;
+
+  halt(exitCode);
+end.

tests/test/units/strutils/tinttobin.pp

@@ -0,0 +1,98 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  StrUtils;
+
+var
+  exitCode: integer = 0;
+
+procedure IntToBinTest(const testinteger: integer;
+                       const digits: integer;
+                       const expectation: string;
+                       const testnr: integer);
+  var
+    teststring: string;
+  begin
+    teststring := IntToBin(testinteger, digits);
+    if teststring <> expectation then
+    begin
+      writeln('Testing strUtils/IntToBin: Test ', testnr, ' failed with number ', testinteger);
+      writeln('Returned String: ', teststring);
+      writeln('Expected String: ', expectation);
+      exitCode := 1;
+    end;
+  end;
+  
+const
+  codes: array[0..1] of char = ('0','1');
+
+var
+  i, j, value: integer;
+  testinteger: integer;
+  teststring: string;
+  digits: integer;
+
+begin
+  digits := 32;
+  setlength(teststring, digits);
+
+  for testinteger := 0 to $7FFF do
+  begin
+    value := testinteger;
+    for j :=  digits downto 1 do
+    begin
+      teststring[j] := codes[value mod 2];
+      value := value div 2;
+    end;
+    IntToBinTest(testinteger, digits, teststring, 1 + testinteger);
+  end;
+
+  for testinteger := -$8000 to -$1 do
+  begin
+    value := -testinteger - 1; { prepare for 2's complement -1 }
+    teststring[1] := '1';      { sign bit }
+    teststring[digits] := codes[1 - (value mod 2)]; { inversion of 0 and 1}
+    value := value div 2;
+    for j :=  digits - 1 downto 2 do
+    begin
+      teststring[j] := codes[-(value mod 2) + 1];
+      value := value div 2;
+    end;
+    IntToBinTest(testinteger, digits, teststring, $10000 + testinteger);
+  end;
+
+{$IF DECLARED(longint)}
+  randomize;
+  for i := 1 to 1000 do
+  begin
+    testinteger := $7FFF + random($80000000 - $7FFF);
+    value := testinteger;
+    for j :=  digits downto 1 do
+    begin
+      teststring[j] := codes[value mod 2];
+      value := value div 2;
+    end;
+    IntToBinTest(testinteger, digits, teststring, $10000 + i);
+  end;
+
+  for i := 1 to 1000 do
+  begin
+    testinteger := -$8000 - random($80000000 - $8000);
+    value := -testinteger - 1; { prepare for 2's complement -1 }
+    teststring[1] := '1';      { sign bit }
+    teststring[digits] := codes[1 - (value mod 2)]; { inversion of 0 and 1}
+    value := value div 2;
+    for j :=  digits - 1 downto 2 do
+    begin
+      teststring[j] := codes[-(value mod 2) + 1];
+      value := value div 2;
+    end;
+    IntToBinTest(testinteger, digits, teststring, $10000 + 1000 + i);
+  end;
+{$IFEND}
+
+  halt(exitCode);
+end.

tests/test/units/strutils/tinttoroman.pp

@@ -0,0 +1,135 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  StrUtils;
+
+var
+  exitCode: integer = 0;
+
+procedure IntToRomanTest(const testinteger: integer;
+                         const expectation: string);
+  var
+    teststring: string;
+  begin
+    teststring := IntToRoman(testinteger);
+    if teststring <> expectation then
+    begin
+      writeln('Testing strUtils/IntToRoman: Test failed with number ', testinteger);
+      writeln('Returned String: ', teststring);
+      writeln('Expected String: ', expectation);
+      exitCode := 1;
+    end;
+  end;
+  
+var
+  i, value, digit, safedValue: integer;
+  testinteger: integer;
+  teststring: string;
+
+begin
+
+  for testinteger := 1 to 2000 do
+  begin
+    value := testinteger;
+    digit := value mod 10;
+    case digit of
+      0: teststring := '';
+      1: teststring := 'I';
+      2: teststring := 'II';
+      3: teststring := 'III';
+      4: teststring := 'IV';
+      5: teststring := 'V';
+      6: teststring := 'VI';
+      7: teststring := 'VII';
+      8: teststring := 'VIII';
+      9: teststring := 'IX';
+    end;
+    value := value div 10;
+    digit := value mod 10;
+    case digit of
+      1: teststring := 'X' + teststring;
+      2: teststring := 'XX' + teststring;
+      3: teststring := 'XXX' + teststring;
+      4: teststring := 'XL' + teststring;
+      5: teststring := 'L' + teststring;
+      6: teststring := 'LX' + teststring;
+      7: teststring := 'LXX' + teststring;
+      8: teststring := 'LXXX' + teststring;
+      9: teststring := 'XC' + teststring;
+    end;
+    value := value div 10;
+    digit := value mod 10;
+    case digit of
+      1: teststring := 'C' + teststring;
+      2: teststring := 'CC' + teststring;
+      3: teststring := 'CCC' + teststring;
+      4: teststring := 'CD' + teststring;
+      5: teststring := 'D' + teststring;
+      6: teststring := 'DC' + teststring;
+      7: teststring := 'DCC' + teststring;
+      8: teststring := 'DCCC' + teststring;
+      9: teststring := 'CM' + teststring;
+    end;
+    value := value div 10;
+    for i := 1 to value do
+      teststring := 'M' + teststring;
+    
+    IntToRomanTest(testinteger, teststring);
+  end;
+
+  randomize;
+  for testinteger := 1 to 1000 do
+  begin
+    value := random(100000);
+    safedValue := value;
+    digit := value mod 10;
+    case digit of
+      0: teststring := '';
+      1: teststring := 'I';
+      2: teststring := 'II';
+      3: teststring := 'III';
+      4: teststring := 'IV';
+      5: teststring := 'V';
+      6: teststring := 'VI';
+      7: teststring := 'VII';
+      8: teststring := 'VIII';
+      9: teststring := 'IX';
+    end;
+    value := value div 10;
+    digit := value mod 10;
+    case digit of
+      1: teststring := 'X' + teststring;
+      2: teststring := 'XX' + teststring;
+      3: teststring := 'XXX' + teststring;
+      4: teststring := 'XL' + teststring;
+      5: teststring := 'L' + teststring;
+      6: teststring := 'LX' + teststring;
+      7: teststring := 'LXX' + teststring;
+      8: teststring := 'LXXX' + teststring;
+      9: teststring := 'XC' + teststring;
+    end;
+    value := value div 10;
+    digit := value mod 10;
+    case digit of
+      1: teststring := 'C' + teststring;
+      2: teststring := 'CC' + teststring;
+      3: teststring := 'CCC' + teststring;
+      4: teststring := 'CD' + teststring;
+      5: teststring := 'D' + teststring;
+      6: teststring := 'DC' + teststring;
+      7: teststring := 'DCC' + teststring;
+      8: teststring := 'DCCC' + teststring;
+      9: teststring := 'CM' + teststring;
+    end;
+    value := value div 10;
+    for i := 1 to value do
+      teststring := 'M' + teststring;
+    
+    IntToRomanTest(safedValue, teststring);
+  end;
+
+  halt(exitCode);
+end.

tests/test/units/strutils/tnumb2usa.pp

@@ -0,0 +1,81 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  SysUtils,
+  StrUtils;
+
+var
+  exitCode: integer = 0;
+
+procedure Numb2USATest(const teststring: string;
+                       const expectation: string);
+  var
+    usastring: string;
+  begin
+    usastring := Numb2USA(teststring);
+    if usastring <> expectation then
+    begin
+      writeln('Testing strUtils/Numb2USA: Test with ', teststring, ' failed.');
+      writeln('Returned String: ', usastring);
+      writeln('Expected String: ', expectation);
+      exitCode := 1;
+    end;
+  end; 
+
+var
+  i, j, len, value, pos, posusa, numberOfCommas, preDigits: integer;
+  teststring: string;
+  usastring: string;
+
+begin
+  randomize;
+  for i := 0 to 1000 do
+  begin
+    value := trunc(exp(random(trunc(ln(MaxInt)))));
+    teststring := intToStr(value);
+    len := length(teststring);
+    if len <= 3 then
+      usastring := teststring
+    else
+    begin
+      numberOfCommas := (len - 1) div 3;
+      setlength(usastring, len + numberOfCommas);
+      preDigits := (len - 1) mod 3 + 1; { gives 1, 2 or 3 }
+      for j := 1 to preDigits do
+        usastring[j] := teststring[j];
+      pos := preDigits + 1;
+      posusa := preDigits + 1;
+      usastring[posusa] := ',';
+      inc(posusa);
+      if numberOfCommas > 1 then
+        for j := 1 to numberOfCommas - 1 do
+        begin
+          usastring[posusa] := teststring[pos];
+          inc(pos);
+          inc(posusa);
+          usastring[posusa] := teststring[pos];
+          inc(pos);
+          inc(posusa);
+          usastring[posusa] := teststring[pos];
+          inc(posusa);
+          usastring[posusa] := ',';
+          inc(pos);
+          inc(posusa);
+        end;
+      usastring[posusa] := teststring[pos];
+      inc(pos);
+      inc(posusa);
+      usastring[posusa] := teststring[pos];
+      inc(pos);
+      inc(posusa);
+      usastring[posusa] := teststring[pos];
+    end;
+
+    Numb2USATest(teststring, usastring);
+  end;
+ 
+  halt(exitCode);
+end.

tests/test/units/strutils/tromantoint.pp

@@ -0,0 +1,49 @@
+{$mode objfpc}
+{$h+}
+{$hints on}
+{$warnings on}
+
+uses
+  StrUtils;
+
+var
+  exitCode: integer = 0;
+
+procedure RomanToIntTest(const testRoman: string;
+                         const expectation: integer);
+  var
+    test: integer;
+  begin
+    test := RomanToInt(testRoman);
+    if test <> expectation then
+    begin
+      writeln('Testing strUtils/RomanToInt: Test with ', testRoman, ' failed.');
+      writeln('Returned number: ', test);
+      writeln('Expected number: ', expectation);
+      exitCode := 1;
+    end;
+  end; 
+
+var
+  i: integer;
+  testRoman: string;
+  testInteger: integer;
+
+begin
+  for i := 1 to 2000 do
+  begin
+    testInteger := i;
+    testRoman := intToRoman(testInteger);
+    RomanToIntTest(testRoman, testInteger);
+  end;
+
+  randomize;
+  for i := 1 to 1000 do
+  begin
+    testInteger := random(1000000);
+    testRoman := intToRoman(testInteger);
+    RomanToIntTest(testRoman, testInteger);
+  end;
+ 
+  halt(exitCode);
+end.