diff options
Diffstat (limited to 'packages/fcl-db/tests')
| -rw-r--r-- | packages/fcl-db/tests/bufdatasettoolsunit.pas | 15 | ||||
| -rw-r--r-- | packages/fcl-db/tests/dbguitestrunner.pas | 68 | ||||
| -rw-r--r-- | packages/fcl-db/tests/dbtestframework_gui.lpi | 13 | ||||
| -rw-r--r-- | packages/fcl-db/tests/dbtestframework_gui.lpr | 30 | ||||
| -rw-r--r-- | packages/fcl-db/tests/inieditor.lfm | 32 | ||||
| -rw-r--r-- | packages/fcl-db/tests/inieditor.pas | 1 | ||||
| -rw-r--r-- | packages/fcl-db/tests/sqldbtoolsunit.pas | 16 | ||||
| -rw-r--r-- | packages/fcl-db/tests/testbufdatasetstreams.pas | 45 | ||||
| -rw-r--r-- | packages/fcl-db/tests/testdbbasics.pas | 19 | ||||
| -rw-r--r-- | packages/fcl-db/tests/testfieldtypes.pas | 1802 |
10 files changed, 1095 insertions, 946 deletions
diff --git a/packages/fcl-db/tests/bufdatasettoolsunit.pas b/packages/fcl-db/tests/bufdatasettoolsunit.pas index 48f07080a6..3ec164d719 100644 --- a/packages/fcl-db/tests/bufdatasettoolsunit.pas +++ b/packages/fcl-db/tests/bufdatasettoolsunit.pas @@ -6,8 +6,8 @@ A closed BufDataset normally has no data, so these tests won't work. To circumvent this, this unit saves the dataset contents to file and reloads them on opening using the BufDataset persistence mechanism. - } + {$mode objfpc}{$H+} interface @@ -18,7 +18,6 @@ uses BufDataset; type -{ TbufdatasetConnector } { TbufdatasetDBConnector } @@ -140,9 +139,13 @@ begin FieldDefs.Add('FDATETIME',ftDateTime); FieldDefs.Add('FBLOB',ftBlob); FieldDefs.Add('FMEMO',ftMemo); - FieldDefs.Add('FLARGEINT',ftLargeint); FieldDefs.Add('FFIXEDCHAR',ftFixedChar,10); + FieldDefs.Add('FLARGEINT',ftLargeint); + FieldDefs.Add('FGUID',ftGuid,38); FieldDefs.Add('FFMTBCD',ftFmtBCD); + FieldDefs.Add('FWIDESTRING',ftWideString,10); + FieldDefs.Add('FFIXEDWIDECHAR',ftFixedWideChar,10); + FieldDefs.Add('FWIDEMEMO',ftWideMemo); CreateDataset; Open; for i := 0 to testValuesCount-1 do @@ -162,9 +165,13 @@ begin FieldByName('FDATETIME').AsDateTime := StrToDateTime(testValues[ftDateTime,i], Self.FormatSettings); FieldByName('FBLOB').AsString := testStringValues[i]; FieldByName('FMEMO').AsString := testStringValues[i]; - FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i]; FieldByName('FFIXEDCHAR').AsString := PadRight(testStringValues[i], 10); + FieldByName('FLARGEINT').AsLargeInt := testLargeIntValues[i]; + FieldByName('FGUID').AsString := GuidToString(GUID_NULL); FieldByName('FFMTBCD').AsBCD := StrToBCD(testFmtBCDValues[i], Self.FormatSettings); + FieldByName('FWIDESTRING').AsString := testStringValues[i]; + FieldByName('FFIXEDWIDECHAR').AsString := PadRight(testStringValues[i], 10); + FieldByName('FWIDEMEMO').AsString := testStringValues[i]; Post; end; MergeChangeLog; diff --git a/packages/fcl-db/tests/dbguitestrunner.pas b/packages/fcl-db/tests/dbguitestrunner.pas new file mode 100644 index 0000000000..cc80b15ac9 --- /dev/null +++ b/packages/fcl-db/tests/dbguitestrunner.pas @@ -0,0 +1,68 @@ +unit DBGuiTestRunner; +// Adds database.ini editing facilities to regular GuiTestRunner form + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, + Interfaces, Forms, + StdCtrls, + GuiTestRunner, inieditor; + +type + + { TDBGuiTestRunnerForm } + + TDBGuiTestRunnerForm=class(TGUITestRunner) + private + DBEditButton: TButton; + public + procedure DBEditButtonClick(ASender: TObject); + constructor Create(AOwner: TComponent); override; + end; + +var + DBGuiTestRunnerForm: TDBGuiTestRunnerForm; + + +implementation + + +{ TDBGuiTestRunnerForm } + +procedure TDBGuiTestRunnerForm.DBEditButtonClick(ASender: TObject); +var + DBSelectForm: TFormIniEditor; +begin + DBSelectForm:=TFormIniEditor.Create(nil); + try + DBSelectForm.INIFile:='database.ini'; + DBSelectForm.ProfileSelectSection:='Database'; + DBSelectForm.ProfileSelectKey:='type'; + // We can ignore resulting db selection as the file is saved already: + DBSelectForm.ShowModal; + finally + DBSelectForm.Free; + end; +end; + +constructor TDBGuiTestRunnerForm.Create(AOwner: TComponent); +// Add our database.ini edit button to the existing GUI +begin + inherited Create(AOwner); + DBEditButton:=TButton.Create(Self); + DBEditButton.Top:=7; + DBEditButton.Left:=210; + DBEditButton.Height:=32; + DBEditButton.Width:=100; + DBEditButton.Caption:='Edit database.ini...'; + DBEditButton.Hint:='Edit database selection settings (effective for next start)'; + DBEditButton.OnClick:=@DBEditButtonClick; + // Set this last; now all properties take effect + DBEditButton.Parent:=Self.Panel1; +end; + +end. + diff --git a/packages/fcl-db/tests/dbtestframework_gui.lpi b/packages/fcl-db/tests/dbtestframework_gui.lpi index 0c932eba99..7576d7e19f 100644 --- a/packages/fcl-db/tests/dbtestframework_gui.lpi +++ b/packages/fcl-db/tests/dbtestframework_gui.lpi @@ -1,10 +1,14 @@ -<?xml version="1.0"?> +<?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> <Version Value="9"/> <General> + <Flags> + <MainUnitHasCreateFormStatements Value="False"/> + </Flags> <SessionStorage Value="InProjectDir"/> <MainUnit Value="0"/> + <Title Value="DBTestFramework"/> <ResourceType Value="res"/> <UseXPManifest Value="True"/> </General> @@ -76,12 +80,17 @@ <PackageName Value="FCL"/> </Item4> </RequiredPackages> - <Units Count="1"> + <Units Count="2"> <Unit0> <Filename Value="dbtestframework_gui.lpr"/> <IsPartOfProject Value="True"/> <UnitName Value="dbtestframework_gui"/> </Unit0> + <Unit1> + <Filename Value="dbguitestrunner.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="DBGuiTestRunner"/> + </Unit1> </Units> </ProjectOptions> <CompilerOptions> diff --git a/packages/fcl-db/tests/dbtestframework_gui.lpr b/packages/fcl-db/tests/dbtestframework_gui.lpr index d901d7fe88..99b86a5e5a 100644 --- a/packages/fcl-db/tests/dbtestframework_gui.lpr +++ b/packages/fcl-db/tests/dbtestframework_gui.lpr @@ -14,10 +14,11 @@ program dbtestframework_gui; uses Interfaces, Forms, // GUI: - GuiTestRunner, inieditor, + StdCtrls {to extend GuiTestRunner}, + DBGuiTestRunner, inieditor, // Generic DB test framework units ToolsUnit, - // Connectors for different database-types + // Connectors for different database types sqldbtoolsunit, dbftoolsunit, bufdatasettoolsunit, @@ -37,29 +38,10 @@ uses {$R *.res} -var - DBSelectForm: TFormIniEditor; - TestRunForm: TGUITestRunner; begin + Application.Title:='DBTestFramework'; Application.Initialize; - DBSelectForm:=TFormIniEditor.Create(nil); - try - DBSelectForm.INIFile:='database.ini'; - DBSelectForm.ProfileSelectSection:='Database'; - DBSelectForm.ProfileSelectKey:='type'; - // We can ignore resulting db selection as the file is saved already: - DBSelectForm.ShowModal; - finally - DBSelectForm.Free; - end; - // Manually run this form because autocreation could have loaded an old - // database.ini file (if the user changed it using DBSelectForm) - TestRunForm:=TGUITestRunner.Create(nil); - try - TestRunForm.Show; - Application.Run; - finally - TestRunForm.Free; - end; + Application.CreateForm(TDBGuiTestRunnerForm, DBGuiTestRunnerForm); + Application.Run; end. diff --git a/packages/fcl-db/tests/inieditor.lfm b/packages/fcl-db/tests/inieditor.lfm index 8437c995f0..222c51a28d 100644 --- a/packages/fcl-db/tests/inieditor.lfm +++ b/packages/fcl-db/tests/inieditor.lfm @@ -454,12 +454,14 @@ object FormIniEditor: TFormIniEditor Lines.Strings = ( '' ) + SelectedColor.FrameEdges = sfeAround SelectedColor.BackPriority = 50 SelectedColor.ForePriority = 50 SelectedColor.FramePriority = 50 SelectedColor.BoldPriority = 50 SelectedColor.ItalicPriority = 50 SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 OnStatusChange = SynMemoStatusChange inline SynLeftGutterPartList1: TSynGutterPartList object SynGutterMarks1: TSynGutterMarks @@ -471,6 +473,7 @@ object FormIniEditor: TFormIniEditor MouseActions = <> MarkupInfo.Background = clBtnFace MarkupInfo.Foreground = clNone + MarkupInfo.FrameEdges = sfeAround DigitCount = 2 ShowOnlyLineNumbersMultiplesOf = 1 ZeroStart = False @@ -485,11 +488,15 @@ object FormIniEditor: TFormIniEditor object SynGutterSeparator1: TSynGutterSeparator Width = 2 MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + MarkupInfo.FrameEdges = sfeAround end object SynGutterCodeFolding1: TSynGutterCodeFolding MouseActions = <> MarkupInfo.Background = clNone MarkupInfo.Foreground = clGray + MarkupInfo.FrameEdges = sfeAround MouseActionsExpanded = <> MouseActionsCollapsed = <> end @@ -497,7 +504,7 @@ object FormIniEditor: TFormIniEditor end object FileNameEdit: TFileNameEdit Left = 56 - Height = 23 + Height = 21 Top = 24 Width = 368 OnAcceptFileName = FileNameEditAcceptFileName @@ -510,28 +517,28 @@ object FormIniEditor: TFormIniEditor end object INIFileLabel: TLabel Left = 8 - Height = 15 + Height = 13 Top = 24 - Width = 34 + Width = 32 Caption = 'INI file' ParentColor = False end object ProfileSelect: TComboBox Left = 56 - Height = 23 + Height = 21 Hint = 'Choose the profile you want to enable' Top = 61 Width = 164 - ItemHeight = 15 + ItemHeight = 13 OnSelect = ProfileSelectSelect Sorted = True TabOrder = 1 end object ProfileLabel: TLabel Left = 8 - Height = 15 + Height = 13 Top = 64 - Width = 34 + Width = 30 Caption = 'Profile' ParentColor = False end @@ -556,6 +563,17 @@ object FormIniEditor: TFormIniEditor OnClick = CancelButtonClick TabOrder = 3 end + object Label1: TLabel + Left = 8 + Height = 13 + Top = 0 + Width = 229 + Caption = 'Changes need a program restart to load!' + Font.Color = clRed + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end object SynIniHighlighter: TSynIniSyn DefaultFilter = 'INI Files (*.ini)|*.ini' Enabled = False diff --git a/packages/fcl-db/tests/inieditor.pas b/packages/fcl-db/tests/inieditor.pas index 60a365c975..9e1a387f2e 100644 --- a/packages/fcl-db/tests/inieditor.pas +++ b/packages/fcl-db/tests/inieditor.pas @@ -15,6 +15,7 @@ type TFormIniEditor = class(TForm) GUITimer: TIdleTimer; + Label1: TLabel; OKButton: TButton; CancelButton: TButton; ProfileSelect: TComboBox; diff --git a/packages/fcl-db/tests/sqldbtoolsunit.pas b/packages/fcl-db/tests/sqldbtoolsunit.pas index 687c8b6b36..9b6c389cc0 100644 --- a/packages/fcl-db/tests/sqldbtoolsunit.pas +++ b/packages/fcl-db/tests/sqldbtoolsunit.pas @@ -12,7 +12,7 @@ uses ,pqconnection ,odbcconn {$IFNDEF WIN64} - {See packages\fcl-db\fpmake.pp: Oracle connector is not built if PostgreSQL connectoris not built} + {See packages\fcl-db\fpmake.pp: Oracle connector not built yet on Win64} ,oracleconnection {$ENDIF WIN64} ,sqlite3conn @@ -222,6 +222,9 @@ begin FieldtypeDefinitions[ftBlob] := 'IMAGE'; FieldtypeDefinitions[ftMemo] := 'TEXT'; FieldtypeDefinitions[ftGraphic] := ''; + FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)'; + FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)'; + //FieldtypeDefinitions[ftWideMemo] := 'NTEXT'; // Sybase has UNITEXT? end; ssMySQL: begin @@ -245,9 +248,10 @@ begin ssPostgreSQL: begin FieldtypeDefinitions[ftCurrency] := 'MONEY'; // ODBC?! - FieldtypeDefinitions[ftBlob] := 'BYTEA'; - FieldtypeDefinitions[ftMemo] := 'TEXT'; - FieldtypeDefinitions[ftGraphic] := ''; + FieldtypeDefinitions[ftBlob] := 'BYTEA'; + FieldtypeDefinitions[ftMemo] := 'TEXT'; + FieldtypeDefinitions[ftGraphic] := ''; + FieldtypeDefinitions[ftGuid] := 'UUID'; end; ssSQLite: begin @@ -257,6 +261,7 @@ begin FieldtypeDefinitions[ftVarBytes] := 'VARBINARY(10)'; FieldtypeDefinitions[ftMemo] := 'CLOB'; //or TEXT SQLite supports both, but CLOB is sql standard (TEXT not) FieldtypeDefinitions[ftWideString] := 'NVARCHAR(10)'; + FieldtypeDefinitions[ftFixedWideChar] := 'NCHAR(10)'; FieldtypeDefinitions[ftWideMemo] := 'NCLOB'; end; end; @@ -393,7 +398,6 @@ begin for countID := 0 to testValuesCount-1 do begin - Sql := 'insert into FPDEV_FIELD (ID'; Sql1 := 'values ('+IntToStr(countID); for FType := low(TFieldType)to high(TFieldType) do @@ -471,7 +475,7 @@ begin begin sql.clear; sql.add('SELECT * FROM FPDEV_FIELD'); - tsqlquery(Result).UniDirectional:=TestUniDirectional; + UniDirectional:=TestUniDirectional; end; end; diff --git a/packages/fcl-db/tests/testbufdatasetstreams.pas b/packages/fcl-db/tests/testbufdatasetstreams.pas index 313a7e45db..b8de052644 100644 --- a/packages/fcl-db/tests/testbufdatasetstreams.pas +++ b/packages/fcl-db/tests/testbufdatasetstreams.pas @@ -7,7 +7,7 @@ unit TestBufDatasetStreams; interface uses - fpcunit, testutils, testregistry, testdecorator, + fpcunit, testregistry, Classes, SysUtils, db, BufDataset; type @@ -71,6 +71,7 @@ type procedure TestDeleteAllInsertXML; procedure TestStreamingBlobFieldsXML; procedure TestStreamingBigBlobFieldsXML; + procedure TestStreamingNullFieldsXML; procedure TestStreamingCalculatedFieldsXML; procedure TestAppendDeleteBIN; @@ -473,8 +474,8 @@ begin SaveDS.First; while not LoadDS.EOF do begin - AssertEquals(LoadDS.FieldByName('FBLOB').AsString,SaveDS.FieldByName('FBLOB').AsString); - AssertEquals(LoadDS.FieldByName('FMEMO').AsString,SaveDS.FieldByName('FMEMO').AsString); + AssertEquals(SaveDS.FieldByName('FBLOB').AsString, LoadDS.FieldByName('FBLOB').AsString); + AssertEquals(SaveDS.FieldByName('FMEMO').AsString, LoadDS.FieldByName('FMEMO').AsString); LoadDS.Next; SaveDS.Next; end; @@ -547,6 +548,44 @@ begin end; end; +procedure TTestBufDatasetStreams.TestStreamingNullFieldsXML; +var + SaveDs: TCustomBufDataset; + LoadDs: TCustomBufDataset; + i: integer; +begin + SaveDs := DBConnector.GetFieldDataset(true) as TCustomBufDataset; + with SaveDs do + begin + Open; + Next; + Edit; + // set all fields to null + for i:=0 to FieldCount-1 do + Fields[i].Clear; + Post; + // check if they are null + for i:=0 to FieldCount-1 do + AssertTrue(Fields[i].FieldName, Fields[i].IsNull); + SaveToFile(TestXMLFileName, dfXML); + end; + + LoadDs := TCustomBufDataset.Create(nil); + try + LoadDs.LoadFromFile(TestXMLFileName); + SaveDs.First; + while not SaveDs.EOF do + begin + for i:=0 to SaveDs.FieldCount-1 do + AssertEquals(SaveDs.Fields[i].FieldName, SaveDs.Fields[i].IsNull, LoadDs.Fields[i].IsNull); + LoadDs.Next; + SaveDs.Next; + end; + finally + LoadDs.Free; + end; +end; + procedure TTestBufDatasetStreams.TestStreamingCalculatedFieldsXML; var ADataset: TCustomBufDataset; diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas index 24f6971235..de40276c3d 100644 --- a/packages/fcl-db/tests/testdbbasics.pas +++ b/packages/fcl-db/tests/testdbbasics.pas @@ -324,11 +324,11 @@ begin begin aDatasource.DataSet := ds; DataEvents := ''; - open; - Fields.add(tfield.Create(DBConnector.GetNDataset(1))); + Open; + Fields.Add(TField.Create(ds)); CheckEquals('deUpdateState:0;deFieldListChange:0;',DataEvents); DataEvents := ''; - fields.Clear; + Fields.Clear; CheckEquals('deFieldListChange:0;',DataEvents) end; aDatasource.Free; @@ -1319,7 +1319,6 @@ begin first; CheckTrue(EOF); - Close; end; end; @@ -1327,14 +1326,13 @@ end; {$ifdef fpc} procedure TTestBufDatasetDBBasics.TestIsEmpty; begin - with tCustombufdataset(DBConnector.GetNDataset(True,1)) do + with DBConnector.GetNDataset(True,1) as TCustomBufDataset do begin open; delete; Resync([]); - applyupdates; + ApplyUpdates; CheckTrue(IsEmpty); - end; end; @@ -2333,7 +2331,6 @@ var i : byte; DbfTableLevel: integer; begin - DbfTableLevel:=4; if (uppercase(dbconnectorname)='DBF') then begin DbfTableLevel:=strtointdef(dbconnectorparams,4); @@ -2359,7 +2356,8 @@ var i : byte; begin if (uppercase(dbconnectorname)='DBF') then - Ignore('TDBF Smallint support only from -999 to 9999'); + Ignore('TDBF: Smallint support only from -999 to 9999'); + TestfieldDefinition(ftSmallint,2,ds,Fld); for i := 0 to testValuesCount-1 do @@ -2498,7 +2496,8 @@ var i : byte; begin if (uppercase(dbconnectorname)='DBF') then - Ignore('This test does not apply to TDDBF as they store currency in BCD fields.'); + Ignore('This test does not apply to TDBF as they store currency in BCD fields.'); + TestfieldDefinition(ftCurrency,8,ds,Fld); for i := 0 to testValuesCount-1 do diff --git a/packages/fcl-db/tests/testfieldtypes.pas b/packages/fcl-db/tests/testfieldtypes.pas index 0447e81592..f837bbad7a 100644 --- a/packages/fcl-db/tests/testfieldtypes.pas +++ b/packages/fcl-db/tests/testfieldtypes.pas @@ -31,50 +31,7 @@ type procedure TearDown; override; procedure RunTest; override; published - procedure TestEmptyUpdateQuery; // bug 13654 - procedure TestParseJoins; // bug 10148 - procedure TestParseUnion; // bug 8442 - procedure TestDoubleFieldNames; // bug 8457 - procedure TestNumericNames; // Bug9661 - procedure TestApplyUpdFieldnames; // Bug 12275 - procedure TestStringLargerThen8192; - procedure TestInsertLargeStrFields; // bug 9600 - procedure TestLargeRecordSize; - procedure TestClearUpdateableStatus; - procedure TestReadOnlyParseSQL; // bug 9254 - procedure TestpfInUpdateFlag; // bug 7565 - procedure TestAggregates; - procedure TestServerFilter; // bug 15456 - procedure Test11Params; - procedure TestRowsAffected; // bug 9758 - procedure TestLocateNull; - procedure TestLocateOnMoreRecords; - procedure TestStringsReplace; - procedure TestCircularParams; - procedure TestBug9744; - procedure TestCrossStringDateParam; - procedure TestSetBlobAsMemoParam; - procedure TestSetBlobAsBlobParam; - procedure TestSetBlobAsStringParam; - procedure TestNonNullableParams; - procedure TestDblQuoteEscComments; - procedure TestInsertReturningQuery; - procedure TestOpenStoredProc; - procedure TestOpenSpecialStatements; - - procedure TestTemporaryTable; - procedure TestRefresh; - procedure TestQueryAfterReconnect; // bug 16438 - - procedure TestParametersAndDates; - procedure TestExceptOnsecClose; - procedure TestErrorOnEmptyStatement; - - procedure TestBlob; - procedure TestChangeBlob; - procedure TestBlobGetText; - procedure TestBlobSize; - + // Fields (field recognition): procedure TestInt; procedure TestTinyint; procedure TestNumeric; @@ -83,12 +40,43 @@ type 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; @@ -101,7 +89,30 @@ type procedure TestVarBytesParamQuery; procedure TestBooleanParamQuery; - // SchemaType tests + 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; @@ -110,12 +121,12 @@ type procedure TestMultipleFieldPKIndexDefs; procedure TestGetIndexDefs; - // Test SQL-field type recognition - procedure TestSQLClob; - procedure TestSQLLargeint; - procedure TestSQLInterval; - procedure TestSQLIdentity; - procedure TestSQLReal; + // Connection: + procedure TestEmptyUpdateQuery; // bug 13654 + procedure TestTemporaryTable; + procedure TestQueryAfterReconnect; // bug 16438 + + procedure TestStringsReplace; end; implementation @@ -570,6 +581,21 @@ begin end; end; +procedure TTestFieldTypes.TestBlob; + +begin + CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]); + TestFieldDeclaration(ftBlob,0); + + TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')'); + + with TSQLDBConnector(DBConnector).Query do + begin + Open; + AssertEquals('Test deze blob',fields[0].AsString); + close; + end; +end; procedure TTestFieldTypes.TestChangeBlob; @@ -653,18 +679,297 @@ begin end; -procedure TTestFieldTypes.TestBlob; +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 - CreateTableWithFieldType(ftBlob,FieldtypeDefinitions[ftBlob]); - TestFieldDeclaration(ftBlob,0); + result := QuotedStr(testStringValues[a]); +end; - TSQLDBConnector(DBConnector).Connection.ExecuteDirect('insert into FPDEV2 (FT) values (''Test deze blob'')'); +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 does not 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:=ftInteger; + 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'; + 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 + 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('Test deze blob',fields[0].AsString); + AssertEquals(s,fields[0].AsString); + close; + end; +end; + +procedure TTestFieldTypes.TestInsertLargeStrFields; +// See also: TestStringLargerThen8192 +const + FieldValue1='test1'; +var + FieldValue2: string; +begin + FieldValue2:=StringOfChar('t', 16000); + 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).CommitDDL; + + query.sql.Text:='select * from FPDEV2'; + Query.Open; + Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize) + Query.InsertRecord([2,FieldValue2]); // string length > 8192 (dsMaxStringSize) + Query.ApplyUpdates; + Query.Close; + Query.Open; + AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString); + Query.Next; + AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString)); + AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString); + Query.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 + 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 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; @@ -688,6 +993,367 @@ begin 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 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.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 := '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 := []; // 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 @@ -940,7 +1606,6 @@ begin TSQLDBConnector(DBConnector).Transaction.CommitRetaining; end; - procedure TTestFieldTypes.TestSetBlobAsParam(asWhat: integer); const TestValue='Test deze BLob'; @@ -978,117 +1643,58 @@ begin TestSetBlobAsParam(0); end; -procedure TTestFieldTypes.TestSetBlobAsStringParam; -begin - TestSetBlobAsParam(1); -end; - procedure TTestFieldTypes.TestSetBlobAsBlobParam; begin TestSetBlobAsParam(2); end; - -procedure TTestFieldTypes.TestQueryAfterReconnect; -var DS: TDataset; +procedure TTestFieldTypes.TestSetBlobAsStringParam; begin - ds := DBConnector.GetNDataset(true,5); - with ds do - begin - open; - close; - TSQLDBConnector(DBConnector).Connection.Close; - TSQLDBConnector(DBConnector).Connection.Open; - open; - close; - end; + TestSetBlobAsParam(1); 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; +procedure TTestFieldTypes.Test11Params; +var i : integer; begin - with TSQLDBConnector(DBConnector) do + 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); + 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; - // Must be exactly 23 to trigger bug/test - AssertTrue(Locate('name',VarArrayOf(['TestName23']),[])); - AssertEquals(23,fieldbyname('ID').AsInteger); - end; + 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.TestRefresh; -var ADataset: TDataset; - i: integer; - AFldID, AFldName: TField; +procedure TTestFieldTypes.TestCircularParams; begin - ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5); - - Adataset.Open; - AFldId:=Adataset.Fields[0]; - AFldName:=Adataset.Fields[1]; - for i := 1 to 5 do + with TSQLDBConnector(dbconnector) 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; + 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; - 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; + 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; - 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; @@ -1119,85 +1725,35 @@ begin AssertTrue(Passed); end; -procedure TTestFieldTypes.TestStringLargerThen8192; -// See also: TestInsertLargeStrFields -var - s : string; - i : integer; - +procedure TTestFieldTypes.TestParametersAndDates; +// See bug 7205 +var ADateStr : String; 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 + ''')'); + 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 - Open; - AssertEquals(s,fields[0].AsString); + 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; - end; -end; - -procedure TTestFieldTypes.TestInsertLargeStrFields; -// See also: TestStringLargerThen8192 -const - FieldValue1='test1'; -var - FieldValue2: string; -begin - FieldValue2:=StringOfChar('t', 16000); - 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).CommitDDL; - - query.sql.Text:='select * from FPDEV2'; - Query.Open; - Query.InsertRecord([1,FieldValue1]); // string length <= 8192 (dsMaxStringSize) - Query.InsertRecord([2,FieldValue2]); // string length > 8192 (dsMaxStringSize) - Query.ApplyUpdates; - Query.Close; - Query.Open; - AssertEquals(FieldValue1, Query.FieldByName('NAME').AsString); - Query.Next; - AssertEquals(length(FieldValue2), length(Query.FieldByName('NAME').AsString)); - AssertEquals(FieldValue2, Query.FieldByName('NAME').AsString); - Query.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 - 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 POVRINA'',''000037756'',''2005-07-01'',''NE ODGOVARA'',''Ovdje se upisuje komentar o kontrolnom broju..............'')'); - ExecSQL; - - sql.clear; - sql.append('select * from FPDEV2'); + sql.add('select now()::date as current_date where cast(1 as integer) = :PARAM1'); + params.parambyname('PARAM1').asinteger:= 1; open; - AssertEquals('ZUBNE PASTE',FieldByName('plant').AsString); - AssertEquals(EncodeDate(2005,07,01),FieldByName('sampling_datetime').AsDateTime); + first; + AssertEquals(ADateStr,fields[0].asstring); // return invalid date + // writeln(fields[0].asstring); close; - end; + end end; + procedure TTestFieldTypes.TestInsertReturningQuery; begin if not(SQLServerType in [ssFirebird, ssOracle, ssPostgreSQL]) then Ignore(STestNotApplicable); @@ -1304,319 +1860,55 @@ begin end; end; -procedure TTestFieldTypes.TestClearUpdateableStatus; -// Test if CanModify is correctly disabled in case of a select query without -// a from-statement. + +procedure TTestFieldTypes.TestErrorOnEmptyStatement; +var PassException : boolean; begin - if not (SQLServerType in [ssMySQL]) then Ignore('This test does only apply to MySQL because the used SQL-statement is MySQL only.'); - with TSQLDBConnector(DBConnector) do + PassException:=False; + with TSQLDBConnector(DBConnector).Query do begin - with (GetNDataset(false,5) as TSQLQuery) do - begin - Open; - AssertEquals(True,CanModify); - Close; - SQL.Text:='select last_insert_id();'; + sql.Text := ''; + try Open; - AssertEquals(False,CanModify); - close; - end; + except + on E:EDatabaseError do + if Pos(SErrNoStatement,E.Message) > 0 then + PassException := True; 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; + AssertTrue(PassException); 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 := '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 := []; // do not include calculated fields into generated sql insert/update +procedure TTestFieldTypes.TestExceptOnsecClose; - Open; - Edit; - FieldByName('ID').AsInteger := 254; - Post; - ApplyUpdates; - Append; - FieldByName('ID').AsInteger := 255; - Post; - ApplyUpdates; - Close; - AFld1.Free; - AFld2.Free; - AFld3.Free; - end; -end; +var passed : boolean; -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.Add('select * from FPDEV'); - sql.clear; - sql.append('select avg(FIELD2) from FPDEV2'); - open; - AssertEquals(3,Fields[0].AsInteger); + Open; close; - end; - -end; - -procedure TTestFieldTypes.TestParseJoins; -begin - with TSQLDBConnector(DBConnector) do - begin - with query do + SQL.Clear; + SQL.Add('select blaise from FPDEV'); + passed := false; + try + open; + except + on E: Exception 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; + passed := (E.ClassType.InheritsFrom(EDatabaseError)) 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.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'))); + AssertTrue(passed); - AssertEquals(1,fieldbyname('ID').AsInteger); - AssertEquals(1,fieldbyname('ID_1').AsInteger); - AssertEquals('TestName1',fieldbyname('NAME').AsString); - AssertEquals('TestName1',fieldbyname('NAME_1').AsString); - close; - end; + 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).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.TestServerFilter; begin @@ -1683,363 +1975,135 @@ begin end; procedure TTestFieldTypes.TestRowsAffected; +var Query2: TSQLQuery; begin with TSQLDBConnector(DBConnector) do begin - AssertEquals(-1,query.RowsAffected); + Query2 := GetNDataset(0) as TSQLQuery; + + AssertEquals(-1, Query.RowsAffected); Connection.ExecuteDirect('create table FPDEV2 (' + ' ID INT NOT NULL, ' + ' NAME VARCHAR(250),' + - ' PRIMARY KEY (ID) ' + - ') '); + ' 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); + AssertEquals(1, Query.RowsAffected); Query.SQL.Text := 'insert into FPDEV2(ID,NAME) values (2,''test2'')'; Query.ExecSQL; - AssertEquals(1,query.RowsAffected); + AssertEquals(1, Query.RowsAffected); + Query.SQL.Text := 'update FPDEV2 set NAME=''NewTest'''; Query.ExecSQL; - AssertEquals(2,query.RowsAffected); + + 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. - if (SQLConnType = 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'; + 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(2,query.RowsAffected); + AssertEquals(3, Query.RowsAffected); Query.SQL.Text := 'delete from FPDEV2'; Query.ExecSQL; - AssertEquals(0,query.RowsAffected); + 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).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.Test11Params; -var i : integer; +procedure TTestFieldTypes.TestLocateNull; +var DS: TCustomBufDataset; begin - with TSQLDBConnector(dbconnector) do + ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset; + with ds 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; + 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.TestBug9744; -var i : integer; +procedure TTestFieldTypes.TestLocateOnMoreRecords; +var DS: TCustomBufDataset; 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.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 + ')'); + 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 TSQLDBConnector(DBConnector).Query do - begin - Open; - for i := 0 to testValuesCount-1 do + with ds do begin - ACheckFieldValueProc(fields[0],i); - Next; + 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; - 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 does not 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; +procedure TTestFieldTypes.TestRefresh; +var ADataset: TDataset; i: integer; - updatable: boolean; + AFldID, AFldName: TField; 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:=ftInteger; - 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); + ADataset := TSQLDBConnector(DBConnector).GetNDataset(true,5); - with TSQLDBConnector(DBConnector).Query do - begin - Open; - AssertTrue(Locate('FT',1,[])); // bug 17624 - for i := 1 to 3 do + Adataset.Open; + AFldId:=Adataset.Fields[0]; + AFldName:=Adataset.Fields[1]; + for i := 1 to 5 do begin - AssertEquals(i, Fields[0].AsInteger); - Next; + AssertEquals(i,AFldID.asinteger); + AssertEquals('TestName'+inttostr(i),AFldName.asstring); + ADataset.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 + + 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 - 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; + AssertEquals(i,AFldID.AsInteger); + if i = 2 then + AssertEquals('test',AFldName.AsString) + else + AssertEquals('TestName'+inttostr(i),AFldName.AsString); + ADataset.Next; end; - Close; - end; + ADataset.Next; + AssertTrue(ADataset.EOF); 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'; - else - datatype:='REAL'; - end; - TestSQLFieldType(ftFloat, datatype, sizeof(double), @TestSQLReal_GetSQLText, @CheckFieldValue); -end; procedure TTestFieldTypes.TestTableNames; var TableList : TStringList; @@ -2173,6 +2237,11 @@ begin 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"; @@ -2210,93 +2279,46 @@ begin 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.TestParametersAndDates; -// See bug 7205 -var ADateStr : String; +procedure TTestFieldTypes.TestQueryAfterReconnect; +var DS: TDataset; 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 + ds := DBConnector.GetNDataset(true,5); + with ds 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; + TSQLDBConnector(DBConnector).Connection.Close; + TSQLDBConnector(DBConnector).Connection.Open; open; - first; - AssertEquals(ADateStr,fields[0].asstring); // return invalid date - // writeln(fields[0].asstring); close; - - end + end; end; -procedure TTestFieldTypes.TestExceptOnsecClose; +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])); -var passed : boolean; + 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'],[])); -begin - with TSQLDBConnector(DBConnector).Query do - begin - SQL.Clear; - SQL.Add('select * from FPDEV'); + AssertEquals('dit is een char is een strin',StringsReplace('dit was een string was een strin',['string','was'],['char','is'],[rfReplaceAll])); - Open; - close; + 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])); - 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); + 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])); - Close; - end; -end; + 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])); -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; + 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; |