
unit CompilerTestFunctions;

interface

uses Classes,
     TestFramework,
     { Project Units }
     ifps3,
     ifpscomp,
     ifps3utl,
     IFPS3CompExec,
     CompilerTestBase;

type

    TCompilerTestFunctions = class(TCompilerTestBase)
    private
      function MethodTest(const s: string): string;
    protected
        procedure OnCompile(Sender: TIFPS3CompExec); override;
        procedure OnExecute(Sender: TIFPS3CompExec); override;
    published
        procedure CallProcedure;
        procedure CallMethod;
        procedure WideStringFunctions;
    end;

    {
    TVariablesTest = class(TCompilerTest)
    private
    published
    end; }

implementation

uses StrUtils, SysUtils, Math, Dialogs,
    { Project Units }
    ifpiir_std,
    ifpii_std,
    ifpiir_stdctrls,
    ifpii_stdctrls,
    ifpiir_forms,
    ifpii_forms,
    ifpii_graphics,
    ifpii_controls,
    ifpii_classes,
    ifpiir_graphics,
    ifpiir_controls,
    ifpiir_classes;


{ TFunctionsTest }

var
    vResultS: string;
    vResultSw: WideString;
    aWideString: WideString;

procedure ResultS(const s: string);
begin
    vResultS := s;
end;

procedure ResultSw(const s: WideString);
begin
    vResultSw := s;
end;

function getWideString(): WideString;
begin
    Result := aWideString;
end;


function MyWide2String(s: WideString): String;
begin
    Result := s + '+Wide2String';
end;

function MyString2Wide(s: String): WideString;
begin
    Result := s + '+String2Wide';
end;

function MyWide2Wide(s: WideString): WideString;
begin
    Result := s + '+Wide2Wide';
end;

procedure TCompilerTestFunctions.OnCompile(Sender: TIFPS3CompExec);
begin
    inherited;
    Sender.AddFunction(@ResultS, 'procedure ResultS(s: string);');
    Sender.AddFunction(@ResultSw, 'procedure ResultSw(s: WideString);');
    Sender.AddFunction(@MyString2Wide, 'function MyString2Wide(s: String): Widestring;');
    Sender.AddFunction(@MyWide2String, 'function MyWide2String(s: Widestring): string;');
    Sender.AddFunction(@MyWide2Wide, 'function MyWide2Wide(s: Widestring): Widestring;');
    Sender.AddFunction(@getWideString, 'function getWideString(): Widestring;');
    Sender.AddMethod(Self, @TCompilerTestFunctions.MethodTest, 'function MethodTest(s: string): string');
    //Sender.AddRegisteredVariable('aWideString', 'WideString');
end;

procedure TCompilerTestFunctions.OnExecute(Sender: TIFPS3CompExec);
begin
    inherited;
    //Sender.SetVarToInstance('aWideString', aWideString);
end;

procedure TCompilerTestFunctions.CallProcedure;
begin
    CompileRun('begin ResultS(''hello''); end.');
    CheckEquals('hello', vResultS, last_script);
end;


procedure TCompilerTestFunctions.WideStringFunctions;
begin
    CompileRun('begin ResultS(MyString2Wide(''hello'')); end.');
    CheckEquals('hello+String2Wide', vResultS, last_script);

    CompileRun('begin ResultS(MyWide2String(''hello'')); end.');
    CheckEquals('hello+Wide2String', vResultS, last_script);

    CompileRun('begin ResultS(MyWide2Wide(''hello'')); end.');
    CheckEquals('hello+Wide2Wide', vResultS, last_script);

    aWideString := 'Unicode=[' + WideChar($1F04) + WideChar($4004) + ']';
    CompileRun('begin ResultSw(getWideString()); end.');
    CheckEquals(aWideString, vResultSw, last_script);
end;

function TCompilerTestFunctions.MethodTest(const s: string): string;
begin
  Result := 'Test+'+s;
end;

procedure TCompilerTestFunctions.CallMethod;
begin
    CompileRun('begin ResultS(MethodTest(''hello'')); end.');
    CheckEquals('Test+hello', vResultS, last_script);
end;

initialization
  RegisterTests('Functions Tests',
                [ TCompilerTestFunctions.Suite
                ]);

end.