12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426 |
- unit TestFieldTypes;
- {$mode objfpc}{$H+}
- {$modeswitch nestedprocvars}
- interface
- uses
- Classes, SysUtils, fpcunit, 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;
- ParamValuesCount : integer); overload;
- procedure TestXXParamQuery(ADataType : TFieldType; ASQLTypeDecl : string;
- ParamValuesCount : integer; const ParamValues: array of string; Cross : boolean = False); overload;
- procedure TestSetBlobAsParam(asWhat : integer);
- protected
- procedure SetUp; override;
- procedure TearDown; override;
- procedure RunTest; override;
- published
- // Fields (field recognition):
- procedure TestInt;
- procedure TestTinyint;
- procedure TestNumeric;
- procedure TestFloat;
- procedure TestDate;
- procedure TestDateTime; // bug 6925
- procedure TestString;
- procedure TestUnlVarChar;
- procedure TestBlob;
- procedure TestChangeBlob;
- procedure TestBlobGetText;
- procedure TestBlobSize;
- procedure TestSQLClob;
- procedure TestSQLLargeint;
- procedure TestSQLInterval;
- procedure TestSQLIdentity;
- procedure TestSQLReal;
- procedure TestStringLargerThen8192;
- procedure TestInsertLargeStrFields; // bug 9600
- procedure TestLargeRecordSize;
- procedure TestNullValues;
- procedure TestAggregates;
- procedure TestBug9744;
- // Field names:
- procedure TestDoubleFieldNames; // bug 8457
- procedure TestNumericFieldNames; // Bug9661
- procedure TestApplyUpdFieldNames; // Bug 12275
- // Parsing SQL:
- procedure TestParseJoins; // bug 10148
- procedure TestParseUnion; // bug 8442
- procedure TestClearUpdateableStatus;
- procedure TestReadOnlyParseSQL; // bug 9254
- procedure TestDblQuoteEscComments;
- // ApplyUpdates:
- procedure TestpfInUpdateFlag; // bug 7565
- // Parameters:
- procedure TestParamQuery;
- procedure TestStringParamQuery;
- procedure TestFixedStringParamQuery;
- procedure TestDateParamQuery;
- procedure TestCrossStringDateParam;
- procedure TestSmallIntParamQuery;
- procedure TestIntParamQuery;
- procedure TestLargeIntParamQuery;
- procedure TestTimeParamQuery;
- procedure TestDateTimeParamQuery;
- procedure TestFmtBCDParamQuery;
- Procedure TestFmtBCDParamQuery2; // Bug 27077
- procedure TestFloatParamQuery;
- procedure TestCurrencyParamQuery;
- procedure TestBCDParamQuery;
- procedure TestBytesParamQuery;
- procedure TestVarBytesParamQuery;
- procedure TestBooleanParamQuery;
- procedure TestBlobParamQuery;
- procedure TestSetBlobAsMemoParam;
- procedure TestSetBlobAsBlobParam;
- procedure TestSetBlobAsStringParam;
- procedure Test11Params;
- procedure TestCircularParams;
- procedure TestNonNullableParams;
- procedure TestParametersAndDates;
- // Opening non-select statements, which returns result set:
- procedure TestInsertReturningQuery;
- procedure TestOpenStoredProc;
- procedure TestOpenSpecialStatements;
- procedure TestErrorOnEmptyStatement;
- procedure TestExceptOnsecClose;
- procedure TestServerFilter; // bug 15456
- procedure TestRowsAffected; // bug 9758
- procedure TestLocateNull;
- procedure TestLocateOnMoreRecords;
- procedure TestRefresh;
- // SchemaType tests:
- procedure TestTableNames;
- procedure TestGetTables;
- procedure TestFieldNames;
- procedure TestGetFieldNames;
- procedure TestUpdateIndexDefs;
- procedure TestMultipleFieldPKIndexDefs;
- procedure TestGetIndexDefs;
- // Connection:
- procedure TestEmptyUpdateQuery; // bug 13654
- procedure TestTemporaryTable;
- procedure TestQueryAfterReconnect; // bug 16438
- procedure TestStringsReplace;
- 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',
- '1899-12-29',
- '1899-12-30',
- '1899-12-31',
- '1900-01-01',
- '1800-03-30',
- '1754-06-04',
- '1650-05-10',
- '0904-04-12',
- '0199-07-09',
- '0001-01-01'
- );
- testBlobValuesCount = 6;
- testBlobValues : Array[0..testBlobValuesCount-1] of ansistring = (
- 'Test this Blob', // common value
- '', // empty value
- 'a'#0'b'#13#10#1'c', // binary data
- '''":a', // single quotes
- '\''\', // backslash
- '\n'#13'\0ab''c'
- );
- testBytesValuesCount = 5;
- testVarBytesValuesCount = 8;
- testBytesValues : Array[0..testVarBytesValuesCount-1] of shortstring = (
- #1#0#1#0#1, #0#0#1#0#1, #0''''#13#0#1, '\'#0'"\'#13, #13#13#0#10#10,
- '', #0, #0#1#2#3#4#5#6#7#8#9
- );
- procedure TTestFieldTypes.CreateTableWithFieldType(ADatatype: TFieldType;
- ASQLTypeDecl: string);
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- Connection.ExecuteDirect('create table FPDEV2 (FT ' +ASQLTypeDecl+ ')');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- CommitDDL;
- end;
- 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(SameText('FT',Fields[0].FieldName));
- AssertEquals('DataSize', ADataSize, Fields[0].DataSize);
- AssertEquals('DataType', ord(ADatatype), ord(Fields[0].DataType));
- Close;
- 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.TestTinyint;
- const
- testValuesCount = 5;
- testValues : Array[0..testValuesCount-1] of byte = (0,1,127,128,255);
- var
- datatype: string;
- fieldtype: TFieldType;
- i: integer;
- begin
- case SQLServerType of
- ssMSSQL:
- begin
- datatype := 'TINYINT';
- fieldtype := ftWord;
- end;
- ssMySQL:
- begin
- datatype := 'TINYINT UNSIGNED';
- fieldtype := ftWord;
- end;
- ssOracle:
- begin
- datatype := 'NUMBER(3)';
- fieldtype := ftSmallint;
- end;
- ssSQLite:
- begin
- datatype := 'TINYINT';
- fieldtype := ftSmallint;
- end;
- else
- begin
- fieldtype := ftSmallint;
- datatype := FieldtypeDefinitions[fieldtype];
- end;
- end;
- CreateTableWithFieldType(fieldtype, datatype);
- TestFieldDeclaration(fieldtype, sizeof(Smallint));
- with TSQLDBConnector(DBConnector) do
- begin
- Query.Open;
- for i := 0 to testValuesCount-1 do
- Query.AppendRecord([testValues[i]]);
- Query.ApplyUpdates;
- Query.Close;
- for i := 0 to testValuesCount-1 do
- ExecuteDirect('insert into FPDEV2 (FT) values (' + inttostr(testValues[i]) + ')');
- Query.Open;
- for i := 0 to testValuesCount*2-1 do
- begin
- AssertEquals(testValues[i mod testValuesCount], Query.Fields[0].AsInteger);
- Query.Next;
- end;
- Query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestNumeric;
- const
- testValuesCount = 13;
- testValues4 : Array[0..testValuesCount-1] of currency = (-99.99,-12.34,-10.2,-10,-0.5,-0.01,0,0.01,0.5,10,10.2,12.34,99.99);
- testValues9 : Array[0..testValuesCount-1] of currency = (-123456.789,-10000,-1875.25,-10,-0.5,-0.001,0,0.001,0.5,10,1875.25,10000,123456.789);
- FieldTypes: array [0..7] of TFieldType = (ftBCD, ftBCD, ftBCD, ftFmtBCD, ftLargeInt, ftFmtBCD, ftFmtBCD, ftFmtBCD);
- FieldSizes: array [0..7] of integer = (4,2,3,5,0,3,5,0); //scale for FieldTypes
- var
- i,d : integer;
- s,s4,s9 : string;
- t : TFieldType;
- begin
- with TSQLDBConnector(DBConnector) do begin
- if SQLConnType = INTERBASE then
- begin
- //Interbase internal storage of exact numeric data types based on precision:
- // 1-4 (smallint), 5-9 (integer), 10-18 (int64)
- s := ''; //Interbase supports precision up to 18 only
- FieldTypes[5] := ftBCD; //ATM TIBConnection incorrectly maps NUMERIC(18,3) to ftBCD
- end
- else
- s := ', N19_0 NUMERIC(19,0)';
- Connection.ExecuteDirect('create table FPDEV2 (FT NUMERIC(18,4), N4_2 NUMERIC(4,2), N9_3 NUMERIC(9,3), N9_5 NUMERIC(9,5), N18_0 NUMERIC(18,0), N18_3 NUMERIC(18,3), N18_5 NUMERIC(18,5)' + s + ')');
- CommitDDL;
- with Query do
- begin
- SQL.Text := 'select * from FPDEV2';
- Open;
- for i := 0 to FieldCount-1 do
- begin
- case Fields[i].DataType of
- ftBCD: d := sizeof(Currency);
- ftFmtBCD: d := sizeof(TBCD);
- ftLargeInt: d := sizeof(int64);
- else d := 0;
- end;
- t := FieldTypes[i];
- if t = ftLargeInt then t := ftFmtBCD; //acceptable alternative
- AssertEquals(Fields[i].DataSize, d);
- AssertTrue(Fields[i].DataType in [FieldTypes[i], t]);
- AssertEquals(Fields[i].Size, FieldSizes[i]);
- end;
- Close;
- end;
- for i := 0 to testValuesCount-1 do
- begin
- s4 := CurrToStrF(testValues4[i],ffFixed,2,DBConnector.FormatSettings);
- s9 := CurrToStrF(testValues9[i],ffFixed,3,DBConnector.FormatSettings);
- Connection.ExecuteDirect(format('insert into FPDEV2 (N4_2,N9_5,FT,N9_3,N18_3,N18_5) values (%s,%s,%s,%s,%s,%s)', [s4,s4,s9,s9,s9,s9]));
- end;
- with Query do
- begin
- Open;
- for i := 0 to testValuesCount-1 do
- begin
- AssertEquals(testValues4[i], Fields[1].AsCurrency);
- AssertEquals(testValues4[i], Fields[3].AsCurrency);
- AssertEquals(testValues9[i], Fields[0].AsCurrency);
- AssertEquals(testValues9[i], Fields[2].AsCurrency);
- AssertEquals(testValues9[i], Fields[5].AsCurrency);
- AssertEquals(testValues9[i], Fields[6].AsCurrency);
- Next;
- end;
- Close;
- end;
- 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],DBConnector.FormatSettings) + ')');
- 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.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,10*DBConnector.CharSize+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);
- AssertEquals('IsNull', False, Fields[0].IsNull); // '' is not NULL
- 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 SQLServerType<>ssPostgreSQL then Ignore('This test only applies 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 SQLConnType=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] + ''')');
- 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.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
- '2100-01-01 01:01:01',
- '1903-04-02 01:04:02',
- '1900-01-01',
- '1899-12-31',
- '1899-12-30',
- '1899-12-29',
- '1899-12-30 18:00:51',
- '1899-12-30 04:00:51',
- '1899-12-29 04:00:51',
- '1899-12-29 18:00:51',
- '1815-09-24 03:47:22',
- '1800-03-30',
- '1754-06-04',
- '1650-05-10', // MS SQL 2005 doesn't support datetimes before 1753
- '1400-02-03 12:21:53',
- '1333-02-03 21:44:21',
- '0904-04-12',
- '0354-11-20 21:25:15',
- '0199-07-09',
- '0001-01-01'
- );
- var
- i : byte;
- begin
- CreateTableWithFieldType(ftDateTime,FieldtypeDefinitions[ftDateTime]);
- TestFieldDeclaration(ftDateTime,8);
- for i := 0 to testValuesCount-1 do
- if SQLConnType=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 testValuesCount-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.TestBlob;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TestFieldDeclaration(ftBlob,0);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test this blob'')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertEquals('Test this blob',fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestChangeBlob;
- var s : string;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('create table FPDEV2 (ID int,FT '+FieldtypeDefinitions[ftblob]+')');
- TSQLDBConnector(DBConnector).CommitDDL;
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (ID,FT) values (1,''Test this blob'')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.clear;
- sql.add('select * from FPDEV2');
- Open;
- AssertEquals('Test this blob', Fields[1].AsString);
- Fields[1].ProviderFlags := [pfInUpdate]; // Blob is not in the where
- UpdateMode := upWhereAll;
- Edit;
- s := 'This blob has changed!';
- Fields[1].AsString := s;
- AssertEquals(s, Fields[1].AsString); // test before Post
- Cancel;
- AssertEquals('After Cancel', 'Test this blob', Fields[1].AsString); // original value
- Append; // Blob is null
- Fields[1].AsString := s; // Null flag must be unset
- AssertEquals(s, Fields[1].AsString);
- Fields[1].Clear;
- AssertTrue('Clear', Fields[1].IsNull);
- Cancel;
- Edit;
- With CreateBlobStream(Fields[1], bmWrite) do
- begin
- s := 'This blob has changed!';
- WriteBuffer(Pointer(s)^,Length(s));
- Post;
- Free;
- end;
- AssertEquals('After Post', s, Fields[1].AsString);
- ApplyUpdates(0);
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining; // For debug-purposes
- Close;
- Open;
- AssertEquals(s, 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 this blob'')');
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (Null)');
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertFalse(fields[0].IsNull);
- AssertEquals('(BLOB)',fields[0].DisplayText);
- AssertEquals('Test this blob',fields[0].AsString);
- Next;
- AssertTrue(fields[0].IsNull);
- AssertEquals('(blob)',fields[0].Text);
- AssertEquals('',fields[0].AsString);
- close;
- end;
- end;
- procedure TTestFieldTypes.TestBlobSize;
- const
- TestValue: string = 'Test this blob';
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values ('''+TestValue+''')');
- with TSQLDBConnector(DBConnector).Query do
- begin
- sql.text := 'select * from FPDEV2';
- Open;
- AssertEquals(length(TestValue),TBlobField(fields[0]).BlobSize);
- close;
- 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;
- var datatype: string;
- begin
- if SQLConnType=sqlite3 then
- datatype:='CLOB'
- else
- datatype:=FieldtypeDefinitions[ftMemo];
- TestSQLFieldType(ftMemo, datatype, 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;
- var datatype: string;
- begin
- if SQLConnType=sqlite3 then
- datatype:='LARGEINT'
- else
- datatype:='BIGINT';
- TestSQLFieldType(ftLargeint, datatype, 8, @TestSQLLargeint_GetSQLText, @CheckFieldValue);
- end;
- var testIntervalValuesCount: integer;
- const testIntervalValues: array[0..5] of shortstring = ('00:00:00.000','00:00:01.000','23:59:59.000','99:59:59.000','838:59:59.000','1000:00:00.000');
- // Placed here, as long as bug 18702 is not solved
- function TestSQLInterval_GetSQLText(const a: integer) : string;
- begin
- if a < testIntervalValuesCount then
- Result := QuotedStr(testIntervalValues[a])
- else
- Result := 'NULL'
- end;
- procedure TTestFieldTypes.TestSQLInterval;
- procedure CheckFieldValue(AField: TField; a: integer);
- begin
- if a < testIntervalValuesCount then
- AssertEquals(testIntervalValues[a], DateTimeToTimeString(AField.AsDateTime))
- else
- AssertTrue(AField.IsNull);
- end;
- var datatype: string;
- begin
- if SQLConnType = postgresql then
- begin
- datatype:='INTERVAL';
- testIntervalValuesCount := 6;
- end
- else
- begin
- datatype:=FieldtypeDefinitions[ftTime];
- if datatype = '' then
- Ignore(STestNotApplicable);
- if SQLServerType = ssSQLite then
- testIntervalValuesCount := 6
- else if SQLServerType = ssMySQL then
- // MySQL ODBC driver prior 5.2.6 doesn't correctly handles time values >= '100:00:00'
- testIntervalValuesCount := 5
- else
- testIntervalValuesCount := 3;
- end;
- TestSQLFieldType(ftTime, datatype, sizeof(TDateTime), @TestSQLInterval_GetSQLText, @CheckFieldValue);
- end;
- procedure TTestFieldTypes.TestSQLIdentity;
- var datatype, values: string;
- fieldtype: TFieldType;
- i: integer;
- updatable: boolean;
- begin
- case SQLServerType of
- ssMySQL:
- begin
- datatype:='INT AUTO_INCREMENT PRIMARY KEY';
- values:='VALUES(DEFAULT)';
- fieldtype:=ftAutoInc;
- updatable:=true;
- end;
- ssSQLite:
- begin
- datatype:='INTEGER PRIMARY KEY';
- values:='DEFAULT VALUES';
- fieldtype:=ftAutoInc;
- updatable:=true;
- end;
- ssPostgreSQL:
- begin
- datatype:='SERIAL';
- values:='DEFAULT VALUES';
- if SQLConnType = ODBC then
- fieldtype:=ftAutoInc
- else
- fieldtype:=ftInteger;
- updatable:=true;
- end;
- ssMSSQL, ssSybase:
- begin
- datatype:='INTEGER IDENTITY';
- values:='DEFAULT VALUES';
- fieldtype:=ftAutoInc;
- updatable:=false;
- end
- else
- Ignore(STestNotApplicable);
- end;
- CreateTableWithFieldType(fieldtype, datatype);
- TestFieldDeclaration(fieldtype, sizeof(longint));
- for i := 1 to 3 do
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 '+values);
- with TSQLDBConnector(DBConnector).Query do
- begin
- Open;
- AssertTrue(Locate('FT',1,[])); // bug 17624
- for i := 1 to 3 do
- begin
- AssertEquals(i, Fields[0].AsInteger);
- Next;
- end;
- // some databases (like MS SQL Server) do not allow updating identity columns
- AssertEquals('ReadOnly', Fields[0].ReadOnly, not updatable);
- // some databases (like PostgreSQL, MySQL) allow inserting explicit values and updating auto incrementing columns
- if updatable then
- begin
- UpdateMode:=upWhereAll; // if there is no PK for FPDEV2 table
- // updating:
- Last;
- while not Bof do
- begin
- Edit;
- Fields[0].AsInteger:=Fields[0].AsInteger+2;
- Post;
- Prior;
- end;
- // inserting:
- Append;
- Fields[0].AsInteger:=6;
- Post;
- ApplyUpdates;
- end;
- Close;
- end;
- end;
- function TestSQLReal_GetSQLText(const i: integer) : string;
- begin
- if i < 20 then // first 20 values fit into MySQL FLOAT data type
- Result := FloatToStr(testFloatValues[i], DBConnector.FormatSettings)
- else
- Result := 'NULL';
- end;
- procedure TTestFieldTypes.TestSQLReal;
- procedure CheckFieldValue(AField:TField; i: integer);
- begin
- if i < 20 then
- AssertEquals(testFloatValues[i], AField.AsFloat)
- else
- AssertTrue(AField.IsNull);
- end;
- var datatype: string;
- begin
- case SQLServerType of
- ssFirebird, ssInterbase,
- ssMySQL:
- datatype:='FLOAT';
- ssOracle:
- datatype:='BINARY_FLOAT';
- else
- datatype:='REAL';
- end;
- TestSQLFieldType(ftFloat, datatype, sizeof(double), @TestSQLReal_GetSQLText, @CheckFieldValue);
- end;
- procedure TTestFieldTypes.TestStringLargerThen8192;
- // See also: TestInsertLargeStrFields
- var
- s : string;
- i : integer;
- begin
- // Firebird has limit 32765 bytes, so this is 8191 characters when using UNICODE character set
- CreateTableWithFieldType(ftString,'VARCHAR(9000)');
- TestFieldDeclaration(ftString,9000*DBConnector.CharSize+1);
- 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.TestInsertLargeStrFields;
- // See also: TestStringLargerThen8192
- var
- FieldValues: array [1..4] of string;
- i,l1,l2: integer;
- begin
- FieldValues[1] := 'test1'; // string length < 8192 (dsMaxStringSize)
- FieldValues[2] := StringOfChar('a', 8192); // string length = 8192 (dsMaxStringSize)
- FieldValues[3] := StringOfChar('b', 16000); // string length > 8192 (dsMaxStringSize)
- FieldValues[4] := StringOfChar('c', 17000); // string length > Field.Size
- with TSQLDBConnector(DBConnector) do
- begin
- Connection.ExecuteDirect( 'create table FPDEV2 (' +
- ' ID INT NOT NULL , ' +
- ' F1 VARCHAR(8192), ' +
- ' F2 VARCHAR(16000),' +
- 'primary key (ID) )');
- // Firebird/Interbase need a commit after a DDL statement. Not necessary for the other connections
- TSQLDBConnector(DBConnector).CommitDDL;
- query.sql.Text:='select * from FPDEV2';
- Query.Open;
- for i:=1 to high(FieldValues) do
- Query.InsertRecord([i, FieldValues[i], FieldValues[i]]);
- Query.ApplyUpdates;
- Query.Close;
- Query.Open;
- for i:=1 to high(FieldValues) do
- begin
- l1:=length(FieldValues[i]);
- if l1 > 8192 then l1 := 8192;
- l2:=length(FieldValues[i]);
- if l2 > 16000 then l2 := 16000;
- AssertEquals(l1, length(Query.FieldByName('F1').AsString));
- AssertEquals(l2, length(Query.FieldByName('F2').AsString));
- AssertEquals(copy(FieldValues[i],1,l1), Query.FieldByName('F1').AsString);
- AssertEquals(copy(FieldValues[i],1,l2), Query.FieldByName('F2').AsString);
- Query.Next;
- end;
- Query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestLargeRecordSize;
- // probably tests situation, where total record size > 64K (TDataSet.RecordSize returns word value)
- 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
- TSQLDBConnector(DBConnector).CommitDDL;
- 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 POVRŠINA'',''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.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).CommitDDL;
- 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.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).CommitDDL;
- 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.TestBug9744;
- var i : integer;
- begin
- // Tests rev.8703: "Fixed MySQL ftLargeInt support"; count() returns BIGINT values
- 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, ' +
- ' PRIMARY KEY (ID,NP)' +
- ') ');
- Transaction.CommitRetaining;
- 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) values ('+inttostr(i)+',1)');
- connection.ExecuteDirect('insert into TTTXY(ID,NP) values ('+inttostr(i)+',2)');
- end;
- Query.SQL.Text := 'select OBJ.ID, OBJ.NAME, count(XY.NP) as NPF from TTTOBJ OBJ, TTTXY XY where OBJ.ID=XY.ID group by OBJ.ID, OBJ.NAME';
- query.Prepare;
- query.open;
- query.close;
- finally
- Connection.ExecuteDirect('drop table TTTXY');
- Connection.ExecuteDirect('drop table TTTOBJ');
- Transaction.CommitRetaining;
- 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.TestNumericFieldNames;
- 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).CommitDDL;
- 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).CommitDDL;
- 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.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;
- AssertFalse(CanModify);
- Close;
- SQL.Text:='select T1.NAME from FPDEV T1,FPDEV T2 where T1.ID=T2.ID';
- Open;
- AssertFalse(CanModify);
- 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.TestClearUpdateableStatus;
- // Test if CanModify is correctly disabled in case of a select query without
- // a from-statement.
- begin
- if not (SQLServerType in [ssMySQL]) then Ignore('This test only applies 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; // field "ID" from UNION can be marked as ReadOnly
- 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.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.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 := IdentifierCase('ID');
- AFld1.DataSet := ds;
- AFld1.ProviderFlags := AFld1.ProviderFlags + [pfInKey];
- AFld2 := TStringField.Create(ds);
- AFld2.FieldName := IdentifierCase('NAME');
- AFld2.DataSet := ds;
- AFld3 := TIntegerField.Create(ds);
- AFld3.FieldName := 'CALCFLD';
- AFld3.DataSet := ds;
- Afld3.FieldKind := fkCalculated;
- AFld3.ProviderFlags := []; // do not include calculated fields into generated sql insert/update
- 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.TestParamQuery;
- // Tests running insert queries using parameters
- const
- DecoyFieldData1='decoytest';
- DecoyFieldData2=':decoy ::test $decoy2 $$2';
- 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).CommitDDL;
- 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,'''+DecoyFieldData1+''')');
- 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,'''+DecoyFieldData2+''')');
- 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(DecoyFieldData1,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(DecoyFieldData2,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.TestSmallIntParamQuery;
- begin
- TestXXParamQuery(ftSmallInt,FieldtypeDefinitions[ftSmallInt],testValuesCount);
- end;
- procedure TTestFieldTypes.TestIntParamQuery;
- begin
- TestXXParamQuery(ftInteger,'INT',testIntValuesCount);
- end;
- procedure TTestFieldTypes.TestLargeIntParamQuery;
- begin
- TestXXParamQuery(ftLargeInt,FieldtypeDefinitions[ftLargeInt],testValuesCount);
- end;
- procedure TTestFieldTypes.TestFmtBCDParamQuery;
- begin
- TestXXParamQuery(ftFMTBcd, FieldtypeDefinitions[ftFMTBcd], testValuesCount, testFmtBCDValues);
- end;
- Procedure TTestFieldTypes.TestFmtBCDParamQuery2;
- begin
- // This test tests FmtBCD params with smaller precision, which fits into INT32
- // TestFmtBCDParamQuery tests FmtBCD params with bigger precision, which fits into INT64
- TestXXParamQuery(ftFMTBcd, 'NUMERIC(9,5)', 2, ['1234','1234.56781']);
- end;
- procedure TTestFieldTypes.TestDateParamQuery;
- begin
- TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount);
- end;
- procedure TTestFieldTypes.TestCrossStringDateParam;
- begin
- TestXXParamQuery(ftDate,FieldtypeDefinitions[ftDate],testDateValuesCount,[],True);
- end;
- procedure TTestFieldTypes.TestTimeParamQuery;
- begin
- TestXXParamQuery(ftTime,FieldtypeDefinitions[ftTime],testValuesCount);
- end;
- procedure TTestFieldTypes.TestDateTimeParamQuery;
- begin
- TestXXParamQuery(ftDateTime,FieldtypeDefinitions[ftDateTime],testValuesCount);
- end;
- procedure TTestFieldTypes.TestFloatParamQuery;
- begin
- TestXXParamQuery(ftFloat,FieldtypeDefinitions[ftFloat],testFloatValuesCount);
- end;
- procedure TTestFieldTypes.TestCurrencyParamQuery;
- begin
- TestXXParamQuery(ftCurrency,FieldtypeDefinitions[ftCurrency],testValuesCount);
- end;
- procedure TTestFieldTypes.TestBCDParamQuery;
- begin
- TestXXParamQuery(ftBCD,'NUMERIC(10,4)',testBCDValuesCount);
- end;
- procedure TTestFieldTypes.TestBytesParamQuery;
- begin
- TestXXParamQuery(ftBytes, FieldtypeDefinitions[ftBytes], testBytesValuesCount, [], True);
- end;
- procedure TTestFieldTypes.TestVarBytesParamQuery;
- begin
- TestXXParamQuery(ftVarBytes, FieldtypeDefinitions[ftVarBytes], testVarBytesValuesCount, [], not(SQLServerType in [ssMSSQL, ssSybase]));
- end;
- procedure TTestFieldTypes.TestBooleanParamQuery;
- begin
- TestXXParamQuery(ftBoolean, FieldtypeDefinitions[ftBoolean], testValuesCount);
- end;
- procedure TTestFieldTypes.TestBlobParamQuery;
- begin
- TestXXParamQuery(ftBlob, FieldtypeDefinitions[ftBlob], testBlobValuesCount);
- end;
- procedure TTestFieldTypes.TestStringParamQuery;
- begin
- TestXXParamQuery(ftString,'VARCHAR(10)',testValuesCount);
- end;
- procedure TTestFieldTypes.TestFixedStringParamQuery;
- begin
- TestXXParamQuery(ftFixedChar,'CHAR(10)',testValuesCount);
- end;
- procedure TTestFieldTypes.TestXXParamQuery(ADataType : TFieldType; ASQLTypeDecl : string;
- ParamValuesCount : integer);
- begin
- TestXXParamQuery(ADataType, ASQLTypeDecl, ParamValuesCount, [], False);
- end;
- procedure TTestFieldTypes.TestXXParamQuery(ADataType : TFieldType; ASQLTypeDecl : string;
- ParamValuesCount : integer; const ParamValues: array of string; Cross : boolean = False);
- var i : integer;
- begin
- if ASQLTypeDecl = '' then
- Ignore('Fields of the type ' + FieldTypeNames[ADatatype] + ' are not supported by this sqldb-connection type');
- 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
- TSQLDBConnector(DBConnector).CommitDDL;
- with TSQLDBConnector(DBConnector).Query do
- begin
- 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 ParamValuesCount-1 do
- begin
- Params.ParamByName('id').AsInteger := i;
- case ADataType of
- ftSmallInt: Params.ParamByName('field1').AsSmallInt := testSmallIntValues[i];
- ftInteger : Params.ParamByName('field1').AsInteger := testIntValues[i];
- ftLargeInt: Params.ParamByName('field1').AsLargeInt := testLargeIntValues[i];
- ftBoolean : Params.ParamByName('field1').AsBoolean := testBooleanValues[i];
- ftFloat : Params.ParamByName('field1').AsFloat := testFloatValues[i];
- ftCurrency: Params.ParamByName('field1').AsCurrency:= testCurrencyValues[i];
- ftBCD : Params.ParamByName('field1').AsBCD := testBCDValues[i];
- ftFixedChar,
- ftString : Params.ParamByName('field1').AsString := testValues[ADataType,i];
- ftTime : Params.ParamByName('field1').AsTime := TimeStringToDateTime(testTimeValues[i]);
- ftDate : if cross then
- Params.ParamByName('field1').AsString:= testDateValues[i]
- else
- Params.ParamByName('field1').AsDate := StrToDate(testDateValues[i],'yyyy/mm/dd','-');
- ftDateTime: Params.ParamByName('field1').AsDateTime := StrToDateTime(testValues[ADataType,i], DBConnector.FormatSettings);
- ftFMTBcd : Params.ParamByName('field1').AsFMTBCD := StrToBCD(ParamValues[i], DBConnector.FormatSettings);
- ftBlob : Params.ParamByName('field1').AsBlob := BytesOf(testBlobValues[i]);
- ftBytes : if cross then
- Params.ParamByName('field1').Value := StringToByteArray(testBytesValues[i])
- else
- Params.ParamByName('field1').AsBytes := BytesOf(testBytesValues[i]);
- ftVarBytes: if cross then
- Params.ParamByName('field1').AsString := testBytesValues[i]
- else
- Params.ParamByName('field1').AsBytes := BytesOf(testBytesValues[i]);
- else
- AssertTrue('no test for paramtype available',False);
- end;
- ExecSQL;
- end;
- // test NULL parameter value
- Params.ParamByName('id').AsInteger := ParamValuesCount;
- Params.ParamByName('field1').Clear;
- ExecSQL;
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- sql.clear;
- sql.append('select * from FPDEV2 order by ID');
- open;
- for i := 0 to ParamValuesCount-1 do
- begin
- AssertEquals(i,FieldByName('ID').AsInteger);
- case ADataType of
- ftSmallInt : AssertEquals(testSmallIntValues[i],FieldByName('FIELD1').AsInteger);
- ftInteger : AssertEquals(testIntValues[i],FieldByName('FIELD1').AsInteger);
- ftLargeInt : AssertEquals(testLargeIntValues[i],FieldByName('FIELD1').AsLargeInt);
- ftBoolean : AssertEquals(testBooleanValues[i],FieldByName('FIELD1').AsBoolean);
- ftFloat : AssertEquals(testFloatValues[i],FieldByName('FIELD1').AsFloat);
- ftCurrency : AssertEquals(testCurrencyValues[i],FieldByName('FIELD1').AsFloat,0); // TCurrencyField uses double data type (not currency) to store values!
- 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],DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
- ftDateTime : AssertEquals(testValues[ADataType,i], DateTimeToStr(FieldByName('FIELD1').AsDateTime, DBConnector.FormatSettings));
- ftFMTBcd : AssertEquals(ParamValues[i], BCDToStr(FieldByName('FIELD1').AsBCD, DBConnector.FormatSettings));
- ftBlob : AssertEquals(testBlobValues[i], FieldByName('FIELD1').AsString);
- ftVarBytes,
- ftBytes : AssertEquals(testBytesValues[i], shortstring(FieldByName('FIELD1').AsString));
- else
- AssertTrue('no test for paramtype available',False);
- end;
- AssertEquals('IsNull', False, FieldByName('FIELD1').IsNull);
- Next;
- end;
- AssertTrue('Expected IsNull', FieldByName('FIELD1').IsNull);
- AssertTrue('Expected Null Variant', VarIsNull(FieldByName('FIELD1').AsVariant));
- close;
- end;
- TSQLDBConnector(DBConnector).Transaction.CommitRetaining;
- end;
- procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer);
- var i: integer;
- begin
- CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]);
- TestFieldDeclaration(ftBlob,0);
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Text := 'insert into FPDEV2 (FT) values (:BlobParam)';
- for i:=0 to testBlobValuesCount - 1 do
- begin
- case asWhat of
- 0: Params.ParamByName('blobParam').AsMemo := TestBlobValues[i];
- 1: Params.ParamByName('blobParam').AsBlob := BytesOf(TestBlobValues[i]);
- 2: Params.ParamByName('blobParam').AsString := TestBlobValues[i];
- end;
- ExecSQL;
- end;
- Params.ParamByName('blobParam').Clear;
- ExecSQL;
- SQL.Text := 'select FT from FPDEV2';
- Open;
- for i:=0 to testBlobValuesCount - 1 do
- begin
- AssertEquals(TestBlobValues[i], Fields[0].AsString);
- Next;
- end;
- AssertTrue(Fields[0].IsNull);
- Close;
- end;
- end;
- procedure TTestFieldTypes.TestSetBlobAsMemoParam;
- begin
- // Firebird/Interbase ODBC driver : if parameter of ValueType=SQL_C_CHAR is bound to BLOB column
- // driver interprets character data as hexadecimal string and performs conversion ('FF10'=#255#16)
- TestSetBlobAsParam(0);
- end;
- procedure TTestFieldTypes.TestSetBlobAsBlobParam;
- begin
- TestSetBlobAsParam(1);
- end;
- procedure TTestFieldTypes.TestSetBlobAsStringParam;
- begin
- TestSetBlobAsParam(2);
- 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).CommitDDL;
- 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.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).CommitDDL;
- 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.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,1);
- 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.TestParametersAndDates;
- // See bug 7205
- var ADateStr : String;
- begin
- if not(SQLServerType in [ssPostgreSQL, ssOracle]) 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.TestInsertReturningQuery;
- begin
- if not(SQLServerType in [ssFirebird, ssOracle, ssPostgreSQL]) then Ignore(STestNotApplicable);
- with TSQLDBConnector(DBConnector) do
- begin
- // This only works with databases that supports 'insert into .. returning'
- // for example: PostgreSQL, Oracle, Firebird version 2.0 and up
- CreateTableWithFieldType(ftInteger,'int');
- Query.SQL.Text:='insert into FPDEV2 values(154) returning FT';
- Query.Open;
- AssertTrue(CompareText('FT',Query.Fields[0].FieldName)=0);
- AssertEquals(154,Query.fields[0].AsInteger);
- Query.Close;
- end;
- end;
- procedure TTestFieldTypes.TestOpenStoredProc;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- case SQLServerType of
- ssMySQL:
- begin
- Connection.ExecuteDirect('create procedure FPDEV_PROC() select 1 union select 2;');
- Query.SQL.Text:='call FPDEV_PROC';
- end;
- ssFirebird, ssInterbase:
- begin
- Connection.ExecuteDirect('create procedure FPDEV_PROC returns (r integer) as begin r=1; end');
- Query.SQL.Text:='execute procedure FPDEV_PROC';
- end;
- ssMSSQL, ssSybase:
- begin
- Connection.ExecuteDirect('create procedure FPDEV_PROC as select 1 union select 2;');
- Query.SQL.Text:='execute FPDEV_PROC';
- end;
- else
- begin
- Ignore('This test does not apply to this sqldb connection type, since it does not support selectable stored procedures.');
- Exit;
- end;
- end;
- Transaction.CommitRetaining;
- try
- Query.Open;
- AssertEquals(1, Query.Fields[0].AsInteger);
- Query.Next;
- if not(SQLServerType in [ssFirebird, ssInterbase]) then
- begin
- AssertFalse('Eof after 1st row', Query.Eof);
- AssertEquals(2, Query.Fields[0].AsInteger);
- Query.Next;
- end;
- AssertTrue('No Eof after last row', Query.Eof);
- Query.Close;
- finally
- Connection.ExecuteDirect('drop procedure FPDEV_PROC');
- Transaction.CommitRetaining;
- end;
- end;
- end;
- procedure TTestFieldTypes.TestOpenSpecialStatements;
- const CTE_SELECT = 'WITH a AS (SELECT * FROM FPDEV) SELECT * FROM a';
- type TTestStatements = array of string;
- var statements: TTestStatements;
- s: string;
- begin
- // tests non-select statements (other than "SELECT ..."), which return result-set
- // at least one row must be returned
- with TSQLDBConnector(DBConnector) do
- begin
- case SQLServerType of
- ssSQLite:
- statements := TTestStatements.Create('pragma table_info(FPDEV)');
- ssFirebird:
- statements := TTestStatements.Create(
- CTE_SELECT (*FB 2.1*),
- 'EXECUTE BLOCK RETURNS (U VARCHAR(255)) AS BEGIN SELECT rdb$get_context(''SYSTEM'',''CURRENT_USER'') FROM rdb$database INTO U; SUSPEND; END' (*FB 2.0*)
- );
- ssPostgreSQL:
- statements := TTestStatements.Create(CTE_SELECT, 'EXPLAIN '+CTE_SELECT);
- ssMSSQL:
- statements := TTestStatements.Create(CTE_SELECT (*MS SQL 2005*));
- ssMySQL:
- statements := TTestStatements.Create(
- 'check table FPDEV', // bug 14519
- 'show tables from '+Connection.DatabaseName // bug 16842
- )
- else
- Ignore(STestNotApplicable);
- end;
- for s in statements do
- begin
- Query.SQL.Text := s;
- Query.Open;
- AssertTrue(Query.FieldCount>0);
- AssertFalse('Eof after open', Query.Eof);
- Query.Next;
- Query.Close;
- end;
- 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;
- 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
- begin
- passed := (E.ClassType.InheritsFrom(EDatabaseError))
- end;
- end;
- AssertTrue(passed);
- Close;
- end;
- end;
- procedure TTestFieldTypes.TestServerFilter;
- begin
- // Tests SQLParser and ServerFilter
- with TSQLDBConnector(DBConnector).Query do
- begin
- ServerFilter:='ID=21';
- ServerFiltered:=true;
- // tests parsing SELECT without WHERE
- SQL.Text:='select * from FPDEV';
- Open;
- CheckTrue(CanModify, SQL.Text);
- CheckEquals(1, RecordCount);
- Close;
- SQL.Text:='select *'#13'from FPDEV'#13'order by 1';
- Open;
- CheckTrue(CanModify, SQL.Text);
- CheckEquals(1, RecordCount);
- Close;
- // tests parsing SELECT with simple WHERE
- SQL.Text:='select *'#9'from FPDEV'#9'where NAME<>''''';
- Open;
- CheckTrue(CanModify, SQL.Text);
- CheckEquals(1, RecordCount);
- Close;
- // tests parsing SELECT with simple WHERE followed by ORDER BY
- SQL.Text:='select *'#10'from FPDEV'#10'where NAME>'''' order by 1';
- Open;
- CheckTrue(CanModify, SQL.Text);
- CheckEquals(1, RecordCount);
- Close;
- // tests parsing of WHERE ... LIMIT
- case SQLServerType of
- ssFirebird, ssInterbase:
- SQL.Text:='select first 1 NAME from FPDEV where NAME=''TestName21''';
- ssMSSQL, ssSybase:
- SQL.Text:='select top 1 NAME from FPDEV where NAME=''TestName21''';
- else
- SQL.Text:='select NAME from FPDEV where NAME=''TestName21'' limit 1';
- end;
- Open;
- CheckTrue(CanModify, SQL.Text);
- Close;
- // tests parsing SELECT with table alias and embedded comments (MySQL requires space after -- )
- SQL.Text:='/**/select * from/**/FPDEV as fp-- comment'#13'where(NAME>''TestName20'')/**/order by 1';
- Open;
- CheckTrue(CanModify, 'CanModify: '+SQL.Text);
- CheckTrue(ServerIndexDefs.Count >= 1, 'ServerIndexDefs: '+SQL.Text); // is TableName extracted correctly? (MS SQL Server can automatically creates index)
- Close;
- // tests parsing SELECT with quoted identifiers (MySQL requires sql-mode=ANSI_QUOTES)
- // The folding of unquoted names to lower case in PostgreSQL is incompatible with the SQL standard
- SQL.Text:=IdentifierCase('SELECT"ID"FROM"FPDEV"ORDER BY"ID"');
- Open;
- CheckTrue(CanModify, SQL.Text);
- Close;
- end;
- end;
- procedure TTestFieldTypes.TestRowsAffected;
- var Query2: TSQLQuery;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- Query2 := GetNDataset(0) as TSQLQuery;
- 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).CommitDDL;
- 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(-1, Query2.RowsAffected);
- Query2.SQL.Text := 'insert into FPDEV2 values(3,''test3'')';
- Query2.ExecSQL;
- AssertEquals(1, Query2.RowsAffected);
- // tests, that RowsAffected is specific per query, not per connection
- // i.e. that it doesn't return only RowsAffected of last query executed over connection
- 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.
- Query.SQL.Text := 'delete from FPDEV2 where ID>0'; // sqlite doesn't count the RowsAffected if there is no where-clause
- Query.ExecSQL;
- AssertEquals(3, Query.RowsAffected);
- Query.SQL.Text := 'delete from FPDEV2';
- Query.ExecSQL;
- AssertEquals(0, Query.RowsAffected);
- 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('ID', i, AFldID.AsInteger);
- if i = 2 then
- AssertEquals('NAME', 'test', AFldName.AsString)
- else
- AssertEquals('NAME', 'TestName'+inttostr(i), AFldName.AsString);
- ADataset.Next;
- end;
- ADataset.Next;
- AssertTrue(ADataset.EOF);
- end;
- procedure TTestFieldTypes.TestTableNames;
- var TableList : TStringList;
- begin
- TableList := TStringList.Create;
- try
- TSQLDBConnector(DBConnector).Connection.GetTableNames(TableList);
- AssertTrue(TableList.IndexOf('fpdev')<>-1);
- finally
- TableList.Free;
- 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.TestFieldNames;
- var FieldList : TStringList;
- begin
- FieldList := TStringList.Create;
- try
- TSQLDBConnector(DBConnector).Connection.GetFieldNames('fpdev',FieldList);
- AssertTrue(FieldList.IndexOf('id')<>-1);
- finally
- FieldList.Free;
- end;
- end;
- procedure TTestFieldTypes.TestGetFieldNames;
- var FieldNames : TStringList;
- begin
- with TSQLDBConnector(DBConnector) do
- begin
- FieldNames := TStringList.Create;
- try
- if SQLConnType in MySQLConnTypes 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.TestUpdateIndexDefs;
- var ds : TSQLQuery;
- begin
- // Firebird/Interbase ODBC driver returns for :
- // SQLPrimaryKeys (PK_NAME): RDB$RELATION_CONSTRAINTS(RDB$CONSTRAINT_NAME)
- // SQLStatistics (INDEX_NAME): RDB$INDICES(RDB$INDEX_NAME)
- // these two names can differ (when PRIMARY KEY is created without giving constraint name),
- // therefore two indexes may be created instead of one (see TODBCConnection.UpdateIndexDefs)
- 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
- TSQLDBConnector(DBConnector).CommitDDL;
- 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.TestGetIndexDefs;
- var ds : TSQLQuery;
- inddefs : TIndexDefs;
- begin
- ds := DBConnector.GetNDataset(1) as TSQLQuery;
- ds.Open;
- AssertEquals('ServerIndexDefs.Count', 1, ds.ServerIndexDefs.Count);
- inddefs := HackedDataset(ds).GetIndexDefs(ds.ServerIndexDefs,[ixPrimary]);
- AssertEquals('ixPrimary', 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('ixPrimary,ixUnique', 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('ixDescending', 0, inddefs.count);
- inddefs.Free;
- end;
- procedure TTestFieldTypes.TestEmptyUpdateQuery;
- begin
- TSQLDBConnector(DBConnector).Connection.ExecuteDirect('update FPDEV set NAME=''nothing'' where (1=0)');
- end;
- procedure TTestFieldTypes.TestTemporaryTable;
- begin
- // Tests rev.6481: "Do not use a new connection for every statement that is executed";
- if SQLServerType in [ssMSSQL, ssSybase] then Ignore('This test does not apply to this sqldb connection type, since it doesn''t support temporary tables');
- with TSQLDBConnector(DBConnector).Query do
- begin
- SQL.Clear;
- if SQLServerType in [ssFirebird, ssInterbase, ssOracle] then
- // Global temporary table: introduced in Firebird 2.1
- // has persistent metadata; data is per transaction (default) or per connection
- SQL.Add('CREATE GLOBAL TEMPORARY TABLE FPDEV_TEMP (id int)')
- else
- SQL.Add('CREATE TEMPORARY TABLE FPDEV_TEMP (id int)');
- ExecSQL;
- try
- // Firebird/Interbase needs a commit after DDL:
- TSQLDBConnector(DBConnector).CommitDDL;
- SQL.Text := 'INSERT INTO FPDEV_TEMP(id) values (5)';
- ExecSQL;
- SQL.Text := 'SELECT * FROM FPDEV_TEMP';
- Open;
- AssertEquals(5, Fields[0].AsInteger);
- Close;
- finally
- // For Firebird/Interbase, we need to explicitly delete the table as well (it's active within the transaction)
- if SQLServerType in [ssFirebird, ssInterbase, ssOracle] then
- begin
- SQL.Text := 'DROP TABLE FPDEV_TEMP';
- ExecSQL;
- TSQLDBConnector(DBConnector).CommitDDL;
- end;
- end;
- end;
- 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.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.SetUp;
- begin
- InitialiseDBConnector;
- DBConnector.StartTest(TestName);
- end;
- procedure TTestFieldTypes.TearDown;
- begin
- DBConnector.StopTest(TestName);
- if assigned(DBConnector) then
- TSQLDBConnector(DBConnector).Transaction.Rollback;
- FreeDBConnector;
- end;
- procedure TTestFieldTypes.RunTest;
- begin
- // if (SQLConnType in TSQLConnType) then
- inherited RunTest;
- end;
- initialization
- // Only test if using sqldb
- if uppercase(dbconnectorname)='SQL' then
- RegisterTest(TTestFieldTypes);
- end.
|