SRL Archive - Delphi/FPC Help and Tutorials

Ok, I came across this bug, I'm not sure what I'm doing wrong. 6011111111111117

Ok, here is the Simba version of the code:

var
  number:string;

function IntDigits(int: Int64): TIntegerArray;
var
  s: string;
  l, i: Integer;
begin
  s := Int64ToStr(int);
  l := Length(s);
  SetLength(Result, l);
  for i := 0 to (l - 1) do
    Result[i] := StrToInt(s[(i + 1)]);
end;

procedure TIAAppend(var TIA: TIntegerArray; x: Integer);
var
  aL: Integer;
begin
  aL := (Length(TIA) + 1);
  SetLength(TIA, aL);
  TIA[(aL - 1)] := Integer(x);
end;

function even_number(Number: integer): boolean;
begin
  result := (Number mod 2 = 0);
end;

function add_TIA(arr:TIntegerArray):Integer;
var
  i:Integer;
begin
  for i := 0 to high(arr) do
    result := result + arr[i];
end;

function check_valid_credit(number:Int64):Boolean;
var
  card_number, even, odd:TIntegerArray;
  i, total:Integer;
begin
  card_number := IntDigits(number);
  if (length(card_number) <> 16) then
  begin
    result := false;
    exit;
  end;
  for i := 0 to high(card_number) do
  begin
    if even_number(i) then
      TIAAppend(even, card_number[i]);
    if (not even_number(i)) then
      TIAAppend(odd, card_number[i]);
  end;
  total := total + (add_TIA(odd) * 2) + add_TIA(even);
  for i := 0 to high(odd) do
  begin
    if (odd[i] > 4) then
      total := total + 1
  end;
  result := (total mod 10 = 0);
end;

var
  t:Integer;
begin
  Writeln(check_valid_credit(6011111111111117));
end.

Using the credit card number 6011111111111117, it returns true everytime like it's supposed to.

Now heres the plugin version:

library TestPlugin;

{$mode objfpc}{$H+}

uses
  Classes, sysutils
  { you can add units after this };

//{$R *.res}

type TIntegerArray = array of Integer;

function Internal_Func: String;
begin
  Result := 'Internal_Func';
end;

function Test_Func(var T: String): Integer; register;
begin
  T := Internal_Func;
  Result := 123;
end;

procedure Test_Proc(var T: String); register;
begin
  T := 'Test_Proc';
end;

function IntDigits(int: Int64): TIntegerArray;
var
  s: string;
  l, i: Integer;
begin
  s := IntToStr(int);
  l := Length(s);
  SetLength(result, l);
  for i := 0 to (l - 1) do
    Result[i] := StrToInt(s[(i + 1)]);
end;

procedure TIAAppend(var TIA: TIntegerArray; x: Integer);
var
  aL: Integer;
begin
  aL := (Length(TIA) + 1);
  SetLength(TIA, aL);
  TIA[(aL - 1)] := Integer(x);
end;

function even_number(Number: integer): boolean;
begin
  result := (Number mod 2 = 0);
end;

function add_TIA(arr:TIntegerArray):Integer;
var
  i:Integer;
begin
  for i := 0 to high(arr) do
    result := result + arr[i];
end;

function check_valid_credit(number:Int64): Boolean; register;
var
  card_number, even, odd:TIntegerArray;
  i, total:Integer;
begin
  card_number := IntDigits(number);
  if (length(card_number) <> 16) then
  begin
    result := false;
    exit;
  end;
  for i := 0 to high(card_number) do
  begin
    if even_number(i) then
      TIAAppend(even, card_number[i]);
    if (not even_number(i)) then
      TIAAppend(odd, card_number[i]);
  end;
  total := total + (add_TIA(odd) * 2) + add_TIA(even);
  for i := 0 to high(odd) do
  begin
    if (odd[i] > 4) then
      total := total + 1
  end;
  result := (total mod 10 = 0);
end;

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 3;
end;

function GetFunctionCallingConv(x : Integer) : Integer; stdcall; export;
begin
  Result := 0;
  case x of
     0..2 : Result := 1;
  end;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall; export;
begin
  case x of
    0:
      begin
        ProcAddr := @Test_Func;
        StrPCopy(ProcDef, 'function Test_Func(var T: String): Integer;');
      end;
    1:
      begin
        ProcAddr := @Test_Proc;
        StrPCopy(ProcDef, 'procedure Test_Proc(var T: String);');
      end;
    2:
      begin
        ProcAddr := @check_valid_credit;
        StrPCopy(ProcDef, 'function check_valid_credit(number:Int64): Boolean;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetFunctionCallingConv;

begin
end.                                   

And the simba code:

program SimbaPluginTest;
{$LoadLib TestPlugin}

var
  t: boolean;

begin
  Writeln(check_valid_credit(6011111111111117));
end.
         

This returns false about 80% of the time, and true 20% of the time.


Why is the results different?