afe3fdfd77
git-svn-id: http://code.remobjects.com/svn/pascalscript@1 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
148 lines
4.6 KiB
ObjectPascal
148 lines
4.6 KiB
ObjectPascal
unit CompileTestExtended;
|
|
|
|
interface
|
|
|
|
uses Classes,
|
|
TestFramework,
|
|
{ Project Units }
|
|
SysUtils,
|
|
ifps3,
|
|
ifps3utl,
|
|
ifpscomp,
|
|
IFPS3CompExec,
|
|
CompilerTestBase;
|
|
|
|
type
|
|
TCompilerTestExtended = class(TCompilerTestBase)
|
|
private
|
|
protected
|
|
LastResult: string;
|
|
LastResultB: Boolean;
|
|
LastResultI: Longint;
|
|
LastResultD: Double;
|
|
procedure OnCompImport(Sender: TObject; x: TIFPSPascalCompiler); override;
|
|
procedure ResultD(const d: Double);
|
|
procedure ResultS(const s: string);
|
|
procedure ResultB(const val: Boolean);
|
|
procedure ResultI(const val: Longint);
|
|
published
|
|
procedure VariantTest1;
|
|
procedure VariantTest2;
|
|
procedure ArrayTest1;
|
|
procedure CompileDouble;
|
|
procedure ArrayRefCounting;
|
|
procedure ArrayTest;
|
|
procedure FormatTest;
|
|
procedure ExtCharTest;
|
|
procedure StrList;
|
|
end;
|
|
|
|
implementation
|
|
|
|
|
|
{ TCompilerTestExtended }
|
|
|
|
procedure TCompilerTestExtended.ArrayRefCounting;
|
|
begin
|
|
CompileRun('var e, d: array of string; begin SetArrayLength(d, 1); d[0] := ''123''; e := d;'+
|
|
'setarraylength(d, 0); e[0] := ''321''; d := e;setarraylength(e, 0); d[0] := ''321'';end.');
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ArrayTest;
|
|
begin
|
|
CompileRun('var d,e: array of string; begin SetArrayLength(d, 1); d[0] := ''123''; e := d; setarraylength(e, 0); ResultS(d[0]); end.');
|
|
CheckEquals(LastResult, '123');
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ArrayTest1;
|
|
begin
|
|
CompileRun('type Tstrarr = array of string; var r: TStrArr; i: Longint; Begin'+
|
|
' setarraylength(r, 3); r[0] := ''asdf''; r[1] := ''safasf''; ResultS(r[0]+''!''+r[1]); end.');
|
|
CheckEquals('asdf!safasf', LastResult);
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.CompileDouble;
|
|
var
|
|
d: double;
|
|
begin
|
|
CompileRun('var x: Double; begin x := 1234.54656456; ResultS(Format(''%15.0f'',[2*x]));end.');
|
|
d := 1234.54656456;
|
|
CheckEquals(LastResult, Format('%15.0f',[2*d]));
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ExtCharTest;
|
|
var
|
|
d: double;
|
|
begin
|
|
CompileRun('var s:string; i:integer; Res: Double; function Test(i1, i2: Integer): Double; begin Result := Double(i1) / i2; end; '+
|
|
'begin i := ord(''a'');s:=chr(i); i := ord(''a''); s:= chr(i + 1); s := s + chr(i); res := Test(10, 2); ResultS(''Test 1: ''+s+''|Test 2:''+FloatToStr(res));end.');
|
|
d := 10;
|
|
d := d / 2;
|
|
CheckEquals('Test 1: ba|Test 2:'+ifps3utl.FloatToStr(d), LastResult);
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.FormatTest;
|
|
begin
|
|
CompileRun('var s: string; begin s := ''TeSTDaTa''; ResultS(''Test: ''+format(''test %s %f'', [s, 2 * PI])); end.');
|
|
CheckEquals('Test: test TeSTDaTa '+SysUtils.Format('%f', [2*pi]), LastResult);
|
|
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.OnCompImport(Sender: TObject;
|
|
x: TIFPSPascalCompiler);
|
|
begin
|
|
inherited;
|
|
CompExec.AddMethod(Self, @TCompilerTestExtended.ResultS, 'procedure ResultS(const s: string);');
|
|
CompExec.AddMethod(Self, @TCompilerTestExtended.ResultB, 'procedure ResultB(const b: Boolean);');
|
|
CompExec.AddMethod(Self, @TCompilerTestExtended.ResultI, 'procedure ResultI(const I: Longint);');
|
|
CompExec.AddMethod(Self, @TCompilerTestExtended.ResultD, 'procedure ResultD(const D: Double);');
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ResultB(const val: Boolean);
|
|
begin
|
|
LastResultB := Val;
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ResultD(const d: Double);
|
|
begin
|
|
LastResultD := d;
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ResultI(const val: Integer);
|
|
begin
|
|
LastResultI := Val;
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.ResultS(const s: string);
|
|
begin
|
|
LastResult := s;
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.StrList;
|
|
begin
|
|
CompileRun('var r: TStringList; begin r := TStringList.Create; try r.Values[''test''] := ''data'';'+
|
|
'ResultS(''Test1: ''+r.Values[''test1'']+#13#10+''Test2: ''+r.Values[''test'']); finally r.Free; end;end.');
|
|
|
|
CheckEquals('Test1: '#13#10'Test2: data', Lastresult);
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.VariantTest1;
|
|
begin
|
|
CompileRun('var v: variant; Begin v := ''Hey:''; v := v + FloatToStr(Pi); ResultS(v);end.');
|
|
CheckEquals('Hey:'+ifps3utl.FloatToStr(Pi), LastResult);
|
|
end;
|
|
|
|
procedure TCompilerTestExtended.VariantTest2;
|
|
begin
|
|
CompileRun('var v: variant; s: string;Begin v := 123; s := v; v := s + ''_test_'';'+
|
|
' s := v; v := 123.456; s := s + v; v := ''test'' + s; ResultS(v);end.');
|
|
CheckEquals('test123_test_'+Sysutils.FloatToStr(123.456), LastResult);
|
|
end;
|
|
|
|
initialization
|
|
RegisterTests('Extended Compiler Tests',
|
|
[ TCompilerTestExtended.Suite
|
|
]);
|
|
|
|
end.
|