1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846 |
- unit TestFieldTypes;
- {$mode objfpc}{$H+}
- {$modeswitch nestedprocvars}
- interface
- uses
- Classes, SysUtils, fpcunit, testutils, testregistry,
- db;
- type
- TParamProc = procedure(AParam:TParam; i : integer);
- TFieldProc = procedure(AField:TField; i : integer);
- TGetSQLTextProc = function(const i: integer) : string; { is nested;}
- TCheckFieldValueProc = procedure(AField:TField; i : integer) is nested;
- { TTestFieldTypes }
- TTestFieldTypes= class(TTestCase)
- private
- procedure CreateTableWithFieldType(ADatatype : TFieldType; ASQLTypeDecl : string);
- procedure TestFieldDeclaration(ADatatype: TFieldType; ADataSize: integer);
- procedure TestSQLFieldType(ADatatype: TFieldType; ASQLTypeDecl: string;
- ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc;
- ACheckFieldValueProc: TCheckFieldValueProc);
- procedure TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
- procedure TestSetBlobAsParam(asWhat : integer);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- procedure RunTest; override;
- published
- procedure TestEmptyUpdateQuery; // bug 13654
- procedure TestParseJoins; // bug 10148
- procedure TestDoubleFieldNames; // bug 8457
- procedure TestParseUnion; // bug 8442
- procedure TestInsertLargeStrFields; // bug 9600
- procedure TestNumericNames; // Bug9661
- procedure TestApplyUpdFieldnames; // Bug 12275;
- procedure TestLimitQuery; // bug 15456
- procedure Test11Params;
- procedure TestRowsAffected; // bug 9758
- procedure TestLocateNull;
- procedure TestLocateOnMoreRecords;
- procedure TestStringsReplace;
- procedure TestCircularParams;
- procedure TestBug9744;
- procedure TestCrossStringDateParam;
- procedure TestGetFieldNames;
- procedure TestUpdateIndexDefs;
- procedure TestMultipleFieldPKIndexDefs;
- procedure TestSetBlobAsMemoParam;
- procedure TestSetBlobAsBlobParam;
- procedure TestSetBlobAsStringParam;
- procedure TestNonNullableParams;
- procedure TestGetIndexDefs;
- procedure TestDblQuoteEscComments;
- procedure TestpfInUpdateFlag; // bug 7565
- procedure TestInt;
- procedure TestScript;
- procedure TestInsertReturningQuery;
- procedure TestTemporaryTable;
- procedure TestRefresh;
- procedure TestParametersAndDates;
- procedure TestExceptOnsecClose;
- procedure TestErrorOnEmptyStatement;
- procedure TestBlob;
- procedure TestChangeBlob;
- procedure TestBlobGetText;
- procedure TestBlobSize;
- procedure TestLargeRecordSize;
- procedure TestNumeric;
- procedure TestFloat;
- procedure TestDateTime; // bug 6925
- procedure TestString;
- procedure TestUnlVarChar;
- procedure TestDate;
- procedure TestNullValues;
- procedure TestParamQuery;
- procedure TestStringParamQuery;
- procedure TestFixedStringParamQuery;
- procedure TestDateParamQuery;
- procedure TestIntParamQuery;
- procedure TestTimeParamQuery;
- procedure TestFmtBCDParamQuery;
- procedure TestFloatParamQuery;
- procedure TestBCDParamQuery;
- procedure TestAggregates;
- procedure TestStringLargerThen8192;
- procedure TestQueryAfterReconnect; // bug 16438
- // SchemaType tests
- procedure TestTableNames;
- procedure TestFieldNames;
- procedure TestClearUpdateableStatus;
- procedure TestReadOnlyParseSQL; // bug 9254
- procedure TestGetTables;
- // Test SQL-field type recognition
- procedure TestSQLClob;
- procedure TestSQLLargeint;
- end;
- implementation
- uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils, dbconst, FmtBCD;
- Type HackedDataset = class(TDataset);
- const
- testFloatValuesCount = 21;
- testFloatValues : Array[0..testFloatValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
- testBCDValuesCount = 10;
- testBCDValues : Array[0..testBCDValuesCount-1] of currency = (-100,54.53,1.2345,123.5345,0,1,-1,0,1.42,1324.4324);
- testIntValuesCount = 17;
- testIntValues : Array[0..testIntValuesCount-1] of integer = (-maxInt,-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,MaxInt);
- testDateValuesCount = 18;
- testDateValues : Array[0..testDateValuesCount-1] of string = (
- '2000-01-01',
- '1999-12-31',
- '2004-02-29',
- '2004-03-01',
- '1991-02-28',
- '1991-03-01',
- '2040-10-16',
- '1977-09-29',
- '1800-03-30',
- '1650-05-10',
- '1754-06-04',
- '0904-04-12',
- '0199-07-09',
- '0001-01-01',
- '1899-12-29',
- '1899-12-30',
- '1899-12-31',
- '1900-01-01'
- );
- procedure TTestFieldTypes.TestpfInUpdateFlag;
- var ds : TCustomBufDataset;
- AFld1, AFld2, AFld3 : Tfield;
- begin
- ds := (DBConnector.GetNDataset(True,5) as TCustomBufDataset);
- with ds do
- begin
- AFld1 := TIntegerField.Create(ds);
- AFld1.FieldName := 'ID';
- AFld1.DataSet := ds;
- AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
- AFld2 := TStringField.Create(ds);
- AFld2.FieldName := 'NAME';
- AFld2.DataSet := ds;
- AFld3 := TIntegerField.Create(ds);
- AFld3.FieldName := 'CALCFLD';
- AFld3.DataSet := ds;
- Afld3.FieldKind := fkCalculated;
- AFld3.ProviderFlags := [];
- Open;
- Edit;
- FieldByName('ID').AsInteger := 254;
- Post;
- ApplyUpdates;
- Append;
- FieldByName('ID').AsInteger := 255;
- Post;
- ApplyUpdates;
- Close;
- AFld1.Free;
- AFld2.Free;
- AFld3.Free;
- end;
- end;
- procedure TTestFieldTypes.TestScript;
- var Ascript : TSQLScript;
- begin
- Ascript := tsqlscript.create(nil);
- try
- with Ascript do
- begin
- DataBase := TSQLDBConnector(DBConnector).Connection;
- transaction := TSQLDBConnector(DBConnector).Transaction;
- script.clear;
- script.append('create table a (id int);');
- script.append('create table b (id int);');
- ExecuteScript;
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- finally
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table a');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('drop table b');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- end;
- procedure TTestFieldTypes.TestInt;
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftInteger,'INT');
- TestFieldDeclaration(ftInteger,4);
- for i := 0 to testIntValuesCount-1 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testIntValues[i]) + ')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testIntValuesCount-1 do
- begin
- AssertEquals(testIntValues[i],fields[0].AsInteger);
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestLargeRecordSize;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (plant varchar(8192),sampling_type varchar(8192),area varchar(8192), area_description varchar(8192), batch varchar(8192), sampling_datetime timestamp, status varchar(8192), batch_commentary varchar(8192))');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- if UpperCase(dbconnectorparams)='INTERBASE' then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.append('insert into FPDEV2 (plant,sampling_type,batch,sampling_datetime,status,batch_commentary) values (''ZUBNE PASTE'',''OTISCI POVRINA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')');
- ExecSQL;
- sql.clear;
- sql.append('select * from FPDEV2');
- open;
- AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString);
- AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestNumeric;
- const
- testValuesCount = 13;
- testValues : Array[0..testValuesCount-1] of currency = (-123456.789,-10200,-10000,-1875.25,-10,-0.5,0,0.5,10,1875.25,10000,10200,123456.789);
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftBCD,'NUMERIC(10,4)');
- TestFieldDeclaration(ftBCD,sizeof(Currency));
- for i := 0 to testValuesCount-1 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + CurrToStrF(testValues[i],ffFixed,3) + ')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- AssertEquals(testValues[i],fields[0].AsCurrency);
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestString;
- const
- testValuesCount = 19;
- testValues : Array[0..testValuesCount-1] of string = (
- '',
- 'a',
- 'ab',
- 'abc',
- 'abcd',
- 'abcde',
- 'abcdef',
- 'abcdefg',
- 'abcdefgh',
- 'abcdefghi',
- 'abcdefghij',
- 'lMnOpQrStU',
- '1234567890',
- '_!@#$%^&*(',
- ')-;:/?.<>',
- '~`|{}- =', // note that there's no \ (backslash) since some db's uses that as escape-character
- ' WRaP ',
- 'wRaP ',
- ' wRAP'
- );
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftString,'VARCHAR(10)');
- TestFieldDeclaration(ftString,11);
- for i := 0 to testValuesCount-1 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- if (SQLDbType in [mysql40,mysql41]) then
- AssertEquals(TrimRight(testValues[i]),fields[0].AsString) // MySQL < 5.0.3 automatically trims strings
- else
- AssertEquals(testValues[i],fields[0].AsString);
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestUnlVarChar;
- const
- testValuesCount = 21;
- testValues : Array[0..testValuesCount-1] of string = (
- '',
- 'a',
- 'ab',
- 'abc',
- 'abcd',
- 'abcde',
- 'abcdef',
- 'abcdefg',
- 'abcdefgh',
- 'abcdefghi',
- 'abcdefghij',
- 'lMnOpQrStU',
- '1234567890',
- '_!@#$%^&*(',
- ')-;:/?.<>',
- '~`|{}- =',
- ' WRaP ',
- 'wRaP ',
- ' wRAP',
- '0123456789',
- 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
- + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?' + 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !@#$%^&*()_+-=][|}{;:,./<>?'
- );
- var
- i : byte;
- begin
- if SQLDbType<>postgresql then Ignore('This test does only apply to Postgres, since others don''t support varchars without length given');
- CreateTableWithFieldType(ftString,'VARCHAR');
- TestFieldDeclaration(ftString,dsMaxStringSize+1);
- for i := 0 to testValuesCount-1 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- AssertEquals(testValues[i],fields[0].AsString);
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestDate;
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftDate,'DATE');
- TestFieldDeclaration(ftDate,8);
- for i := 0 to testDateValuesCount-1 do
- if SQLDbType=oracle then
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testDateValues[i] + ''',''YYYY-MM-DD''))')
- else
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testDateValues[i] + ''')');
- // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testDateValuesCount-1 do
- begin
- AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings));
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestChangeBlob;
- var s : string;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For interbase
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test deze blob'')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.add('select * from FPDEV2');
- Open;
- fields[1].ProviderFlags := [pfInUpdate]; // blob niet in de where
- UpdateMode := upWhereAll;
- AssertEquals('Test deze blob',fields[1].AsString);
- edit;
- // Dat werkt niet lekker, omdat de stream vernield wordt...
- // fields[0].asstring := 'Deze blob is gewijzigd!';
- With Createblobstream(fields[1],bmwrite) do
- begin
- s := 'Deze blob is gewijzigd!';
- WriteBuffer(Pointer(s)^,Length(s));
- post;
- free;
- end;
- AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
- ApplyUpdates(0);
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
- close;
- open;
- AssertEquals('Deze blob is gewijzigd!',fields[1].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestBlobGetText;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TestFieldDeclaration(ftBlob,0);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (Null)');
- // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertFalse(fields[0].IsNull);
- AssertEquals('(BLOB)',fields[0].DisplayText);
- AssertEquals('Test deze blob',fields[0].AsString);
- Next;
- AssertTrue(fields[0].IsNull);
- AssertEquals('(blob)',fields[0].Text);
- AssertEquals('',fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestBlobSize;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.text := 'select * from FPDEV2';
- Open;
- AssertEquals(14,TBlobField(fields[0]).BlobSize);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestSetBlobAsStringParam;
- begin
- TestSetBlobAsParam(1);
- end;
- procedure TTestFieldTypes.TestBlob;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TestFieldDeclaration(ftBlob,0);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')');
- // TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertEquals('Test deze blob',fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestDateTime;
- const
- testValuesCount = 31;
- testValues : Array[0..testValuesCount-1] of string = (
- '2000-01-01',
- '1999-12-31',
- '2004-02-29',
- '2004-03-01',
- '1991-02-28',
- '1991-03-01',
- '1977-09-29',
- '2000-01-01 10:00:00',
- '2000-01-01 23:59:59',
- '1994-03-06 11:54:30',
- '2040-10-16', // MySQL 4.0 doesn't support datetimes before 1970 or after 2038
- '1400-02-03 12:21:53',
- '0354-11-20 21:25:15',
- '1333-02-03 21:44:21',
- '1800-03-30',
- '1650-05-10',
- '1754-06-04',
- '0904-04-12',
- '0199-07-09',
- '0001-01-01',
- '1899-12-29',
- '1899-12-30',
- '1899-12-31',
- '1900-01-01',
- '1899-12-30 18:00:51',
- '1899-12-30 04:00:51',
- '1899-12-29 04:00:51',
- '1899-12-29 18:00:51',
- '1903-04-02 01:04:02',
- '1815-09-24 03:47:22',
- '2100-01-01 01:01:01'
- );
- var
- i, corrTestValueCount : byte;
- begin
- CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
- TestFieldDeclaration(ftDateTime,8);
- if SQLDbType=mysql40 then corrTestValueCount := testValuesCount-21
- else corrTestValueCount := testValuesCount;
- for i := 0 to corrTestValueCount-1 do
- if SQLDbType=oracle then
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (to_date (''' + testValues[i] + ''',''YYYY-MM-DD HH24:MI:SS''))')
- else
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + testValues[i] + ''')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to corrTestValueCount-1 do
- begin
- if length(testValues[i]) < 12 then
- AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd', fields[0].AsDateTime, DBConnector.FormatSettings))
- else
- AssertEquals(testValues[i],FormatDateTime('yyyy/mm/dd hh:mm:ss', fields[0].AsDateTime, DBConnector.FormatSettings));
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestFloat;
- const
- testValuesCount = 21;
- testValues : Array[0..testValuesCount-1] of double = (-maxSmallint-1,-maxSmallint,-256,-255,-128,-127,-1,0,1,127,128,255,256,maxSmallint,maxSmallint+1,0.123456,-0.123456,4.35,12.434E7,9.876e-5,123.45678);
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftFloat,'FLOAT');
- TestFieldDeclaration(ftFloat,sizeof(double));
- for i := 0 to testValuesCount-1 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + floattostr(testValues[i]) + ')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- AssertEquals(testValues[i],fields[0].AsFloat);
- Next;
- end;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestNullValues;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FIELD1) values (1)');
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.append('select * from FPDEV2');
- open;
- AssertEquals(1,FieldByName('FIELD1').AsInteger);
- AssertTrue('Null-values test failed',FieldByName('FIELD2').IsNull);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestParamQuery;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT, FIELD3 INT, DECOY VARCHAR(30))');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.append('insert into FPDEV2 (field1) values (:field1)');
- Params.ParamByName('field1').AsInteger := 1;
- ExecSQL;
- sql.clear;
- sql.append('insert into FPDEV2 (field1,field2,decoy) values (:field1,:field2,''decoytest'')');
- Params.ParamByName('field1').AsInteger := 2;
- Params.ParamByName('field2').DataType := ftInteger;
- Params.ParamByName('field2').Value := Null;
- ExecSQL;
- sql.clear;
- sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field3)');
- Params.ParamByName('field1').AsInteger := 3;
- Params.ParamByName('field2').AsInteger := 2;
- Params.ParamByName('field3').AsInteger := 3;
- ExecSQL;
- sql.clear;
- sql.append('insert into FPDEV2 (field1,field2,field3,decoy) values (:field1,:field2,:field3,'':decoy ::test $decoy2 $$2'')');
- Params.ParamByName('field1').AsInteger := 4;
- Params.ParamByName('field2').AsInteger := 2;
- Params.ParamByName('field3').AsInteger := 3;
- ExecSQL;
- sql.clear;
- sql.append('insert into FPDEV2 (field1,field2,field3) values (:field1,:field2,:field1)');
- Params.ParamByName('field1').AsInteger := 5;
- Params.ParamByName('field2').AsInteger := 2;
- ExecSQL;
- sql.clear;
- sql.append('select * from FPDEV2 order by FIELD1');
- open;
- AssertEquals(1,FieldByName('FIELD1').asinteger);
- AssertTrue(FieldByName('FIELD2').IsNull);
- AssertTrue(FieldByName('FIELD3').IsNull);
- AssertTrue(FieldByName('DECOY').IsNull);
- next;
- AssertEquals(2,FieldByName('FIELD1').asinteger);
- AssertTrue(FieldByName('FIELD2').IsNull);
- AssertTrue(FieldByName('FIELD3').IsNull);
- AssertEquals('decoytest',FieldByName('DECOY').AsString);
- next;
- AssertEquals(3,FieldByName('FIELD1').asinteger);
- AssertEquals(2,FieldByName('FIELD2').asinteger);
- AssertEquals(3,FieldByName('FIELD3').asinteger);
- AssertTrue(FieldByName('DECOY').IsNull);
- next;
- AssertEquals(4,FieldByName('FIELD1').asinteger);
- AssertEquals(2,FieldByName('FIELD2').asinteger);
- AssertEquals(3,FieldByName('FIELD3').asinteger);
- AssertEquals(':decoy ::test $decoy2 $$2',FieldByName('DECOY').AsString);
- next;
- AssertEquals(5,FieldByName('FIELD1').asinteger);
- AssertEquals(2,FieldByName('FIELD2').asinteger);
- AssertEquals(5,FieldByName('FIELD3').asinteger);
- AssertTrue(FieldByName('DECOY').IsNull);
- close;
- end;
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- procedure TTestFieldTypes.TestIntParamQuery;
- begin
- TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
- end;
- procedure TTestFieldTypes.TestFmtBCDParamQuery;
- begin
- TestXXParamQuery(ftFMTBcd,FieldtypeDefinitionsConst[ftFMTBcd],testValuesCount);
- end;
- procedure TTestFieldTypes.TestTimeParamQuery;
- begin
- TestXXParamQuery(ftTime,FieldtypeDefinitionsConst[ftTime],testValuesCount);
- end;
- procedure TTestFieldTypes.TestFloatParamQuery;
- begin
- TestXXParamQuery(ftFloat,'FLOAT',testFloatValuesCount);
- end;
- procedure TTestFieldTypes.TestBCDParamQuery;
- begin
- TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
- end;
- procedure TTestFieldTypes.TestStringParamQuery;
- begin
- TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
- end;
- procedure TTestFieldTypes.TestFixedStringParamQuery;
- begin
- TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
- end;
- procedure TTestFieldTypes.TestDateParamQuery;
- begin
- TestXXParamQuery(ftDate,'DATE',testDateValuesCount);
- end;
- procedure TTestFieldTypes.TestXXParamQuery(ADatatype : TFieldType; ASQLTypeDecl : string; testValuescount : integer; Cross : boolean = false);
- var i : integer;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID INT, FIELD1 '+ASQLTypeDecl+')');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- with TSQLDBConnector(DBConnector).Query do
- begin
- PacketRecords := -1;
- sql.clear;
- sql.append('insert into FPDEV2 (ID,FIELD1) values (:id,:field1)');
- // There is no Param.AsFixedChar, so the datatype has to be set manually
- if ADatatype=ftFixedChar then
- Params.ParamByName('field1').DataType := ftFixedChar;
- for i := 0 to testValuesCount -1 do
- begin
- Params.ParamByName('id').AsInteger := i;
- case ADataType of
- ftInteger: Params.ParamByName('field1').asinteger := testIntValues[i];
- ftFloat : Params.ParamByName('field1').AsFloat := testFloatValues[i];
- ftBCD : Params.ParamByName('field1').AsCurrency:= testBCDValues[i];
- ftFixedChar,
- ftString : Params.ParamByName('field1').AsString := testStringValues[i];
- ftTime : Params.ParamByName('field1').AsTime := TimeStringToDateTime(testTimeValues[i]);
- ftDate : if cross then
- Params.ParamByName('field1').AsString:= testDateValues[i]
- else
- Params.ParamByName('field1').AsDateTime:= StrToDate(testDateValues[i],'yyyy/mm/dd','-');
- ftFMTBcd : Params.ParamByName('field1').AsFMTBCD:= StrToBCD(testFmtBCDValues[i]{,DBConnector.FormatSettings})
- else
- AssertTrue('no test for paramtype available',False);
- end;
- ExecSQL;
- end;
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- sql.clear;
- sql.append('select * from FPDEV2 order by ID');
- open;
- for i := 0 to testValuesCount -1 do
- begin
- AssertEquals(i,FieldByName('ID').AsInteger);
- case ADataType of
- ftInteger: AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
- ftFloat : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
- ftBCD : AssertEquals(testBCDValues[i],FieldByName('FIELD1').AsCurrency);
- ftFixedChar : AssertEquals(PadRight(testStringValues[i],10),FieldByName('FIELD1').AsString);
- ftString : AssertEquals(testStringValues[i],FieldByName('FIELD1').AsString);
- ftTime : AssertEquals(testTimeValues[i],DateTimeToTimeString(FieldByName('FIELD1').AsDateTime));
- ftdate : AssertEquals(testDateValues[i],FormatDateTime('yyyy/mm/dd',FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
- ftFMTBcd : AssertEquals(testFmtBCDValues[i],BCDToStr(FieldByName('FIELD1').AsBCD{,DBConnector.FormatSettings}))
- else
- AssertTrue('no test for paramtype available',False);
- end;
- Next;
- end;
- close;
- end;
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
- var
- ASQL : TSQLQuery;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TestFieldDeclaration(ftBlob,0);
- ASQL := DBConnector.GetNDataset(True,1) as tsqlquery;
- with ASql do
- begin
- sql.Text := 'insert into FPDEV2 (FT) values (:BlobParam)';
- case asWhat of
- 0: Params.ParamByName('blobParam').AsMemo := 'Test deze BLob';
- 1: Params.ParamByName('blobParam').AsString := 'Test deze BLob';
- 2: Params.ParamByName('blobParam').AsBlob := 'Test deze BLob';
- end;
- ExecSQL;
- end;
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- if not eof then
- AssertEquals('Test deze BLob',fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestAggregates;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FIELD1 INT, FIELD2 INT)');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (1,1)');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (2,3)');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (3,4)');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 values (4,4)');
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.append('select count(*) from FPDEV2');
- open;
- AssertEquals(4,Fields[0].AsInteger);
- close;
- sql.clear;
- sql.append('select sum(FIELD1) from FPDEV2');
- open;
- AssertEquals(10,Fields[0].AsInteger);
- close;
- sql.clear;
- sql.append('select avg(FIELD2) from FPDEV2');
- open;
- AssertEquals(3,Fields[0].AsInteger);
- close;
- end;
- end;
- procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
- ASQLTypeDecl: string);
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- procedure TTestFieldTypes.TestFieldDeclaration(ADatatype: TFieldType;
- ADataSize: integer);
- begin
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- SQL.Add('select * from FPDEV2');
- Open;
- AssertEquals(1,FieldCount);
- AssertTrue(CompareText('FT',fields[0].FieldName)=0);
- AssertEquals(ADataSize,fields[0].DataSize);
- AssertTrue(ADatatype=fields[0].DataType);
- Close;
- end;
- end;
- procedure TTestFieldTypes.SetUp;
- begin
- InitialiseDBConnector;
- end;
- procedure TTestFieldTypes.TearDown;
- begin
- if assigned(DBConnector) then
- TSQLDBConnector(DBConnector).Transaction.Rollback;
- FreeDBConnector;
- end;
- procedure TTestFieldTypes.RunTest;
- begin
- // if (SQLDbType in TSQLDBTypes) then
- inherited RunTest;
- end;
- procedure TTestFieldTypes.TestQueryAfterReconnect;
- var DS: TDataset;
- begin
- ds := DBConnector.GetNDataset(true,5);
- with ds do
- begin
- open;
- close;
- TSQLDBConnector(DBConnector).Connection.Close;
- TSQLDBConnector(DBConnector).Connection.Open;
- open;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestLocateNull;
- var DS: TCustomBufDataset;
- begin
- ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset;
- with ds do
- begin
- open;
- edit;
- fieldbyname('name').Clear;
- post;
- next;
- AssertFalse(Locate('name',VarArrayOf(['TestName1']),[]));
- AssertTrue(Locate('name',VarArrayOf([Null]),[]));
- AssertEquals(1,fieldbyname('ID').AsInteger);
- end;
- end;
- procedure TTestFieldTypes.TestLocateOnMoreRecords;
- var DS: TCustomBufDataset;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- ds := GetNDataset(true,30) as TCustomBufDataset;
- with query do
- begin
- SQL.Text:='update FPDEV set NAME = null where ID<11;';
- ExecSQL;
- SQL.Text:='update FPDEV set NAME = null where (ID>11) and (ID<23);';
- ExecSQL;
- end;
- with ds do
- begin
- Open;
- // Must be exactly 11 to trigger bug/test
- AssertTrue(Locate('name',VarArrayOf(['TestName11']),[]));
- AssertEquals(11,fieldbyname('ID').AsInteger);
- // Must be exactly 23 to trigger bug/test
- AssertTrue(Locate('name',VarArrayOf(['TestName23']),[]));
- AssertEquals(23,fieldbyname('ID').AsInteger);
- end;
- end;
- end;
- procedure TTestFieldTypes.TestRefresh;
- var ADataset: TDataset;
- i: integer;
- AFldID, AFldName: TField;
- begin
- ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5);
- Adataset.Open;
- AFldId:=Adataset.Fields[0];
- AFldName:=Adataset.Fields[1];
- for i := 1 to 5 do
- begin
- AssertEquals(i,AFldID.asinteger);
- AssertEquals('TestName'+inttostr(i),AFldName.asstring);
- ADataset.Next;
- end;
- ADataset.Next;
- AssertTrue(ADataset.EOF);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''test'' where ID=2');
- ADataset.Refresh;
- ADataset.First;
- for i := 1 to 5 do
- begin
- AssertEquals(i,AFldID.AsInteger);
- if i = 2 then
- AssertEquals('test',AFldName.AsString)
- else
- AssertEquals('TestName'+inttostr(i),AFldName.AsString);
- ADataset.Next;
- end;
- ADataset.Next;
- AssertTrue(ADataset.EOF);
- end;
- procedure TTestFieldTypes.TestEmptyUpdateQuery;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set name=''nothing'' where (1=0)');
- end;
- procedure TTestFieldTypes.TestNonNullableParams;
- var ASQLQuery : TSQLQuery;
- Passed: Boolean;
- begin
- // Check for an exception when a null value is stored into a non-nullable
- // field using a parameter
- // There was a bug in IBConnection so that in this case the last used value
- // for the parameter was used.
- // To make sure that any changes are cancelled in the case the test fails
- TSQLDBConnector(DBConnector).GetNDataset(true,5);
- ASQLQuery := TSQLDBConnector(DBConnector).Query;
- ASQLQuery.SQL.text := 'update fpdev set ID=:ID1 where id = :ID2';
- ASQLQuery.Params[0].Clear;
- ASQLQuery.Params[1].AsInteger := 1;
- AssertTrue(ASQLQuery.Params[0].IsNull);
- Passed:=False;
- try
- @ASQLQuery.ExecSQL;
- except
- on E: Exception do
- if E.ClassType.InheritsFrom(EDatabaseError) then
- Passed := true;
- end;
- AssertTrue(Passed);
- end;
- procedure TTestFieldTypes.TestStringLargerThen8192;
- var
- s : string;
- i : integer;
- begin
- CreateTableWithFieldType(ftString,'VARCHAR(9000)');
- TestFieldDeclaration(ftString,9001);
- setlength(s,9000);
- for i := 1 to 9000 do
- s[i]:=chr((i mod 10)+ord('a'));
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''' + s + ''')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertEquals(s,fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestTableNames;
- var TableList : TStringList;
- i : integer;
- begin
- TableList := TStringList.Create;
- try
- TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
- AssertTrue(TableList.Find('fpdev',i));
- finally
- TableList.Free;
- end;
- end;
- procedure TTestFieldTypes.TestFieldNames;
- var FieldList : TStringList;
- i : integer;
- begin
- FieldList := TStringList.Create;
- try
- TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
- AssertTrue(FieldList.Find('id',i));
- finally
- FieldList.Free;
- end;
- end;
- procedure TTestFieldTypes.TestInsertReturningQuery;
- begin
- if (SQLDbType <> interbase) then Ignore('This test does only apply to Firebird.');
- with TSQLDBConnector(DBConnector) do
- begin
- // This only works with databases that supports 'insert into .. returning'
- // for example, Firebird version 2.0 and up
- CreateTableWithFieldType(ftInteger,'int');
- Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
- Query.Open;
- AssertEquals('FT',Query.fields[0].FieldName);
- AssertEquals(154,Query.fields[0].AsInteger);
- Query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestClearUpdateableStatus;
- // Test if CanModify is correctly disabled in case of a select query without
- // a from-statement.
- begin
- if not (SQLDbType in MySQLdbTypes) then Ignore('This test does only apply to MySQL because the used SQL-statement is MySQL only.');
- with TSQLDBConnector(DBConnector) do
- begin
- with (GetNDataset(false,5) as TSQLQuery) do
- begin
- Open;
- AssertEquals(True,CanModify);
- Close;
- SQL.Text:='select last_insert_id();';
- Open;
- AssertEquals(False,CanModify);
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestReadOnlyParseSQL;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- GetFieldDataset(True);
- with query do
- begin
- AssertFalse(ReadOnly);
- AssertTrue(ParseSQL);
- // If ParseSQL is false, and no update-queries are given, the query
- // shouldn't be updateable after open.
- ParseSQL := False;
- AssertFalse(ParseSQL);
- AssertFalse(ReadOnly);
- SQL.Text := 'select * from FPDEV;';
- open;
- AssertFalse(ParseSQL);
- AssertFalse(ReadOnly);
- AssertFalse(CanModify);
- close;
- // If ParseSQL is true, the query should be updateable after open.
- ReadOnly := False;
- ParseSQL := True;
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- SQL.Text := 'select * from FPDEV';
- open;
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- AssertTrue(CanModify);
- edit;
- FieldByName('ID').AsInteger:=321;
- post;
- Applyupdates;
- close;
- // If ParseSQL is true, but the supplied query isn't updateable, then
- // the query shouldn't be updateable after open.
- ReadOnly := False;
- SQL.Text:='select ID,NAME from FPDEV where ID<5';
- sql.Add('union');
- sql.Add('select ID,NAME from FPDEV where ID>5');
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- open;
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- AssertFalse(CanModify);
- close;
- // As above, but now with an update-query, so that the query should
- // be updateable again.
- ReadOnly := False;
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- UpdateSQL.Text:='update FPDEV set ID=:ID where ID=:OLD_ID';
- open;
- AssertTrue(ParseSQL);
- AssertFalse(ReadOnly);
- AssertTrue(CanModify);
- edit;
- post;
- Applyupdates;
- close;
- // Also if ParseSQL is False, the query should be updateable if a update-
- // query is given.
- ReadOnly := False;
- ParseSQL := False;
- AssertFalse(ParseSQL);
- AssertFalse(ReadOnly);
- open;
- AssertFalse(ParseSQL);
- AssertFalse(ReadOnly);
- AssertTrue(CanModify);
- edit;
- FieldByName('ID').AsInteger:=1;
- post;
- Applyupdates;
- close;
- // But if ReadOnly is true, then CanModify should always be false
- ReadOnly := True;
- ParseSQL := False;
- AssertFalse(ParseSQL);
- AssertTrue(ReadOnly);
- open;
- AssertFalse(ParseSQL);
- AssertTrue(ReadOnly);
- AssertFalse(CanModify);
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestParseJoins;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- with query do
- begin
- SQL.Text:='select TT.NAME from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
- Open;
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestDoubleFieldNames;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- with query do
- begin
- SQL.Text:='select FPDEV.*,TT.* from FPDEV left join FPDEV TT on TT.ID=FPDEV.ID';
- Open;
- AssertTrue(assigned(FindField('ID')));
- AssertTrue (assigned(FindField('ID_1')));
- AssertTrue(assigned(FindField('NAME')));
- AssertTrue(assigned(FindField('NAME_1')));
- AssertEquals(1,fieldbyname('ID').AsInteger);
- AssertEquals(1,fieldbyname('ID_1').AsInteger);
- AssertEquals('TestName1',fieldbyname('NAME').AsString);
- AssertEquals('TestName1',fieldbyname('NAME_1').AsString);
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestParseUnion;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- with query do
- begin
- SQL.Text:='select NAME from FPDEV where ID<5';
- sql.Add('union');
- sql.Add('select NAME from FPDEV where ID>5');
- Open;
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestInsertLargeStrFields;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- Connection.ExecuteDirect('create table FPDEV2 ( ' +
- ' ID INT NOT NULL , ' +
- ' NAME VARCHAR(16000), ' +
- ' PRIMARY KEY (ID) ' +
- ') ');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
- Query.ExecSQL;
- query.sql.Text:='select * from FPDEV2';
- Query.Open;
- AssertEquals(query.FieldByName('NAME').AsString,'test1');
- Query.insert;
- query.fields[1].AsString:='11';
- query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestNumericNames;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- Connection.ExecuteDirect('create table FPDEV2 ( ' +
- ' '+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[1]+' INT NOT NULL, ' +
- ' '+connection.FieldNameQuoteChars[0]+'3TEST'+connection.FieldNameQuoteChars[1]+' VARCHAR(10), ' +
- ' PRIMARY KEY ('+connection.FieldNameQuoteChars[0]+'2ID'+connection.FieldNameQuoteChars[0]+') ' +
- ') ');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- with query do
- begin
- SQL.Text:='select * from FPDEV2';
- Open;
- Edit;
- fieldbyname('2ID').AsInteger:=1;
- fieldbyname('3TEST').AsString:='3test';
- Post;
- ApplyUpdates(0);
- close;
- open;
- AssertEquals('3test',FieldByName('3TEST').AsString);
- Edit;
- fieldbyname('3TEST').AsString:='test3';
- Post;
- ApplyUpdates(0);
- open;
- AssertEquals('test3',FieldByName('3TEST').AsString);
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestApplyUpdFieldnames;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- AssertEquals(-1,query.RowsAffected);
- Connection.ExecuteDirect('create table FPDEV2 ( ' +
- ' ID INT NOT NULL , ' +
- ' '+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+' VARCHAR(250), ' +
- ' PRIMARY KEY (ID) ' +
- ') ');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- Connection.ExecuteDirect('insert into FPDEV2(ID,'+Connection.FieldNameQuoteChars[0]+'NAME-TEST'+Connection.FieldNameQuoteChars[1]+') values (1,''test1'')');
- Query.SQL.Text := 'select * from FPDEV2';
- Query.Open;
- AssertEquals(1,Query.FieldByName('ID').AsInteger);
- AssertEquals('test1',Query.FieldByName('NAME-TEST').AsString);
- Query.Edit;
- Query.FieldByName('NAME-TEST').AsString:='Edited';
- Query.Post;
- Query.ApplyUpdates;
- Query.Close;
- Query.Open;
- AssertEquals(1,Query.FieldByName('ID').AsInteger);
- AssertEquals('Edited',Query.FieldByName('NAME-TEST').AsString);
- Query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestLimitQuery;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- with query do
- begin
- if (sqlDBtype=interbase) then
- SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21'''
- else
- SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
- Open;
- close;
- ServerFilter:='ID=21';
- ServerFiltered:=true;
- open;
- close;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestRowsAffected;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- AssertEquals(-1,query.RowsAffected);
- Connection.ExecuteDirect('create table FPDEV2 ( ' +
- ' ID INT NOT NULL , ' +
- ' NAME VARCHAR(250), ' +
- ' PRIMARY KEY (ID) ' +
- ') ');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (1,''test1'')';
- Query.ExecSQL;
- AssertEquals(1,query.RowsAffected);
- Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (2,''test2'')';
- Query.ExecSQL;
- AssertEquals(1,query.RowsAffected);
- Query.SQL.Text := 'update FPDEV2 set NAME=''NewTest''';
- Query.ExecSQL;
- AssertEquals(2,query.RowsAffected);
- Query.SQL.Text := 'select * from FPDEV2';
- Query.Open;
- AssertTrue(query.RowsAffected<>0); // It should return -1 or the number of selected rows.
- query.Close;
- AssertTrue(query.RowsAffected<>0); // It should return -1 or the same as the last time it was called.
- if (SQLDbType = sqlite3) then // sqlite doesn't count the rowsaffected if there is no where-clause
- Query.SQL.Text := 'delete from FPDEV2 where 1'
- else
- Query.SQL.Text := 'delete from FPDEV2';
- Query.ExecSQL;
- AssertEquals(2,query.RowsAffected);
- Query.SQL.Text := 'delete from FPDEV2';
- Query.ExecSQL;
- AssertEquals(0,query.RowsAffected);
- end;
- end;
- procedure TTestFieldTypes.TestStringsReplace;
- begin
- AssertEquals('dit is een string',StringsReplace('dit was een string',['was'],['is'],[]));
- AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['was'],['is'],[]));
- AssertEquals('dit is een string is een string',StringsReplace('dit was een string was een string',['was'],['is'],[rfReplaceAll]));
- AssertEquals('dit is een char is een char',StringsReplace('dit was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
- AssertEquals('dit is een string was een string',StringsReplace('dit was een string was een string',['string','was'],['char','is'],[]));
- AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll]));
- AssertEquals('dit Was een char is een char',StringsReplace('dit Was een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
- AssertEquals('dit wAs een char is een char',StringsReplace('dit wAs een string was een string',['was','string'],['is','char'],[rfReplaceAll]));
- AssertEquals('dit is een char is een char',StringsReplace('dit Was een sTring was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
- AssertEquals('dit is een char is een char',StringsReplace('dit wAs een STRING was een string',['was','string'],['is','char'],[rfReplaceAll,rfIgnoreCase]));
- AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['straat','string'],['sa','si'],[rfReplaceAll]));
- AssertEquals('dit was een si was een sa',StringsReplace('dit was een string was een straat',['string','straat'],['si','sa'],[rfReplaceAll]));
- AssertEquals('dit was een sing was een saat',StringsReplace('dit was een string was een straat',['str','string'],['s','si'],[rfReplaceAll]));
- AssertEquals('dit was een si was een saat',StringsReplace('dit was een string was een straat',['string','str'],['si','s'],[rfReplaceAll]));
- AssertEquals('dit was een string was een string',StringsReplace('dit was een string was een string',[''],['is'],[rfReplaceAll]));
- AssertEquals('dit een string een string',StringsReplace('dit was een string was een string',['was'],[''],[rfReplaceAll]));
- end;
- procedure TTestFieldTypes.TestCircularParams;
- begin
- with TSQLDBConnector(dbconnector) do
- begin
- Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int,vchar varchar(10))');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:vchar)';
- query.params[0].asinteger := 1;
- query.params[1].asinteger := 1;
- query.params[2].asstring := '$1 :id2 $';
- query.ExecSQL;
- query.sql.text := 'select * from FPDEV2';
- query.open;
- AssertEquals(1,query.fields[0].asinteger);
- AssertEquals(1,query.fields[1].asinteger);
- AssertEquals('$1 :id2 $',query.fields[2].AsString);
- query.close;
- end;
- end;
- procedure TTestFieldTypes.Test11Params;
- var i : integer;
- begin
- with TSQLDBConnector(dbconnector) do
- begin
- Connection.ExecuteDirect('create table FPDEV2 (id1 int, id2 int, id3 int, id4 int,id5 int,id6 int,id7 int,id8 int, id9 int, id10 int, id11 int)');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- Query.sql.Text := 'insert into FPDEV2 values(:id1,:id2,:id3,:id4,:id5,:id6,:id7,:id8,:id9,:id10,:id11)';
- for i := 0 to 10 do
- query.params[i].asinteger := 1;
- query.ExecSQL;
- query.sql.text := 'select * from FPDEV2';
- query.open;
- for i := 0 to 10 do
- AssertEquals(1,query.fields[i].asinteger);
- query.close;
- end;
- end;
- procedure TTestFieldTypes.TestBug9744;
- var i : integer;
- begin
- if SQLDbType in [interbase,postgresql] then Ignore('This test does not apply to this db-engine, since it has no double field-type');
- with TSQLDBConnector(DBConnector) do
- begin
- try
- Connection.ExecuteDirect('create table TTTOBJ ( ' +
- ' ID INT NOT NULL, ' +
- ' NAME VARCHAR(250), ' +
- ' PRIMARY KEY (ID) ' +
- ') ');
- Connection.ExecuteDirect('create table TTTXY ( ' +
- ' ID INT NOT NULL, ' +
- ' NP INT NOT NULL, ' +
- ' X DOUBLE, ' +
- ' Y DOUBLE, ' +
- ' PRIMARY KEY (ID,NP) ' +
- ') ');
- for i := 0 to 7 do
- begin
- connection.ExecuteDirect('insert into TTTOBJ(ID,NAME) values ('+inttostr(i)+',''A'+inttostr(i)+''')');
- connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',1,1,1)');
- connection.ExecuteDirect('insert into TTTXY(ID,NP,X,Y) values ('+inttostr(i)+',2,2,2)');
- end;
- Query.SQL.Text := 'select OBJ.ID, OBJ.NAME, count(XY.NP) as NPF from TTTOBJ as OBJ, TTTXY as XY where (OBJ.ID=XY.ID) group by OBJ.ID';
- query.Prepare;
- query.open;
- query.close;
- finally
- Connection.ExecuteDirect('drop table TTTXY');
- Connection.ExecuteDirect('drop table TTTOBJ');
- end
- end;
- end;
- procedure TTestFieldTypes.TestCrossStringDateParam;
- begin
- TestXXParamQuery(ftDate,'DATE',testDateValuesCount,True);
- end;
- procedure TTestFieldTypes.TestGetFieldNames;
- var FieldNames : TStringList;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- FieldNames := TStringList.Create;
- try
- if SQLDbType in MySQLdbTypes then
- Connection.GetFieldNames('FPDEV',FieldNames)
- else
- Connection.GetFieldNames('fpDEv',FieldNames);
- AssertEquals(2,FieldNames.Count);
- AssertEquals('ID',UpperCase(FieldNames[0]));
- AssertEquals('NAME',UpperCase(FieldNames[1]));
- finally
- FieldNames.Free;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestGetTables;
- var TableNames : TStringList;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- TableNames := TStringList.Create;
- try
- Connection.GetTableNames(TableNames);
- AssertTrue(TableNames.Count>0);
- AssertTrue(TableNames.IndexOf('FPDEV')>-1);
- AssertTrue(TableNames.IndexOf('FPDEV_FIELD')>-1);
- finally
- TableNames.Free;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestSQLFieldType(ADatatype : TFieldType; ASQLTypeDecl : string; ADataSize: integer; AGetSQLTextProc: TGetSQLTextProc; ACheckFieldValueProc: TCheckFieldValueProc);
- var
- i : byte;
- s: string;
- begin
- CreateTableWithFieldType(ADatatype,ASQLTypeDecl);
- TestFieldDeclaration(ADatatype,ADataSize);
- for i := 0 to testValuesCount-1 do
- begin
- s := AGetSQLTextProc(i);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (' + s + ')');
- end;
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- ACheckFieldValueProc(fields[0],i);
- Next;
- end;
- close;
- end;
- end;
- // Placed here, as long as bug 18702 is not solved
- function TestSQLClob_GetSQLText(const a: integer) : string;
- begin
- result := QuotedStr(testStringValues[a]);
- end;
- procedure TTestFieldTypes.TestSQLClob;
- procedure CheckFieldValue(AField:TField; a : integer);
- begin
- AssertEquals(testStringValues[a],AField.AsString);
- end;
- begin
- if SQLDbType=interbase then
- Ignore('This test does not apply to Interbase/Firebird, since it does not support CLOB fields');
- TestSQLFieldType(ftMemo, 'CLOB', 0, @TestSQLClob_GetSQLText, @CheckFieldValue);
- end;
- // Placed here, as long as bug 18702 is not solved
- function TestSQLLargeInt_GetSQLText(const a: integer) : string;
- begin
- result := IntToStr(testLargeIntValues[a]);
- end;
- procedure TTestFieldTypes.TestSQLLargeint;
- procedure CheckFieldValue(AField:TField; a : integer);
- begin
- AssertEquals(testLargeIntValues[a],AField.AsLargeInt);
- end;
- begin
- if sqlDBType=interbase then
- TestSQLFieldType(ftLargeint, 'BIGINT', 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue)
- else
- TestSQLFieldType(ftLargeint, 'LARGEINT', 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
- end;
- procedure TTestFieldTypes.TestUpdateIndexDefs;
- var ds : TSQLQuery;
- begin
- ds := DBConnector.GetNDataset(1) as TSQLQuery;
- ds.Prepare;
- ds.ServerIndexDefs.Update;
- AssertEquals(1,ds.ServerIndexDefs.count);
- AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
- Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
- ds.ServerIndexDefs.Update;
- AssertEquals(1,ds.ServerIndexDefs.count);
- AssertTrue(CompareText('ID',ds.ServerIndexDefs[0].Fields)=0);
- Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
- end;
- procedure TTestFieldTypes.TestMultipleFieldPKIndexDefs;
- var ds : TSQLQuery;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (' +
- ' ID1 INT NOT NULL, ' +
- ' ID2 INT NOT NULL, ' +
- ' NAME VARCHAR(50), ' +
- ' PRIMARY KEY (ID1, ID2) ' +
- ') ');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- if SQLDbType=interbase then TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- ds := TSQLDBConnector(DBConnector).Query;
- ds.sql.Text:='select * from FPDEV2';
- ds.Prepare;
- ds.ServerIndexDefs.Update;
- AssertEquals(1,ds.ServerIndexDefs.count);
- AssertTrue(SameText('ID1;ID2',ds.ServerIndexDefs[0].Fields));
- Asserttrue(ds.ServerIndexDefs[0].Options=[ixPrimary,ixUnique]);
- end;
- procedure TTestFieldTypes.TestSetBlobAsMemoParam;
- begin
- TestSetBlobAsParam(0);
- end;
- procedure TTestFieldTypes.TestSetBlobAsBlobParam;
- begin
- TestSetBlobAsParam(2);
- end;
- procedure TTestFieldTypes.TestTemporaryTable;
- begin
- if SQLDbType=interbase then Ignore('This test does not apply to Interbase/Firebird, since it doesn''t support temporary tables');
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- SQL.Add('CREATE TEMPORARY TABLE TEMP1 (id int)');
- ExecSQL;
- SQL.Text := 'INSERT INTO TEMP1(id) values (5)';
- ExecSQL;
- SQL.Text := 'SELECT * FROM TEMP1';
- Open;
- AssertEquals(5,fields[0].AsInteger);
- Close;
- end;
- end;
- procedure TTestFieldTypes.TestGetIndexDefs;
- var ds : TSQLQuery;
- inddefs : TIndexDefs;
- begin
- ds := DBConnector.GetNDataset(1) as TSQLQuery;
- ds.Open;
- AssertEquals(1,ds.ServerIndexDefs.count);
- inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary]);
- AssertEquals(1,inddefs.count);
- AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
- Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
- inddefs.Free;
- inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary,ixUnique]);
- AssertEquals(1,inddefs.count);
- AssertTrue(CompareText('ID',inddefs[0].Fields)=0);
- Asserttrue(inddefs[0].Options=[ixPrimary,ixUnique]);
- inddefs.Free;
- inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixDescending]);
- AssertEquals(0,inddefs.count);
- inddefs.Free;
- end;
- procedure TTestFieldTypes.TestDblQuoteEscComments;
- begin
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- SQL.Add('select * from FPDEV where name=''test '''' and :ThisIsNotAParameter ''');
- open;
- close;
- end;
- end;
- procedure TTestFieldTypes.TestParametersAndDates;
- // See bug 7205
- var ADateStr : String;
- begin
- if SQLDbType in [interbase,mysql40,mysql41,mysql50,sqlite3] then Ignore('This test does not apply to this sqldb-connection type, since it doesn''t use semicolons for casts');
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- sql.add('select now()::date as current_date where 1=1');
- open;
- first;
- ADateStr:=fields[0].asstring; // return the correct date
- // writeln(fields[0].asstring);
- close;
- sql.clear;
- sql.add('select now()::date as current_date where cast(1 as integer) = :PARAM1');
- params.parambyname('PARAM1').asinteger:= 1;
- open;
- first;
- AssertEquals(ADateStr,fields[0].asstring); // return invalid date
- // writeln(fields[0].asstring);
- close;
- end
- end;
- procedure TTestFieldTypes.TestExceptOnsecClose;
- var passed : boolean;
- begin
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- SQL.Add('select * from FPDEV');
- Open;
- close;
- SQL.Clear;
- SQL.Add('select blaise from FPDEV');
- passed := false;
- try
- open;
- except
- on E: Exception do
- passed := (E.ClassType.InheritsFrom(EDatabaseError))
- end;
- AssertTrue(passed);
- Close;
- end;
- end;
- procedure TTestFieldTypes.TestErrorOnEmptyStatement;
- var PassException : boolean;
- begin
- PassException:=False;
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.Text := '';
- try
- Open;
- except
- on E:EDatabaseError do
- if Pos(SErrNoStatement,E.Message) > 0 then
- PassException := True;
- end;
- AssertTrue(PassException);
- end;
- end;
- initialization
- if uppercase(dbconnectorname)='SQL' then RegisterTest(TTestFieldTypes);
- end.
|