From caf506a7a2c09ea01282649de3ce7a808d2a1f8a Mon Sep 17 00:00:00 2001 From: marco Date: Mon, 28 Mar 2016 14:43:12 +0000 Subject: [PATCH] --- Merging r32093 into '.': U packages/fcl-db/src/sqlite/customsqliteds.pas --- Recording mergeinfo for merge of r32093 into '.': U . --- Merging r32131 into '.': U packages/fcl-db/tests/testdbbasics.pas U packages/fcl-db/src/base/bufdataset.pas U packages/fcl-db/src/sdf/sdfdata.pp U packages/fcl-db/src/memds/memds.pp --- Recording mergeinfo for merge of r32131 into '.': G . --- Merging r32359 into '.': U packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of r32359 into '.': G . --- Merging r32558 into '.': U packages/fcl-db/src/base/bufdataset_parser.pp --- Recording mergeinfo for merge of r32558 into '.': G . --- Merging r32566 into '.': G packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of r32566 into '.': G . --- Merging r32729 into '.': U packages/fcl-db/src/sqldb/postgres/pqconnection.pp --- Recording mergeinfo for merge of r32729 into '.': G . --- Merging r32753 into '.': U packages/fcl-db/src/sqlite/sqliteds.pas U packages/fcl-db/src/sqlite/sqlite3ds.pas --- Recording mergeinfo for merge of r32753 into '.': G . --- Merging r32754 into '.': G packages/fcl-db/src/sqlite/sqlite3ds.pas --- Recording mergeinfo for merge of r32754 into '.': G . --- Merging r32755 into '.': G packages/fcl-db/src/sqlite/sqliteds.pas --- Recording mergeinfo for merge of r32755 into '.': G . --- Merging r32796 into '.': U packages/fcl-db/src/base/dataset.inc --- Recording mergeinfo for merge of r32796 into '.': G . --- Merging r32800 into '.': U packages/fcl-db/src/base/sqlscript.pp --- Recording mergeinfo for merge of r32800 into '.': G . --- Merging r32801 into '.': U packages/fcl-db/tests/dbtestframework.pas U packages/fcl-db/tests/testsqlscript.pas --- Recording mergeinfo for merge of r32801 into '.': G . --- Merging r32807 into '.': G packages/fcl-db/src/base/bufdataset.pas --- Recording mergeinfo for merge of r32807 into '.': G . --- Merging r32808 into '.': U packages/fcl-db/src/sqldb/mysql/mysqlconn.inc --- Recording mergeinfo for merge of r32808 into '.': G . --- Merging r32810 into '.': G packages/fcl-db/src/sqldb/sqldb.pp --- Recording mergeinfo for merge of r32810 into '.': G . # revisions: 32093,32131,32359,32558,32566,32729,32753,32754,32755,32796,32800,32801,32807,32808,32810 git-svn-id: branches/fixes_3_0@33368 - --- packages/fcl-db/src/base/bufdataset.pas | 95 +++++++++----- packages/fcl-db/src/base/bufdataset_parser.pp | 23 +++- packages/fcl-db/src/base/dataset.inc | 4 +- packages/fcl-db/src/base/sqlscript.pp | 17 ++- packages/fcl-db/src/memds/memds.pp | 9 ++ packages/fcl-db/src/sdf/sdfdata.pp | 13 +- packages/fcl-db/src/sqldb/mysql/mysqlconn.inc | 19 +-- .../fcl-db/src/sqldb/postgres/pqconnection.pp | 4 +- packages/fcl-db/src/sqldb/sqldb.pp | 119 +++++++++++++++++- packages/fcl-db/src/sqlite/customsqliteds.pas | 92 +++++++++----- packages/fcl-db/src/sqlite/sqlite3ds.pas | 10 +- packages/fcl-db/src/sqlite/sqliteds.pas | 10 +- packages/fcl-db/tests/dbtestframework.pas | 4 +- packages/fcl-db/tests/testdbbasics.pas | 48 ++++++- packages/fcl-db/tests/testsqlscript.pas | 34 ++++- 15 files changed, 399 insertions(+), 102 deletions(-) diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas index a77e31b8f9..dc4446cdb7 100644 --- a/packages/fcl-db/src/base/bufdataset.pas +++ b/packages/fcl-db/src/base/bufdataset.pas @@ -158,7 +158,8 @@ type procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); virtual; abstract; procedure GotoBookmark(const ABookmark : PBufBookmark); virtual; abstract; function BookmarkValid(const ABookmark: PBufBookmark): boolean; virtual; - function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual; + function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : integer; virtual; + function SameBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; inline; procedure InitialiseIndex; virtual; abstract; @@ -226,7 +227,7 @@ type procedure StoreCurrentRecIntoBookmark(const ABookmark: PBufBookmark); override; procedure StoreSpareRecIntoBookmark(const ABookmark: PBufBookmark); override; procedure GotoBookmark(const ABookmark : PBufBookmark); override; - + function CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; override; procedure InitialiseIndex; override; procedure InitialiseSpareRecord(const ASpareRecord : TRecordBuffer); override; @@ -1248,15 +1249,17 @@ begin if Fields.Count = 0 then DatabaseError(SErrNoDataset); - // If there is a field with FieldNo=0 then the fields are not found to the - // FieldDefs which is a sign that there is no dataset created. (Calculated and - // lookup fields have FieldNo=-1) + // search for autoinc field FAutoIncField:=nil; - for i := 0 to Fields.Count-1 do - if Fields[i].FieldNo=0 then - DatabaseError(SErrNoDataset) - else if (FAutoIncValue>-1) and (Fields[i] is TAutoIncField) and not assigned(FAutoIncField) then - FAutoIncField := TAutoIncField(Fields[i]); + if FAutoIncValue>-1 then + begin + for i := 0 to Fields.Count-1 do + if Fields[i] is TAutoIncField then + begin + FAutoIncField := TAutoIncField(Fields[i]); + Break; + end; + end; InitDefaultIndexes; CalcRecordSize; @@ -1367,12 +1370,14 @@ begin Result := assigned(ABookmark) and assigned(ABookmark^.BookmarkData); end; -function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean; +function TBufIndex.CompareBookmarks(const ABookmark1, ABookmark2: PBufBookmark): integer; begin - if assigned(ABookmark1) and assigned(ABookmark2) then - Result := (ABookmark1^.BookmarkData=ABookmark2^.BookmarkData) - else - Result := False; + Result := 0; +end; + +function TBufIndex.SameBookmarks(const ABookmark1, ABookmark2: PBufBookmark): boolean; +begin + Result := Assigned(ABookmark1) and Assigned(ABookmark2) and (CompareBookmarks(ABookmark1, ABookmark2) = 0); end; function TBufIndex.GetRecord(ABookmark: PBufBookmark; GetMode: TGetMode): TGetResult; @@ -1537,6 +1542,35 @@ begin FCurrentRecBuf := ABookmark^.BookmarkData; end; +function TDoubleLinkedBufIndex.CompareBookmarks(const ABookmark1,ABookmark2: PBufBookmark): integer; +var ARecord1, ARecord2 : PBufRecLinkItem; +begin + // valid bookmarks expected + // estimate result using memory addresses of records + Result := ABookmark1^.BookmarkData - ABookmark2^.BookmarkData; + if Result = 0 then + Exit + else if Result < 0 then + begin + Result := -1; + ARecord1 := ABookmark1^.BookmarkData; + ARecord2 := ABookmark2^.BookmarkData; + end + else + begin + Result := +1; + ARecord1 := ABookmark2^.BookmarkData; + ARecord2 := ABookmark1^.BookmarkData; + end; + // if we need relative position of records with given bookmarks we must + // traverse through index until we reach lower bookmark or 1st record + while assigned(ARecord2) and (ARecord2 <> ARecord1) and (ARecord2 <> FFirstRecBuf) do + ARecord2 := ARecord2[IndNr].prior; + // if we found lower bookmark as first, then estimated position is correct + if ARecord1 <> ARecord2 then + Result := -Result; +end; + procedure TDoubleLinkedBufIndex.InitialiseIndex; begin // Do nothing @@ -1564,7 +1598,7 @@ begin FFirstRecBuf:= nil; end; -function TDoubleLinkedBufIndex.GetRecNo: integer; +function TDoubleLinkedBufIndex.GetRecNo: Longint; var ARecord : PBufRecLinkItem; begin ARecord := FCurrentRecBuf; @@ -2050,8 +2084,8 @@ begin StartBuf := 0; Result := False; for x := StartBuf to high(FUpdateBuffer) do - if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or - (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then + if FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].BookmarkData,@ABookmark) or + (IncludePrior and (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@ABookmark)) then begin FCurrentUpdateBuffer := x; Result := True; @@ -2064,10 +2098,10 @@ function TCustomBufDataset.GetRecordUpdateBufferCached(const ABookmark: TBufBook begin // if the current update buffer matches, immediately return true if (FCurrentUpdateBuffer < length(FUpdateBuffer)) and ( - FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or + FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@ABookmark) or (IncludePrior and (FUpdateBuffer[FCurrentUpdateBuffer].UpdateKind=ukDelete) - and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then + and FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData,@ABookmark))) then begin Result := True; end @@ -2290,7 +2324,7 @@ var StoreRecBM : TBufBookmark; {for x := length(FUpdateBuffer)-1 downto 0 do begin - if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.CompareBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then + if (FUpdateBuffer[x].UpdateKind=ukDelete) and FCurrentIndex.SameBookmarks(@FUpdateBuffer[x].NextBookmarkData,@BookmarkData) then CancelUpdBuffer(FUpdateBuffer[x]); end;} FreeRecordBuffer(OldValuesBuffer); @@ -2314,7 +2348,7 @@ var StoreRecBM : TBufBookmark; FCurrentIndex.GotoBookmark(@Bm); TmpBuf:=FCurrentIndex.CurrentRecord; // resync won't work if the currentbuffer is freed... - if FCurrentIndex.CompareBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do + if FCurrentIndex.SameBookmarks(@Bm,@StoreRecBM) then with FCurrentIndex do begin GotoBookmark(@StoreRecBM); if ScrollForward = grEOF then @@ -2880,7 +2914,7 @@ procedure TCustomBufDataset.GetDatasetPacket(AWriter: TDataPacketReader); if GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,False) then begin repeat - if FCurrentIndex.CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then + if FCurrentIndex.SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData, @AUpdBuffer.BookmarkData) then StoreUpdateBuffer(FUpdateBuffer[FCurrentUpdateBuffer], ARowState); until not GetRecordUpdateBuffer(AUpdBuffer.BookmarkData,True,True) end; @@ -3051,13 +3085,16 @@ begin Result:=assigned(FCurrentIndex) and FCurrentIndex.BookmarkValid(pointer(ABookmark)); end; -function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark - ): Longint; +function TCustomBufDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; begin - if not assigned(Bookmark1) or not assigned(Bookmark2) then - Result := 0 - else if Assigned(FCurrentIndex) and FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) then + if Bookmark1 = Bookmark2 then Result := 0 + else if not assigned(Bookmark1) then + Result := 1 + else if not assigned(Bookmark2) then + Result := -1 + else if assigned(FCurrentIndex) then + Result := FCurrentIndex.CompareBookmarks(pointer(Bookmark1),pointer(Bookmark2)) else Result := -1; end; @@ -3148,7 +3185,7 @@ begin FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[FCurrentUpdateBuffer].NextBookmarkData); for x := FCurrentUpdateBuffer+1 to length(FUpdateBuffer)-1 do - if Findexes[0].CompareBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then + if FIndexes[0].SameBookmarks(@FUpdateBuffer[FCurrentUpdateBuffer].BookmarkData,@FUpdateBuffer[x].NextBookmarkData) then FIndexes[0].StoreSpareRecIntoBookmark(@FUpdateBuffer[x].NextBookmarkData); AddRecordBuffer:=False; diff --git a/packages/fcl-db/src/base/bufdataset_parser.pp b/packages/fcl-db/src/base/bufdataset_parser.pp index 0ad9204938..84b96b79c0 100644 --- a/packages/fcl-db/src/base/bufdataset_parser.pp +++ b/packages/fcl-db/src/base/bufdataset_parser.pp @@ -143,6 +143,12 @@ type procedure Refresh(Buffer: TRecordBuffer); override; end; + TBCDFieldVar = class(TFloatFieldVar) + public + procedure Refresh(Buffer: TRecordBuffer); override; + end; + + //--TFieldVar---------------------------------------------------------------- constructor TFieldVar.Create(UseField: TField); begin @@ -273,6 +279,16 @@ begin FFieldVal := False; end; +procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer); +var c: currency; +begin + if FField.DataSet.GetFieldData(FField,@c) then + FFieldVal := c + else + FFieldVal := 0; +end; + + //--TBufDatasetParser--------------------------------------------------------------- constructor TBufDatasetParser.Create(Adataset: TDataSet); @@ -387,7 +403,7 @@ begin TempFieldVar := TFloatFieldVar.Create(FieldInfo); TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal); end; - ftAutoInc, ftInteger, ftSmallInt: + ftAutoInc, ftInteger, ftSmallInt, ftWord: begin TempFieldVar := TIntegerFieldVar.Create(FieldInfo); TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal); @@ -402,6 +418,11 @@ begin TempFieldVar := TDateTimeFieldVar.Create(FieldInfo); TempFieldVar.FExprWord := DefineDateTimeVariable(VarName, TempFieldVar.FieldVal); end; + ftBCD: + begin + TempFieldVar := TBCDFieldVar.Create(FieldInfo); + TempFieldVar.FExprWord := DefineFloatVariable(VarName, TempFieldVar.FieldVal); + end; else raise EDatabaseError.CreateFmt(SErrIndexBasedOnInvField, [VarName,Fieldtypenames[FieldInfo.DataType]]); end; diff --git a/packages/fcl-db/src/base/dataset.inc b/packages/fcl-db/src/base/dataset.inc index f369da3860..f1cb9da04b 100644 --- a/packages/fcl-db/src/base/dataset.inc +++ b/packages/fcl-db/src/base/dataset.inc @@ -105,7 +105,9 @@ begin begin FFieldDef := nil; FieldIndex := FieldDefs.IndexOf(Fields[i].FieldName); - if FieldIndex <> -1 then + if FieldIndex = -1 then + DatabaseErrorFmt(SFieldNotFound,[Fields[i].FieldName],Self) + else begin FFieldDef := FieldDefs[FieldIndex]; FFieldNo := FFieldDef.FieldNo; diff --git a/packages/fcl-db/src/base/sqlscript.pp b/packages/fcl-db/src/base/sqlscript.pp index a92c6a797a..41ce3f78b1 100644 --- a/packages/fcl-db/src/base/sqlscript.pp +++ b/packages/fcl-db/src/base/sqlscript.pp @@ -278,7 +278,11 @@ function TCustomSQLScript.Available: Boolean; begin With FSQL do - Result:=(FLine=0) and (ReqBookmark -1); end; +function TFixedFormatDataSet.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; +const r: array[Boolean, Boolean] of ShortInt = ((2,-1),(1,0)); +begin + Result := r[Bookmark1=nil, Bookmark2=nil]; + if Result = 2 then + Result := PPtrInt(Bookmark1)^ - PPtrInt(Bookmark2)^; +end; + procedure TFixedFormatDataSet.InternalGotoBookmark(ABookmark: Pointer); var Index: Integer; diff --git a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc index 58642c58ee..1a2fe3ecb7 100644 --- a/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc +++ b/packages/fcl-db/src/sqldb/mysql/mysqlconn.inc @@ -106,6 +106,7 @@ Type TConnectionName = class (TSQLConnection) private + FSkipLibrarVersionCheck : Boolean; FHostInfo: String; FServerInfo: String; FMySQL : PMySQL; @@ -164,6 +165,7 @@ Type property ClientInfo: string read GetClientInfo; property ServerStatus : String read GetServerStatus; published + Property SkipLibrarVersionCheck : Boolean Read FSkipLibrarVersionCheck Write FSkipLibrarVersionCheck; property DatabaseName; property HostName; property KeepConnection; @@ -495,13 +497,16 @@ var FullVersion: string; begin InitialiseMysql; - FullVersion:=strpas(mysql_get_client_info()); - // Version string should start with version number: - // Note: in case of MariaDB version mismatch: tough luck, we report MySQL - // version only. - if (pos(MySQLVersion, FullVersion) <> 1) and - (pos(MariaDBVersion, FullVersion) <> 1) then - Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]); + if not SkipLibrarVersionCheck then + begin + FullVersion:=strpas(mysql_get_client_info()); + // Version string should start with version number: + // Note: in case of MariaDB version mismatch: tough luck, we report MySQL + // version only. + if (pos(MySQLVersion, FullVersion) <> 1) and + (pos(MariaDBVersion, FullVersion) <> 1) then + Raise EInOutError.CreateFmt(SErrVersionMisMatch,[ClassName,MySQLVersion,FullVersion]); + end; inherited DoInternalConnect; ConnectToServer; SelectDatabase; diff --git a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp index 1ec1ab0846..315e09cb31 100644 --- a/packages/fcl-db/src/sqldb/postgres/pqconnection.pp +++ b/packages/fcl-db/src/sqldb/postgres/pqconnection.pp @@ -1006,9 +1006,9 @@ begin begin case AParams[i].DataType of ftDateTime: - s := FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz', AParams[i].AsDateTime); + s := FormatDateTime('yyyy"-"mm"-"dd hh":"nn":"ss.zzz', AParams[i].AsDateTime); ftDate: - s := FormatDateTime('yyyy-mm-dd', AParams[i].AsDateTime); + s := FormatDateTime('yyyy"-"mm"-"dd', AParams[i].AsDateTime); ftTime: s := FormatTimeInterval(AParams[i].AsDateTime); ftFloat, ftBCD: diff --git a/packages/fcl-db/src/sqldb/sqldb.pp b/packages/fcl-db/src/sqldb/sqldb.pp index 4917018931..ac99bc2845 100644 --- a/packages/fcl-db/src/sqldb/sqldb.pp +++ b/packages/fcl-db/src/sqldb/sqldb.pp @@ -25,6 +25,13 @@ uses SysUtils, Classes, DB, bufdataset, sqlscript; type TSchemaType = (stNoSchema, stTables, stSysTables, stProcedures, stColumns, stProcedureParams, stIndexes, stPackages, stSchemata, stSequences); +const + TSchemaObjectNames: array[TSchemaType] of String = ('???', 'table_name', + '???', 'procedure_name', 'column_name', 'param_name', + 'index_name', 'package_name', 'schema_name','sequence'); + +type + TStatementType = (stUnknown, stSelect, stInsert, stUpdate, stDelete, stDDL, stGetSegment, stPutSegment, stExecProcedure, stStartTrans, stCommit, stRollback, stSelectForUpd); @@ -135,6 +142,33 @@ type procedure Update; override; end; + + TSqlObjectIdentifierList = class; + + { TSqlObjectIdenfier } + + TSqlObjectIdenfier = class(TCollectionItem) + private + FObjectName: String; + FSchemaName: String; + public + constructor Create(ACollection: TSqlObjectIdentifierList; Const AObjectName: String; Const ASchemaName: String = ''); + property SchemaName: String read FSchemaName write FSchemaName; + property ObjectName: String read FObjectName write FObjectName; + end; + + { TSqlObjectIdentifierList } + + TSqlObjectIdentifierList = class(TCollection) + private + function GetIdentifier(Index: integer): TSqlObjectIdenfier; + procedure SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier); + public + function AddIdentifier: TSqlObjectIdenfier; overload; + function AddIdentifier(Const AObjectName: String; Const ASchemaName: String = ''): TSqlObjectIdenfier; overload; + property Identifiers[Index: integer]: TSqlObjectIdenfier read GetIdentifier write SetIdentifier; default; + end; + type { TSQLConnection } @@ -221,6 +255,7 @@ type function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; virtual; function GetNextValueSQL(const SequenceName: string; IncrementBy: Integer): string; virtual; + function GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList): Integer; virtual; Procedure MaybeConnect; Property Statements : TFPList Read FStatements; @@ -784,6 +819,31 @@ begin end; +{ TSqlObjectIdentifierList } + +function TSqlObjectIdentifierList.GetIdentifier(Index: integer): TSqlObjectIdenfier; +begin + Result := Items[Index] as TSqlObjectIdenfier; +end; + +procedure TSqlObjectIdentifierList.SetIdentifier(Index: integer; AValue: TSqlObjectIdenfier); +begin + Items[Index] := AValue; +end; + +function TSqlObjectIdentifierList.AddIdentifier: TSqlObjectIdenfier; +begin + Result:=Add as TSqlObjectIdenfier; +end; + +function TSqlObjectIdentifierList.AddIdentifier(Const AObjectName: String; + Const ASchemaName: String = ''): TSqlObjectIdenfier; +begin + Result:=AddIdentifier(); + Result.SchemaName:=ASchemaName; + Result.ObjectName:=AObjectName; +end; + { TSQLDBFieldDefs } class function TSQLDBFieldDefs.FieldDefClass: TFieldDefClass; @@ -1228,11 +1288,11 @@ begin if not ATransaction.Active then ATransaction.MaybeStartTransaction; - try - SQL := TrimRight(SQL); - if SQL = '' then - DatabaseError(SErrNoStatement); + SQL := TrimRight(SQL); + if SQL = '' then + DatabaseError(SErrNoStatement); + try Cursor := AllocateCursorHandle; Cursor.FStatementType := stUnknown; If LogEvent(detPrepare) then @@ -1354,6 +1414,43 @@ begin GetDBInfo(stSequences,'','SEQUENCE_NAME',List); end; +Function TSQLConnection.GetObjectNames(ASchemaType: TSchemaType; AList : TSqlObjectIdentifierList) : Integer; +var + qry : TCustomSQLQuery; + vSchemaName, vObjectName: String; + f: TField; +begin + Result:=0; + if not assigned(Transaction) then + DatabaseError(SErrConnTransactionnSet); + + qry := TCustomSQLQuery.Create(nil); + try + qry.transaction := Transaction; + qry.database := Self; + with qry do + begin + ParseSQL := False; + SetSchemaInfo(ASchemaType,TSchemaObjectNames[ASchemaType],''); + open; + f:=FindField(TSchemaObjectNames[stSchemata]); + while not eof do + begin + vSchemaName:=''; + if Assigned(f) then + vSchemaName:=f.AsString; + vObjectName:=FieldByName(FSchemaObjectName).AsString; + AList.AddIdentifier(vObjectName, vSchemaName); + Next; + Inc(Result); + end; + end; + finally + qry.free; + end; + +end; + function TSQLConnection.GetConnectionInfo(InfoType: TConnInfoType): string; var i: TConnInfoType; begin @@ -3270,6 +3367,7 @@ begin If Assigned(FProxy) then FreeProxy; FConnectorType:=AValue; + CreateProxy; end; end; @@ -3287,7 +3385,7 @@ Var begin inherited DoInternalConnect; - CreateProxy; + CheckProxy; FProxy.CharSet:=Self.CharSet; FProxy.DatabaseName:=Self.DatabaseName; FProxy.HostName:=Self.HostName; @@ -3327,6 +3425,7 @@ begin DatabaseErrorFmt(SErrUnknownConnectorType,[ConnectorType],Self); FProxy:=D.ConnectionClass.Create(Self); FFieldNameQuoteChars := FProxy.FieldNameQuoteChars; + FConnOptions := FProxy.ConnOptions; end; procedure TSQLConnector.FreeProxy; @@ -3548,6 +3647,16 @@ begin end; end; +{ TSqlObjectIdenfier } + +constructor TSqlObjectIdenfier.Create(ACollection: TSqlObjectIdentifierList; + const AObjectName: String; Const ASchemaName: String = ''); +begin + inherited Create(ACollection); + FSchemaName:=ASchemaName; + FObjectName:=AObjectName; +end; + Initialization Finalization diff --git a/packages/fcl-db/src/sqlite/customsqliteds.pas b/packages/fcl-db/src/sqlite/customsqliteds.pas index 33fe54725c..7acdc98c36 100644 --- a/packages/fcl-db/src/sqlite/customsqliteds.pas +++ b/packages/fcl-db/src/sqlite/customsqliteds.pas @@ -109,6 +109,7 @@ type {$endif} FInternalActiveBuffer: PDataRecord; FInsertBookmark: PDataRecord; + FFilterBuffer: TRecordBuffer; FOnCallback: TSqliteCallback; FMasterLink: TMasterDataLink; FIndexFieldNames: String; @@ -176,6 +177,7 @@ type procedure DoBeforeClose; override; procedure DoAfterInsert; override; procedure DoBeforeInsert; override; + procedure DoFilterRecord(var Acceptable: Boolean); virtual; procedure FreeRecordBuffer(var Buffer: TRecordBuffer); override; procedure GetBookmarkData(Buffer: TRecordBuffer; Data: Pointer); override; function GetBookmarkFlag(Buffer: TRecordBuffer): TBookmarkFlag; override; @@ -578,6 +580,13 @@ begin inherited DoBeforeInsert; end; +procedure TCustomSqliteDataset.DoFilterRecord(var Acceptable: Boolean); +begin + Acceptable := True; + if Assigned(OnFilterRecord) then + OnFilterRecord(Self, Acceptable); +end; + destructor TCustomSqliteDataset.Destroy; begin inherited Destroy; @@ -746,10 +755,14 @@ begin else FieldOffset := FieldDefs.Count + FCalcFieldList.IndexOf(Field); - if not (State in [dsCalcFields, dsInternalCalc]) then - FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset] - else - FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset]; + case State of + dsCalcFields, dsInternalCalc: + FieldRow := PPDataRecord(CalcBuffer)^^.Row[FieldOffset]; + dsFilter: + FieldRow := PPDataRecord(FFilterBuffer)^^.Row[FieldOffset]; + else + FieldRow := PPDataRecord(ActiveBuffer)^^.Row[FieldOffset]; + end; Result := FieldRow <> nil; if Result and (Buffer <> nil) then //supports GetIsNull @@ -789,31 +802,46 @@ begin end; function TCustomSqliteDataset.GetRecord(Buffer: TRecordBuffer; GetMode: TGetMode; DoCheck: Boolean): TGetResult; +var + Acceptable: Boolean; + SaveState: TDataSetState; begin Result := grOk; - case GetMode of - gmPrior: - if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then - Result := grBOF - else - FCurrentItem:=FCurrentItem^.Previous; - gmCurrent: - if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then - Result := grError; - gmNext: - if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then - Result := grEOF - else - FCurrentItem := FCurrentItem^.Next; - end; //case - if Result = grOk then - begin - PDataRecord(Pointer(Buffer)^) := FCurrentItem; - FCurrentItem^.BookmarkFlag := bfCurrent; - GetCalcFields(Buffer); - end - else if (Result = grError) and DoCheck then - DatabaseError('No records found', Self); + repeat + Acceptable := True; + case GetMode of + gmPrior: + if (FCurrentItem^.Previous = FBeginItem) or (FCurrentItem = FBeginItem) then + Result := grBOF + else + FCurrentItem:=FCurrentItem^.Previous; + gmCurrent: + if (FCurrentItem = FBeginItem) or (FCurrentItem = FEndItem) then + Result := grError; + gmNext: + if (FCurrentItem = FEndItem) or (FCurrentItem^.Next = FEndItem) then + Result := grEOF + else + FCurrentItem := FCurrentItem^.Next; + end; //case + if Result = grOk then + begin + PDataRecord(Pointer(Buffer)^) := FCurrentItem; + FCurrentItem^.BookmarkFlag := bfCurrent; + GetCalcFields(Buffer); + if Filtered then + begin + FFilterBuffer := Buffer; + SaveState := SetTempState(dsFilter); + DoFilterRecord(Acceptable); + if (GetMode = gmCurrent) and not Acceptable then + Result := grError; + RestoreState(SaveState); + end; + end + else if (Result = grError) and DoCheck then + DatabaseError('No records found', Self); + until (Result <> grOK) or Acceptable; end; function TCustomSqliteDataset.GetRecordCount: Integer; @@ -1573,7 +1601,7 @@ begin FMasterLink.DataSource := Value; end; -procedure TCustomSqliteDataset.ExecSQL(const ASQL: String); +procedure TCustomSqliteDataset.ExecSQL(const ASql: String); begin if FSqliteHandle = nil then GetSqliteHandle; @@ -1831,7 +1859,8 @@ begin Result := False; end; -procedure TCustomSqliteDataset.ExecCallback(const ASQL: String; UserData: Pointer = nil); +procedure TCustomSqliteDataset.ExecCallback(const ASql: String; + UserData: Pointer); var CallbackInfo: TCallbackInfo; begin @@ -1913,12 +1942,13 @@ begin (FAddedItems.Count > 0) or (FDeletedItems.Count > 0); end; -function TCustomSqliteDataset.QuickQuery(const ASQL: String): String; +function TCustomSqliteDataset.QuickQuery(const ASql: String): String; begin Result := QuickQuery(ASQL, nil, False); end; -function TCustomSqliteDataset.QuickQuery(const ASQL: String; const AStrList: TStrings): String; +function TCustomSqliteDataset.QuickQuery(const ASql: String; + const AStrList: TStrings): String; begin Result := QuickQuery(ASQL, AStrList, False) end; diff --git a/packages/fcl-db/src/sqlite/sqlite3ds.pas b/packages/fcl-db/src/sqlite/sqlite3ds.pas index 5c2c07048c..953dc07da4 100644 --- a/packages/fcl-db/src/sqlite/sqlite3ds.pas +++ b/packages/fcl-db/src/sqlite/sqlite3ds.pas @@ -227,17 +227,17 @@ begin SQLITE_FLOAT: AType := ftFloat; else - begin + begin AType := ftString; - DataSize := DefaultStringSize; - end; + DataSize := DefaultStringSize; + end; end; end else begin AType := ftString; - DataSize := DefaultStringSize; + DataSize := DefaultStringSize; end; - FieldDefs.Add(String(sqlite3_column_name(vm, i)), AType, DataSize); + FieldDefs.Add(FieldDefs.MakeNameUnique(String(sqlite3_column_name(vm, i))), AType, DataSize); //Set the pchar2sql function case AType of ftString: diff --git a/packages/fcl-db/src/sqlite/sqliteds.pas b/packages/fcl-db/src/sqlite/sqliteds.pas index 311b56556e..2330eb0fb1 100644 --- a/packages/fcl-db/src/sqlite/sqliteds.pas +++ b/packages/fcl-db/src/sqlite/sqliteds.pas @@ -184,12 +184,16 @@ begin begin AType := ftString; end; - FieldDefs.Add(String(ColumnNames[i]), AType, DataSize); + FieldDefs.Add(FieldDefs.MakeNameUnique(String(ColumnNames[i])), AType, DataSize); //Set the pchar2sql function - if AType in [ftString, ftMemo] then - FGetSqlStr[i] := @Char2SQLStr + case AType of + ftString: + FGetSqlStr[i] := @Char2SQLStr; + ftMemo: + FGetSqlStr[i] := @Memo2SQLStr; else FGetSqlStr[i] := @Num2SQLStr; + end; end; sqlite_finalize(vm, nil); { diff --git a/packages/fcl-db/tests/dbtestframework.pas b/packages/fcl-db/tests/dbtestframework.pas index 3fd3aeb277..67079fc327 100644 --- a/packages/fcl-db/tests/dbtestframework.pas +++ b/packages/fcl-db/tests/dbtestframework.pas @@ -28,7 +28,9 @@ uses TestSpecificTBufDataset, TestSpecificTDBF, TestSpecificTMemDataset, - TestDBExport, tccsvdataset, + TestDBExport, + tccsvdataset, + testsqlscript, consoletestrunner; Procedure LegacyOutput; diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas index 6b10526924..959934179a 100644 --- a/packages/fcl-db/tests/testdbbasics.pas +++ b/packages/fcl-db/tests/testdbbasics.pas @@ -8,7 +8,7 @@ interface uses {$IFDEF FPC} - fpcunit, testregistry, + testregistry, {$ELSE FPC} TestFramework, {$ENDIF FPC} @@ -58,6 +58,7 @@ type procedure TestAssignFieldftFixedChar; procedure TestSelectQueryBasics; procedure TestPostOnlyInEditState; + procedure TestCancel; procedure TestMove; // bug 5048 procedure TestActiveBufferWhenClosed; procedure TestEOFBOFClosedDataset; @@ -138,6 +139,7 @@ type procedure TestBookmarks; procedure TestBookmarkValid; + procedure TestCompareBookmarks; procedure TestDelete1; procedure TestDelete2; @@ -274,6 +276,18 @@ begin end; end; +procedure TTestDBBasics.TestCancel; +begin + with DBConnector.GetNDataset(1) do + begin + Open; + Edit; + FieldByName('name').AsString := 'EditName1'; + Cancel; + CheckEquals('TestName1', FieldByName('name').AsString, 'Cancel did not restored previous value'); + end; +end; + procedure TTestDBBasics.TestMove; var i,count : integer; aDatasource : TDataSource; @@ -802,7 +816,7 @@ begin end; procedure TTestCursorDBBasics.TestBookmarkValid; -var BM1,BM2,BM3,BM4,BM5 : TBookmark; +var BM1,BM2,BM3,BM4,BM5,BM6 : TBookmark; begin with DBConnector.GetNDataset(true,14) do begin @@ -834,9 +848,39 @@ begin CheckTrue(BookmarkValid(BM3)); CheckTrue(BookmarkValid(BM2)); CheckTrue(BookmarkValid(BM1)); + Append; + BM6 := GetBookmark; + CheckFalse(BookmarkValid(BM6)); end; end; +procedure TTestCursorDBBasics.TestCompareBookmarks; +var + FirstBookmark, LastBookmark, EditBookmark, PostEditBookmark: TBookmark; +begin + with DBConnector.GetNDataset(true,14) do + begin + Open; + FirstBookmark := GetBookmark; + + Edit; + EditBookmark := GetBookmark; + Post; + PostEditBookmark := GetBookmark; + + Last; + LastBookmark := GetBookmark; + + CheckEquals(0, CompareBookmarks(FirstBookmark, EditBookmark)); + CheckEquals(0, CompareBookmarks(EditBookmark, PostEditBookmark)); + CheckTrue(CompareBookmarks(FirstBookmark, LastBookmark) < 0, 'b1 0, 'b1>b2'); + CheckEquals(0, CompareBookmarks(nil, nil), '(nil,nil)'); + CheckEquals(-1, CompareBookmarks(FirstBookmark, nil), '(b1,nil)'); + CheckEquals(+1, CompareBookmarks(nil, FirstBookmark), '(nil,b2)'); + end; +end; + procedure TTestCursorDBBasics.TestLocate; begin with DBConnector.GetNDataset(true,13) do diff --git a/packages/fcl-db/tests/testsqlscript.pas b/packages/fcl-db/tests/testsqlscript.pas index 5e9f4cc95b..41867b60da 100644 --- a/packages/fcl-db/tests/testsqlscript.pas +++ b/packages/fcl-db/tests/testsqlscript.pas @@ -12,7 +12,7 @@ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} -unit testcsqlscript; +unit testsqlscript; {$mode objfpc}{$H+} @@ -34,7 +34,7 @@ type protected procedure ExecuteStatement (SQLStatement: TStrings; var StopExecution: Boolean); override; procedure ExecuteDirective (Directive, Argument: String; var StopExecution: Boolean); override; - procedure ExecuteCommit; override; + procedure ExecuteCommit(CommitRetaining: boolean=true); override; procedure DefaultDirectives; override; public constructor create (AnOwner: TComponent); override; @@ -98,6 +98,7 @@ type procedure TestCommentInComment; procedure TestCommentInQuotes1; procedure TestCommentInQuotes2; + Procedure TestDashDashComment; procedure TestQuote1InComment; procedure TestQuote2InComment; procedure TestQuoteInQuotes1; @@ -174,7 +175,7 @@ begin raise exception.create(DoException); end; -procedure TMyScript.ExecuteCommit; +procedure TMyScript.ExecuteCommit(CommitRetaining: boolean=true); begin inc (FCommits); if DoException <> '' then @@ -270,7 +271,20 @@ begin AssertFalse ('Aborted', Aborted); AssertEquals ('Line', 0, Line); AssertEquals ('Defines', 0, Defines.count); - AssertEquals ('Directives', 10, Directives.count); + AssertEquals ('Directives', 12, Directives.count); + AssertTrue('Have SET TERM',Directives.IndexOf('SET TERM')<>-1); + AssertTrue('Have COMMIT WORK',Directives.IndexOf('COMMIT WORK')<>-1); + AssertTrue('Have COMMIT RETAIN',Directives.IndexOf('COMMIT RETAIN')<>-1); + AssertTrue('Have COMMIT',Directives.IndexOf('COMMIT')<>-1); + AssertTrue('Have #IFDEF',Directives.IndexOf('#IFDEF')<>-1); + AssertTrue('Have #IFNDEF',Directives.IndexOf('#IFNDEF')<>-1); + AssertTrue('Have #ELSE',Directives.IndexOf('#ELSE')<>-1); + AssertTrue('Have #ENDIF',Directives.IndexOf('#ENDIF')<>-1); + AssertTrue('Have #DEFINE',Directives.IndexOf('#DEFINE')<>-1); + AssertTrue('Have #UNDEF',Directives.IndexOf('#UNDEF')<>-1); + AssertTrue('Have #UNDEFINE',Directives.IndexOf('#UNDEFINE')<>-1); + // This is defined in our test class. + AssertTrue('Have STOP',Directives.IndexOf('STOP')<>-1); end; end; @@ -513,6 +527,18 @@ begin AssertStatDir('"iets ""/* meer */"""', ''); end; +procedure TTestSQLScript.TestDashDashComment; +begin + script.CommentsInSQL := false; + Add('-- my comment'); + Add('CREATE TABLE "tPatients" ('); + Add(' "BloodGroup" character(2),'); + Add(' CONSTRAINT "ck_tPatients_BloodGroup" CHECK (("BloodGroup" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))),'); + Add(');'); + script.execute; + AssertStatDir('"CREATE TABLE ""tPatients"" ( ""BloodGroup"" character(2), CONSTRAINT ""ck_tPatients_BloodGroup"" CHECK ((""BloodGroup"" = ANY (ARRAY[''A''::bpchar, ''B''::bpchar, ''AB''::bpchar, ''0''::bpchar]))), )"', ''); +end; + procedure TTestSQLScript.TestQuote1InComment; begin script.CommentsInSQL := false;