Allow client to specify firebird engine via runtime providers

ccy · Apr 13, 2023 · 01b916b · 01b916b
1 parent 13d52c2
commit 01b916b
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 20 deletions.
diff --git a/delphi-firebird-api b/delphi-firebird-api
diff --git a/source/dbx4.firebird.connection.pas b/source/dbx4.firebird.connection.pas
@@ -38,6 +38,7 @@   TDBXConnection_Firebird = class(TDBXBase_Firebird, IDBXConnection, IDBXConnect
     FServerCharSet: WideString;
     FWaitOnLocks: Boolean;
     FWaitOnLocksTimeOut: Integer;
+    FProviders: string;
     procedure SetupTimeZones(AddTimeZone: TAddTimeZone);
   protected
     function BeginTransaction(out TransactionHandle: TDBXTransactionHandle;
@@ -179,7 +180,8 @@ function TDBXConnection_Firebird.Connect(Count: TInt32; Names, Values:
     end else if SameText(Names[i], 'Delphi2007Connection') then begin
       if not TryStrToBool(Values[i], FIsDelphi2007Connection) then
         FIsDelphi2007Connection := False;
-    end;
+    end else if SameText(Names[i], TFirebird.FB_Config_Providers) then
+      FProviders := TFirebird.FB_Config_Providers + '=' + Values[i];
   end;
 
   DPB := AnsiChar(isc_dpb_version1) +
@@ -188,6 +190,9 @@ function TDBXConnection_Firebird.Connect(Count: TInt32; Names, Values:
          AnsiChar(isc_dpb_password) + AnsiChar(Length(FPassword)) + AnsiString(FPassword) +
          AnsiChar(isc_dpb_sql_role_name) + AnsiChar(Length(FRoleName)) + AnsiString(FRoleName);
 
+  if not FProviders.IsEmpty then
+    DPB := DPB + AnsiChar(isc_dpb_config) + AnsiChar(Length(FProviders)) + AnsiString(FProviders);
+
   sServerName := AnsiString(FDatabase);
   if FHostName <> '' then
     sServerName := AnsiString(FHostName) + ':' + AnsiString(sServerName);

diff --git a/source/testcase/firebird.utils.pas b/source/testcase/firebird.utils.pas
@@ -14,8 +14,8 @@   TFBVersion = record
 
 function FB_GetVersion(VendorLib, Host, UserName, Password: string): TFBVersion;
 
-procedure FB_CreateDatabase(VendorLib, Host, Database, UserName, Password:
-    string);
+procedure FB_CreateDatabase(VendorLib, Host, Database, UserName, Password,
+    aProviders: string);
 
 procedure FB_DropDatabase(VendorLib, Host, Database, UserName, Password: string);
 
@@ -60,12 +60,13 @@ function ToBytes(a: UInt32): TBytes; overload; inline;
   Move(a, Result[0], SizeOf(a));
 end;
 
-function BuildDPB(UserName, Password: string): TBytes; inline;
+function BuildDPB(UserName, Password, aProviders: string): TBytes; inline;
 begin
   Result := [isc_dpb_version1]
           + [isc_dpb_sql_dialect, SizeOf(UInt32)] + ToBytes(UInt32(SQL_DIALECT_CURRENT));
   if not UserName.IsEmpty then Result := Result + [isc_dpb_user_name, Length(UserName)] + TEncoding.ANSI.GetBytes(UserName);
   if not Password.IsEmpty then Result := Result + [isc_dpb_password, Length(Password)] + TEncoding.ANSI.GetBytes(Password);
+  if not aProviders.IsEmpty then Result := Result + [isc_dpb_config, Length(aProviders)] + TEncoding.ANSI.GetBytes(aProviders);
 end;
 
 function FB_GetVersion(VendorLib, Host, UserName, Password: string):
@@ -118,13 +119,13 @@ function FB_GetVersion(VendorLib, Host, UserName, Password: string):
   st.CheckAndRaiseError(L);
 end;
 
-procedure FB_CreateDatabase(VendorLib, Host, Database, UserName, Password:
-    string);
+procedure FB_CreateDatabase(VendorLib, Host, Database, UserName, Password,
+    aProviders: string);
 begin
   var fileName := AnsiString(ExpandFileNameString(Database));
   if not Host.IsEmpty then fileName := AnsiString(Host) + ':' + fileName;
 
-  var P := BuildDPB(UserName, Password);
+  var P := BuildDPB(UserName, Password, aProviders);
 
   var db: isc_db_handle := nil;
 
@@ -143,7 +144,7 @@ procedure FB_DropDatabase(VendorLib, Host, Database, UserName, Password: string)
   var fileName := AnsiString(ExpandFileNameString(Database));
   if not Host.IsEmpty then fileName := AnsiString(Host) + ':' + fileName;
 
-  var P := BuildDPB(UserName, Password);
+  var P := BuildDPB(UserName, Password, TFirebirdEngines.GetProviders(VendorLib));
 
   var db: isc_db_handle := nil;
 
@@ -165,7 +166,7 @@ function FB_GetODS(VendorLib, Host, Database, UserName, Password: string):
   var fileName := AnsiString(ExpandFileNameString(Database));
   if not Host.IsEmpty then fileName := AnsiString(Host) + ':' + fileName;
 
-  var P := BuildDPB(UserName, Password);
+  var P := BuildDPB(UserName, Password, TFirebirdEngines.GetProviders(VendorLib));
 
   var db: isc_db_handle := nil;
 

diff --git a/source/testcase/vcl.dbx.testcase.pas b/source/testcase/vcl.dbx.testcase.pas
@@ -443,12 +443,20 @@ procedure TTestData_SQLConnection.CreateDatabase;
     sDatabase := sDatabase + 'T_' + GetTickCount.ToString + IntToStr(Random(High(Integer)));
 
     FServerVersion := v.ServerStr;
-    FName := Format('%s (%s) Host: %s Database: %s', [sImpl, FServerVersion, L.Values[HOSTNAME_KEY], sDatabase]);
 
-    FB_CreateDatabase(FVendorLib, L.Values[HOSTNAME_KEY], sDatabase, L.Values[szUSERNAME], L.Values[szPASSWORD]);
+    var i := L.IndexOfName(TFirebird.FB_Config_Providers);
+    var sProviders := '';
+    if i <> -1 then sProviders := L[i];
+    FB_CreateDatabase(FVendorLib, L.Values[HOSTNAME_KEY], sDatabase, L.Values[szUSERNAME], L.Values[szPASSWORD], sProviders);
 
     FODS := FB_GetODS(FVendorLib, L.Values[HOSTNAME_KEY], sDatabase, L.Values[szUSERNAME], L.Values[szPASSWORD]);
 
+    var sDB := L.Values[HOSTNAME_KEY];
+    if not sDB.IsEmpty then sDB := sDB + ':';
+    sDB := sDB + ExpandFileNameString(sDatabase);
+
+    FName := Format('%s (%s) Database: %s ODS: %d.%d', [FServerVersion, sImpl, sDB, DECODE_ODS_MAJOR(FODS), DECODE_ODS_MINOR(FODS)]);
+
     L.Values[DATABASENAME_KEY] := sDatabase;
     FParams := L.Text;
   finally
@@ -484,6 +492,9 @@ procedure TTestData_SQLConnection.Setup(const aConnection: TSQLConnection);
   aConnection.Params.Values[TDBXPropertyNames.LibraryName] := FLibraryName;
   aConnection.Params.Values[TDBXPropertyNames.GetDriverFunc] := FGetDriverFunc;
   aConnection.Params.Values[TDBXPropertyNames.VendorLib] := FVendorLib;
+  var s := TFirebirdEngines.GetProviders(FVendorLib);
+  if not s.IsEmpty then
+    aConnection.Params.Values[TFirebird.FB_Config_Providers] := s;
 {$ifend}
 end;
 
@@ -504,6 +515,8 @@ class procedure TTestSuite_DBX.CheckTestDataFile;
       F.Free;
     end;
   end;
+
+  SetEnvironmentVariable('drivers', PChar(TCmdLineParams_App.Drivers));
 end;
 
 class function TTestSuite_DBX.GetDriverSectionName: string;
@@ -3041,14 +3054,18 @@ class function TTestSuite_DBX1.NewTestDataList(const aParams: string): IInterfac
       for j := 0 to sEmbeds.Count - 1 do begin
         if TCmdLineParams_App.HasTestName and (TCmdLineParams_App.GetTestName <> sEmbeds.Names[j]) then Continue;
 
-        sParams := GetParams('', aParams);
-
-        sVer := GetServerVersion(sEmbeds.ValueFromIndex[j], sParams);
-
-        Result.Add(
-          TTestData_SQLConnection.Create(TDBXProductNames.FirebirdProduct, sDrivers.ValueFromIndex[i],
-          sDrivers.Names[i], sEmbeds.ValueFromIndex[j], sParams)
-        );
+        var Engines := TFirebirdEngines.Create(sEmbeds.ValueFromIndex[j]);
+        try
+          for var E in Engines do begin
+            sParams := GetParams('', aParams) + sLineBreak + Engines.GetProviders(E);
+            Result.Add(
+              TTestData_SQLConnection.Create(TDBXProductNames.FirebirdProduct, sDrivers.ValueFromIndex[i],
+              sDrivers.Names[i], sEmbeds.ValueFromIndex[j], sParams)
+            );
+          end;
+        finally
+          Engines.Free;
+        end;
       end;
     end;
   finally
@@ -3129,6 +3146,7 @@ class function TTestSuite_DBX2.NewTestDataList(const aParams: string = ''):
           IncludeTrailingPathDelimiter(TPath.GetDirectoryName(sDefaultVendorLib)) + 'plugins'
         , 'engine*.dll'
         ) do begin
+          sParams2 := GetParams('', aParams) + sLineBreak + string.Join('=', [TFirebird.FB_Config_Providers, TPath.GetFileNameWithoutExtension(Engine)]);
           R := R + [TTestData_SQLConnection.Create(TDBXProductNames.FirebirdProduct, sDrivers.ValueFromIndex[i], sDrivers.Names[i], sDefaultVendorLib, sParams2)];
         end;