fpc/packages/fcl-db/tests/testbasics.pas
michael edca192fad * Fix many warnings & hints
git-svn-id: trunk@37356 -
2017-09-29 07:50:50 +00:00

492 lines
14 KiB
ObjectPascal

unit TestBasics;
{$IFDEF FPC}
{$mode objfpc}{$H+}
{$ENDIF}
interface
uses
fpcunit, testregistry,
Classes, SysUtils, db;
type
{ TTestBasics }
TTestBasics = class(TTestCase)
private
function CreateDatasetWith3Fields: TDataset;
protected
published
procedure TestParseSQL;
procedure TestInitFielddefsFromFields;
procedure TestDoubleFieldDef;
procedure TestFieldDefWithoutDS;
procedure TestGetParamList;
procedure TestGetFieldList;
procedure TestExtractFieldName; //move record then copy. Is copy identical? Has record position changed?
procedure TestCheckFieldNames;
procedure TestFindField;
end;
implementation
uses toolsunit;
Type
HackedDataset = class(TDataset);
{ TMyDataset }
TMyDataset = Class(TDataset)
protected
function GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
procedure InternalClose; override;
procedure InternalInitFieldDefs; override;
procedure InternalOpen; override;
function IsCursorOpen: Boolean; override;
end;
{ TMyDataset }
function TMyDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
Result:=grOK;
Raise ENotImplemented.Create('GetRecord not implemented');
end;
procedure TMyDataset.InternalClose;
begin
Raise ENotImplemented.Create('Internalclose not implemented');
end;
procedure TMyDataset.InternalInitFieldDefs;
begin
Raise ENotImplemented.Create('InternalInitFieldDefs not implemented');
end;
procedure TMyDataset.InternalOpen;
begin
Raise ENotImplemented.Create('InternalOpen not implemented');
end;
function TMyDataset.IsCursorOpen: Boolean;
begin
Result:=False;
Raise ENotImplemented.Create('IsCursorOpen not implemented');
end;
{ TTestBasics }
function TTestBasics.CreateDatasetWith3Fields: TDataset;
var
F: TField;
begin
Result := TMyDataset.Create(nil);
F := TIntegerField.Create(Result);
F.FieldName := 'Field1';
F.DataSet := Result;
F := TIntegerField.Create(Result);
F.FieldName := 'Field2';
F.DataSet := Result;
F := TIntegerField.Create(Result);
F.FieldName := 'Field3';
F.DataSet := Result;
end;
procedure TTestBasics.TestParseSQL;
var Params : TParams;
ReplStr : string;
pb : TParamBinding;
i : integer;
SQLStr : string;
begin
Params := TParams.Create;
AssertEquals( 'select * from table where id = $1',
params.ParseSQL('select * from table where id = :id',true,True,True,psPostgreSQL));
AssertEquals( 'select * from table where id = $1',
params.ParseSQL('select * from table where id = :id',false,True,True,psPostgreSQL));
AssertEquals( 'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $2)',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :2)',true,True,True,psPostgreSQL));
AssertEquals( 'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $3) and (test=''$test'')',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :par3) and (test=''$test'')',true,true,true,psPostgreSQL));
AssertEquals( 'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 10=$10 11=$11 12=$5 where (id = $3) and (test=''$test'')',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id = :par3) and (test=''$test'')',true,true,true,psPostgreSQL));
AssertEquals( 'select * from table where id = $1',
params.ParseSQL('select * from table where id = :id',true,true,false,psSimulated,pb,ReplStr));
AssertEquals('$',ReplStr);
AssertEquals( 'update test set 1=$1 2=$2 3=$3 4=$4 5=$5 6=$6 7=$7 8=$8 9=$9 where (id = $2)',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :2)',true,true,false,psSimulated,pb,ReplStr));
AssertEquals('$',ReplStr);
AssertEquals( 'update test set 1=$$1 2=$$2 3=$$3 4=$$4 5=$$5 6=$$6 7=$$7 8=$$8 9=$$9 where (id = $$3) and (test=''$test'')',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 where (id = :par3) and (test=''$test'')',true,true,false,psSimulated,pb,ReplStr));
AssertEquals('$$',ReplStr);
AssertEquals( 'update test set 1=$$1 2=$$2 3=$$3 4=$$4 5=$$5 6=$$6 7=$$7 8=$$8 9=$$9 10=$$10 11=$$11 12=$$5 where (id = $$3) and (test=''$test'')',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id = :par3) and (test=''$test'')',true,True,True,psSimulated));
AssertEquals('$$',ReplStr);
AssertEquals( 'update test set 1=$$$1 2=$$$2 3=$$$3 4=$$$4 5=$$$5 6=$$$6 7=$$$7 8=$$$8 9=$$$9 10=$$$10 11=$$$11 12=$$$5 where (id$$ = $$$3) and (test$=''$test'')',
params.ParseSQL('update test set 1=:1 2=:2 3=:par3 4=:par4 5=:par5 6=:par6 7=:par7 8=:par8 9=:par9 10=:par10 11=:11 12=:par5 where (id$$ = :par3) and (test$=''$test'')',true,true,False,psSimulated,pb,ReplStr));
AssertEquals('$$$',ReplStr);
AssertEquals( 'select * from table where id = ?',
params.ParseSQL('select * from table where id = :id',true,true,true,psInterbase));
// Test bug 10345
AssertEquals( 'select email from table where upper(email) like ''%''||?||''%''',
params.ParseSQL('select email from table where upper(email) like ''%''||:email||''%''',true,true,true,psInterbase));
// Test escape-sequences:
AssertEquals( 'select * from table where ''id '''' = :id''',
params.ParseSQL('select * from table where ''id '''' = :id''',true,False,True,psPostgreSQL));
AssertEquals( 'select * from table where "id "" = :id"',
params.ParseSQL('select * from table where "id "" = :id"',true,False,True,psPostgreSQL));
AssertEquals( 'select * from table where "id \" = :id"',
params.ParseSQL('select * from table where "id \" = :id"',true,True,False,psPostgreSQL));
AssertEquals( 'select * from table where "id \" = $1',
params.ParseSQL('select * from table where "id \" = :id',true,False,False,psPostgreSQL));
AssertEquals( 'select * from table where "id = :id\',
params.ParseSQL('select * from table where "id = :id\',true,True,True,psInterbase));
// Test strange-field names
AssertEquals( 'select * from table where "field-name" = ?',
params.ParseSQL('select * from table where "field-name" = :"field-name"',true,True,True,psInterbase));
AssertEquals('field-name',Params.Items[0].Name);
AssertEquals( 'select * from table where "field-name" = ?',
params.ParseSQL('select * from table where "field-name" = :"field-name',true,True,True,psInterbase));
// Test more than 99 params - bug 19645
SQLStr := 'update test set';
for i := 1 to 101 do
SQLStr := format('%s field%d=:par%d', [SQLStr,i,i]);
AssertEquals( StringReplace(SQLStr, ':par', '$', [rfReplaceAll]),
Params.ParseSQL(SQLStr, True, True, True, psPostgreSQL) );
// Test comments:
// Simple comment
AssertEquals( 'select * from table where id= --comment :c'#10'$1-$2 or id= --:c'#13'-$3',
Params.ParseSQL('select * from table where id= --comment :c'#10':a-:b or id= --:c'#13'-:d', True, True, True, psPostgreSQL));
// Bracketed comment
AssertEquals( 'select * from table where id=/*comment :c*/$1-$2',
Params.ParseSQL('select * from table where id=/*comment :c*/:a-:b', True, True, True, psPostgreSQL));
AssertEquals( 'select * from table where id=/*comment :c**/$1-$2',
Params.ParseSQL('select * from table where id=/*comment :c**/:a-:b', True, True, True, psPostgreSQL));
// Consecutive comments, with quote in second comment
AssertEquals( '--c1'#10'--c'''#10'select '':a'' from table where id=$1',
Params.ParseSQL('--c1'#10'--c'''#10'select '':a'' from table where id=:id', True, True, True, psPostgreSQL));
Params.Free;
end;
procedure TTestBasics.TestInitFielddefsFromFields;
var ds : TDataset;
F1,F2,F3 : Tfield;
Procedure CompareFieldAndFieldDef(Fld: TField; FldDef : TFieldDef);
begin
AssertEquals(Fld.FieldName,FldDef.Name);
AssertEquals(Fld.Size,FldDef.Size);
AssertEquals(Fld.Required,FldDef.Required);
AssertTrue(Fld.DataType=FldDef.DataType);
end;
begin
ds := TMyDataset.Create(nil);
try
F1:=TStringField.Create(ds);
F1.Size := 10;
F1.Name := 'StringFld';
F1.FieldName := 'FStringFld';
F1.Required := false;
F1.Dataset:=ds;
F2:=TIntegerField.Create(ds);
F2.Name := 'IntegerFld';
F2.FieldName := 'FIntegerFld';
F2.Required := True;
F2.Dataset:=ds;
F3:=TBCDField.Create(ds);
F3.Name := 'BCDFld';
F3.FieldName := 'FBCDFld';
F3.Required := false;
F3.Dataset:=ds;
(f3 as TBCDField).Precision := 2;
HackedDataset(ds).InitFieldDefsFromfields;
AssertEquals(3,ds.FieldDefs.Count);
CompareFieldAndFieldDef(F1,ds.FieldDefs[0]);
CompareFieldAndFieldDef(F2,ds.FieldDefs[1]);
CompareFieldAndFieldDef(F3,ds.FieldDefs[2]);
finally
ds.Free;
end;
end;
procedure TTestBasics.TestDoubleFieldDef;
var ds : TDataset;
PassException : boolean;
begin
// If a second field with the same name is added to a TFieldDefs, an exception
// should occur
ds := TMyDataset.Create(nil);
try
ds.FieldDefs.Add('Field1',ftInteger);
PassException:=False;
try
ds.FieldDefs.Add('Field1',ftString,10,false)
except
on E: EDatabaseError do PassException := True;
end;
AssertTrue(PassException);
finally
ds.Free;
end;
end;
procedure TTestBasics.TestFieldDefWithoutDS;
var FieldDefs : TFieldDefs;
begin
FieldDefs := TFieldDefs.Create(nil);
try
FieldDefs.Add('test',ftString);
finally
FieldDefs.Free;
end;
end;
procedure TTestBasics.TestGetFieldList;
var
ds: TDataSet;
List: TList;
ExceptionRaised: Boolean;
begin
ds := CreateDatasetWith3Fields;
try
List := TList.Create;
try
//should not
List.Clear;
ds.GetFieldList(List, '');
AssertEquals(0, List.Count);
List.Clear;
ExceptionRaised := False;
try
ds.GetFieldList(List, ' ');
except
on E: EDatabaseError do ExceptionRaised := True;
end;
AssertTrue(ExceptionRaised);
List.Clear;
ds.GetFieldList(List, 'Field1');
AssertEquals(1, List.Count);
List.Clear;
ds.GetFieldList(List, ' Field1 ');
AssertEquals(1, List.Count);
List.Clear;
ds.GetFieldList(List, 'Field1;Field2');
AssertEquals(2, List.Count);
List.Clear;
ds.GetFieldList(List, 'Field1;Field2;');
AssertEquals(2, List.Count);
List.Clear;
ds.GetFieldList(List, 'Field1;Field2;Field3');
AssertEquals(3, List.Count);
finally
List.Destroy;
end;
finally
ds.Destroy;
end;
end;
procedure TTestBasics.TestGetParamList;
var
Params: TParams;
P: TParam;
List: TList;
ExceptionRaised: Boolean;
begin
Params := TParams.Create(nil);
try
P := TParam.Create(Params, ptInput);
P.Name := 'Param1';
P := TParam.Create(Params, ptInput);
P.Name := 'Param2';
P := TParam.Create(Params, ptInput);
P.Name := 'Param3';
List := TList.Create;
try
List.Clear;
Params.GetParamList(List, '');
AssertEquals(0, List.Count);
List.Clear;
ExceptionRaised := False;
try
Params.GetParamList(List, ' ');
except
on E: EDatabaseError do ExceptionRaised := True;
end;
AssertTrue(ExceptionRaised);
List.Clear;
Params.GetParamList(List, 'Param1');
AssertEquals(1, List.Count);
List.Clear;
Params.GetParamList(List, ' Param1 ');
AssertEquals(1, List.Count);
List.Clear;
Params.GetParamList(List, 'Param1;');
AssertEquals(1, List.Count);
List.Clear;
Params.GetParamList(List, 'Param1;Param2');
AssertEquals(2, List.Count);
List.Clear;
Params.GetParamList(List, 'Param1;Param2;Param3');
AssertEquals(3, List.Count);
finally
List.Destroy;
end;
finally
Params.Destroy;
end;
end;
procedure TTestBasics.TestExtractFieldName;
var
i: Integer;
Fields: String;
FieldName: String;
begin
Fields := '';
i := 1;
FieldName := ExtractFieldName(Fields, i);
AssertEquals(1, i);
AssertEquals('', FieldName);
Fields := 'test';
i := 1;
FieldName := ExtractFieldName(Fields, i);
AssertEquals(5, i);
AssertEquals('test', FieldName);
Fields := 'test;';
i := 1;
FieldName := ExtractFieldName(Fields, i);
AssertEquals(6, i);
AssertEquals('test', FieldName);
Fields := ' test ';
i := 1;
FieldName := ExtractFieldName(Fields, i);
AssertEquals(7, i);
AssertEquals('test', FieldName);
Fields := 'test;xxx';
i := 1;
FieldName := ExtractFieldName(Fields, i);
AssertEquals(6, i);
AssertEquals('test', FieldName);
FieldName := ExtractFieldName(Fields, i);
AssertEquals(9, i);
AssertEquals('xxx', FieldName);
end;
procedure TTestBasics.TestCheckFieldNames;
var
ds: TDataSet;
ExceptionRaised: Boolean;
begin
ds := CreateDatasetWith3Fields;
try
ExceptionRaised := False;
try
ds.Fields.CheckFieldNames('');
except
ExceptionRaised := True;
end;
AssertFalse(ExceptionRaised);
ExceptionRaised := False;
try
ds.Fields.CheckFieldNames('Field1;Field2');
except
ExceptionRaised := True;
end;
AssertFalse(ExceptionRaised);
ExceptionRaised := False;
try
ds.Fields.CheckFieldNames('Field1;NonExistentField');
except
ExceptionRaised := True;
end;
AssertTrue(ExceptionRaised);
finally
ds.Destroy;
end;
end;
procedure TTestBasics.TestFindField;
var
ds: TDataSet;
F: TField;
begin
ds := CreateDatasetWith3Fields;
try
F := ds.FindField('');
AssertTrue(F = nil);
F := ds.FindField('field3');
AssertTrue(F <> nil);
F := ds.FindField('NonExistentField');
AssertTrue(F = nil);
finally
ds.Destroy;
end;
end;
initialization
RegisterTest(TTestBasics);
end.