View Issue Details

IDProjectCategoryView StatusLast Update
0025842FPCCompilerpublic2017-03-05 14:32
ReporterKarl-Michael SchindlerAssigned ToMichael Van Canneyt 
PrioritynormalSeverityminorReproducibilityalways
Status closedResolutionfixed 
Platformpowerpc, i386, x86_64OSMac OS XOS Version10.4-10.6
Product Version2.6.3Product Buildtrunk 
Target Version3.2.0Fixed in Version3.1.1 
Summary0025842: Test programs for the StrUtils unit part II
DescriptionThe following programs are tests for the StrUtils unit. I tested them with 2.6.2 and 2.7.1. They should go into the directory fpc/tests/test/units/strutils
TagsNo tags attached.
Fixed in Revision35521
FPCOldBugId
FPCTarget
Attached Files
  • tdec2numb.pp (2,113 bytes)
    {$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.
    
    tdec2numb.pp (2,113 bytes)
  • thex2dec.pp (1,708 bytes)
    {$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.
    
    thex2dec.pp (1,708 bytes)
  • tinttobin.pp (2,483 bytes)
    {$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.
    
    tinttobin.pp (2,483 bytes)
  • tinttoroman.pp (3,683 bytes)
    {$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.
    
    tinttoroman.pp (3,683 bytes)
  • tnumb2usa.pp (1,957 bytes)
    {$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.
    
    tnumb2usa.pp (1,957 bytes)
  • tromantoint.pp (1,041 bytes)
    {$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 := 0 to 2000 do
      begin
        testInteger := i;
        testRoman := intToRoman(testInteger);
        RomanToIntTest(testRoman, testInteger);
        RomanToIntTest('-' + testRoman, -testInteger);
      end;
    
      randomize;
      for i := 0 to 1000 do
      begin
        testInteger := random(1000000);
        testRoman := intToRoman(testInteger);
        RomanToIntTest(testRoman, testInteger);
        RomanToIntTest('-' + testRoman, -testInteger);
      end;
     
      halt(exitCode);
    end.
    
    tromantoint.pp (1,041 bytes)
  • tromantoint2.pp (939 bytes)
    {$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.
    
    tromantoint2.pp (939 bytes)

Activities

Karl-Michael Schindler

2014-03-09 18:16

reporter  

tdec2numb.pp (2,113 bytes)
{$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.
tdec2numb.pp (2,113 bytes)

Karl-Michael Schindler

2014-03-09 18:17

reporter  

thex2dec.pp (1,708 bytes)
{$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.
thex2dec.pp (1,708 bytes)

Karl-Michael Schindler

2014-03-09 18:17

reporter  

tinttobin.pp (2,483 bytes)
{$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.
tinttobin.pp (2,483 bytes)

Karl-Michael Schindler

2014-03-09 18:18

reporter  

tinttoroman.pp (3,683 bytes)
{$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.
tinttoroman.pp (3,683 bytes)

Karl-Michael Schindler

2014-03-09 18:18

reporter  

tnumb2usa.pp (1,957 bytes)
{$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.
tnumb2usa.pp (1,957 bytes)

Karl-Michael Schindler

2014-03-09 18:18

reporter  

tromantoint.pp (1,041 bytes)
{$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 := 0 to 2000 do
  begin
    testInteger := i;
    testRoman := intToRoman(testInteger);
    RomanToIntTest(testRoman, testInteger);
    RomanToIntTest('-' + testRoman, -testInteger);
  end;

  randomize;
  for i := 0 to 1000 do
  begin
    testInteger := random(1000000);
    testRoman := intToRoman(testInteger);
    RomanToIntTest(testRoman, testInteger);
    RomanToIntTest('-' + testRoman, -testInteger);
  end;
 
  halt(exitCode);
end.
tromantoint.pp (1,041 bytes)

Karl-Michael Schindler

2017-02-27 14:07

reporter  

tromantoint2.pp (939 bytes)
{$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.
tromantoint2.pp (939 bytes)

Karl-Michael Schindler

2017-02-27 14:09

reporter   ~0098495

Tested with fpc 3.0.2 on Mac OS X. tromantoint.pp failed with conversion errors. The rest worked. Please replace tromantoint.pp by tromantoint2.pp.

Michael Van Canneyt

2017-03-04 18:07

administrator   ~0098637

Added to testsuite, thanks for the contribution !

Karl-Michael Schindler

2017-03-05 14:31

reporter   ~0098658

thanks for committing.

Issue History

Date Modified Username Field Change
2014-03-09 18:16 Karl-Michael Schindler New Issue
2014-03-09 18:16 Karl-Michael Schindler File Added: tdec2numb.pp
2014-03-09 18:17 Karl-Michael Schindler File Added: thex2dec.pp
2014-03-09 18:17 Karl-Michael Schindler File Added: tinttobin.pp
2014-03-09 18:18 Karl-Michael Schindler File Added: tinttoroman.pp
2014-03-09 18:18 Karl-Michael Schindler File Added: tnumb2usa.pp
2014-03-09 18:18 Karl-Michael Schindler File Added: tromantoint.pp
2017-02-27 14:07 Karl-Michael Schindler File Added: tromantoint2.pp
2017-02-27 14:09 Karl-Michael Schindler Note Added: 0098495
2017-02-28 13:24 Michael Van Canneyt Assigned To => Michael Van Canneyt
2017-02-28 13:24 Michael Van Canneyt Status new => assigned
2017-03-04 18:07 Michael Van Canneyt Fixed in Revision => 35521
2017-03-04 18:07 Michael Van Canneyt Note Added: 0098637
2017-03-04 18:07 Michael Van Canneyt Status assigned => resolved
2017-03-04 18:07 Michael Van Canneyt Fixed in Version => 3.1.1
2017-03-04 18:07 Michael Van Canneyt Resolution open => fixed
2017-03-04 18:07 Michael Van Canneyt Target Version => 3.2.0
2017-03-05 14:31 Karl-Michael Schindler Note Added: 0098658
2017-03-05 14:31 Karl-Michael Schindler Status resolved => closed